mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-15 18:12:20 +00:00
Deploying to gh-pages from @ f93b6d9a5a 🚀
This commit is contained in:
Lemmih
parent
2e49536273
commit
103dbe49f3
44 changed files with 10028 additions and 157 deletions
367
reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear.hs.html
Normal file
367
reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear.hs.html
Normal file
|
|
@ -0,0 +1,367 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE DeriveFoldable #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE DeriveFunctor #-}
|
||||
<span class="lineno"> 3 </span>{-# LANGUAGE DeriveTraversable #-}
|
||||
<span class="lineno"> 4 </span>{-# LANGUAGE FunctionalDependencies #-}
|
||||
<span class="lineno"> 5 </span>{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
<span class="lineno"> 6 </span>{-# LANGUAGE UndecidableInstances #-}
|
||||
<span class="lineno"> 7 </span>{-|
|
||||
<span class="lineno"> 8 </span>Module : Geom2D.CubicBezier.Linear
|
||||
<span class="lineno"> 9 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 10 </span>License : Unlicense
|
||||
<span class="lineno"> 11 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 12 </span>Stability : experimental
|
||||
<span class="lineno"> 13 </span>Portability : POSIX
|
||||
<span class="lineno"> 14 </span>
|
||||
<span class="lineno"> 15 </span>Convenience wrapper around 'Geom2D.CubicBezier'
|
||||
<span class="lineno"> 16 </span>
|
||||
<span class="lineno"> 17 </span>-}
|
||||
<span class="lineno"> 18 </span>module Geom2D.CubicBezier.Linear
|
||||
<span class="lineno"> 19 </span> ( AnyBezier(..)
|
||||
<span class="lineno"> 20 </span> , CubicBezier(..)
|
||||
<span class="lineno"> 21 </span> , QuadBezier(..)
|
||||
<span class="lineno"> 22 </span> , OpenPath(..)
|
||||
<span class="lineno"> 23 </span> , ClosedPath(..)
|
||||
<span class="lineno"> 24 </span> , PathJoin(..)
|
||||
<span class="lineno"> 25 </span> , ClosedMetaPath(..)
|
||||
<span class="lineno"> 26 </span> , OpenMetaPath(..)
|
||||
<span class="lineno"> 27 </span> , MetaJoin(..)
|
||||
<span class="lineno"> 28 </span> , MetaNodeType(..)
|
||||
<span class="lineno"> 29 </span> , FillRule(..)
|
||||
<span class="lineno"> 30 </span> , Tension(..)
|
||||
<span class="lineno"> 31 </span> , quadToCubic
|
||||
<span class="lineno"> 32 </span> , arcLength
|
||||
<span class="lineno"> 33 </span> , arcLengthParam
|
||||
<span class="lineno"> 34 </span> , C.splitBezier
|
||||
<span class="lineno"> 35 </span> , colinear
|
||||
<span class="lineno"> 36 </span> , evalBezier
|
||||
<span class="lineno"> 37 </span> , evalBezierDeriv
|
||||
<span class="lineno"> 38 </span> , bezierHoriz
|
||||
<span class="lineno"> 39 </span> , bezierVert
|
||||
<span class="lineno"> 40 </span> , C.bezierSubsegment
|
||||
<span class="lineno"> 41 </span> , C.reorient
|
||||
<span class="lineno"> 42 </span> , closedPathCurves
|
||||
<span class="lineno"> 43 </span> , openPathCurves
|
||||
<span class="lineno"> 44 </span> , curvesToClosed
|
||||
<span class="lineno"> 45 </span> , closest
|
||||
<span class="lineno"> 46 </span> , unmetaOpen
|
||||
<span class="lineno"> 47 </span> , unmetaClosed
|
||||
<span class="lineno"> 48 </span> , union
|
||||
<span class="lineno"> 49 </span> , bezierIntersection
|
||||
<span class="lineno"> 50 </span> , interpolateVector
|
||||
<span class="lineno"> 51 </span> , vectorDistance
|
||||
<span class="lineno"> 52 </span> , findBezierInflection
|
||||
<span class="lineno"> 53 </span> , findBezierCusp
|
||||
<span class="lineno"> 54 </span> ) where
|
||||
<span class="lineno"> 55 </span>
|
||||
<span class="lineno"> 56 </span>import qualified Data.Vector.Unboxed as V
|
||||
<span class="lineno"> 57 </span>import qualified Geom2D.CubicBezier as C
|
||||
<span class="lineno"> 58 </span>import Graphics.SvgTree (FillRule (..))
|
||||
<span class="lineno"> 59 </span>import Linear.V2
|
||||
<span class="lineno"> 60 </span>
|
||||
<span class="lineno"> 61 </span>------------------------------------------------------------
|
||||
<span class="lineno"> 62 </span>-- Data types
|
||||
<span class="lineno"> 63 </span>
|
||||
<span class="lineno"> 64 </span>-- | A bezier curve of any degree.
|
||||
<span class="lineno"> 65 </span>newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
|
||||
<span class="lineno"> 66 </span>
|
||||
<span class="lineno"> 67 </span>-- | A cubic bezier curve.
|
||||
<span class="lineno"> 68 </span>data CubicBezier a = CubicBezier
|
||||
<span class="lineno"> 69 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC0</span></span></span> :: !(V2 a)
|
||||
<span class="lineno"> 70 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC1</span></span></span> :: !(V2 a)
|
||||
<span class="lineno"> 71 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC2</span></span></span> :: !(V2 a)
|
||||
<span class="lineno"> 72 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC3</span></span></span> :: !(V2 a)
|
||||
<span class="lineno"> 73 </span> } deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 74 </span>
|
||||
<span class="lineno"> 75 </span>-- | A quadratic bezier curve.
|
||||
<span class="lineno"> 76 </span>data QuadBezier a = QuadBezier
|
||||
<span class="lineno"> 77 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC0</span></span></span> :: !(V2 a)
|
||||
<span class="lineno"> 78 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC1</span></span></span> :: !(V2 a)
|
||||
<span class="lineno"> 79 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC2</span></span></span> :: !(V2 a)
|
||||
<span class="lineno"> 80 </span> } deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 81 </span>
|
||||
<span class="lineno"> 82 </span>-- | Open cubicbezier path.
|
||||
<span class="lineno"> 83 </span>data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
|
||||
<span class="lineno"> 84 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 85 </span>
|
||||
<span class="lineno"> 86 </span>-- | Closed cubicbezier path.
|
||||
<span class="lineno"> 87 </span>data ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
|
||||
<span class="lineno"> 88 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 89 </span>
|
||||
<span class="lineno"> 90 </span>-- | Join two points with either a straight line or a bezier
|
||||
<span class="lineno"> 91 </span>-- curve with two control points.
|
||||
<span class="lineno"> 92 </span>data PathJoin a
|
||||
<span class="lineno"> 93 </span> = JoinLine
|
||||
<span class="lineno"> 94 </span> | JoinCurve (V2 a) (V2 a)
|
||||
<span class="lineno"> 95 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 96 </span>
|
||||
<span class="lineno"> 97 </span>-- | Closed meta path.
|
||||
<span class="lineno"> 98 </span>data ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
|
||||
<span class="lineno"> 99 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 100 </span>
|
||||
<span class="lineno"> 101 </span>-- | Open meta path
|
||||
<span class="lineno"> 102 </span>data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
|
||||
<span class="lineno"> 103 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 104 </span>
|
||||
<span class="lineno"> 105 </span>-- | The tension value specifies how /tense/ the curve is.
|
||||
<span class="lineno"> 106 </span>-- A higher value means the curve approaches a line segment,
|
||||
<span class="lineno"> 107 </span>-- while a lower value means the curve is more round. Metafont
|
||||
<span class="lineno"> 108 </span>-- doesn't allow values below 3/4.
|
||||
<span class="lineno"> 109 </span>data Tension a
|
||||
<span class="lineno"> 110 </span> = Tension
|
||||
<span class="lineno"> 111 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionValue</span></span></span> :: a }
|
||||
<span class="lineno"> 112 </span> | TensionAtLeast -- ^ Like Tension, but keep the segment inside the
|
||||
<span class="lineno"> 113 </span> -- bounding triangle defined by the control points,
|
||||
<span class="lineno"> 114 </span> -- if there is one.
|
||||
<span class="lineno"> 115 </span> { tensionValue :: a }
|
||||
<span class="lineno"> 116 </span> deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Functor</span></span></span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Foldable</span></span></span></span></span></span>, <span class="decl"><span class="nottickedoff">Traversable</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>, <span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 117 </span>
|
||||
<span class="lineno"> 118 </span>-- | Join two meta points with either a bezier curve or tension
|
||||
<span class="lineno"> 119 </span>-- contraints.
|
||||
<span class="lineno"> 120 </span>data MetaJoin a
|
||||
<span class="lineno"> 121 </span> = MetaJoin
|
||||
<span class="lineno"> 122 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">metaTypeL</span></span></span> :: MetaNodeType a
|
||||
<span class="lineno"> 123 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionL</span></span></span> :: Tension a
|
||||
<span class="lineno"> 124 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionR</span></span></span> :: Tension a
|
||||
<span class="lineno"> 125 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">metaTypeR</span></span></span> :: MetaNodeType a
|
||||
<span class="lineno"> 126 </span> }
|
||||
<span class="lineno"> 127 </span> | Controls (V2 a) (V2 a)
|
||||
<span class="lineno"> 128 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 129 </span>
|
||||
<span class="lineno"> 130 </span>-- | Node constraint type.
|
||||
<span class="lineno"> 131 </span>data MetaNodeType a
|
||||
<span class="lineno"> 132 </span> = Open
|
||||
<span class="lineno"> 133 </span> | Curl { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">curlgamma</span></span></span> :: a }
|
||||
<span class="lineno"> 134 </span> | Direction { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">nodedir</span></span></span> :: V2 a }
|
||||
<span class="lineno"> 135 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 136 </span>
|
||||
<span class="lineno"> 137 </span>------------------------------------------------------------
|
||||
<span class="lineno"> 138 </span>-- Methods
|
||||
<span class="lineno"> 139 </span>
|
||||
<span class="lineno"> 140 </span>-- | Convert a quadratic bezier to a cubic bezier.
|
||||
<span class="lineno"> 141 </span>quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
|
||||
<span class="lineno"> 142 </span><span class="decl"><span class="istickedoff">quadToCubic = upCast . C.quadToCubic . downCast</span></span>
|
||||
<span class="lineno"> 143 </span>
|
||||
<span class="lineno"> 144 </span>-- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
|
||||
<span class="lineno"> 145 </span>-- within given tolerance @tol@.
|
||||
<span class="lineno"> 146 </span>arcLength :: CubicBezier Double -> Double -> Double -> Double
|
||||
<span class="lineno"> 147 </span><span class="decl"><span class="istickedoff">arcLength bezier t tol = C.arcLength (downCast bezier) t tol</span></span>
|
||||
<span class="lineno"> 148 </span>
|
||||
<span class="lineno"> 149 </span>-- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
|
||||
<span class="lineno"> 150 </span>-- has the arclength @len@, within tolerance @tol@.
|
||||
<span class="lineno"> 151 </span>arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
|
||||
<span class="lineno"> 152 </span><span class="decl"><span class="nottickedoff">arcLengthParam bezier t tol = C.arcLengthParam (downCast bezier) t tol</span></span>
|
||||
<span class="lineno"> 153 </span>
|
||||
<span class="lineno"> 154 </span>-- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
|
||||
<span class="lineno"> 155 </span>colinear :: CubicBezier Double -> Double -> Bool
|
||||
<span class="lineno"> 156 </span><span class="decl"><span class="istickedoff">colinear bezier tol = C.colinear (downCast bezier) tol</span></span>
|
||||
<span class="lineno"> 157 </span>
|
||||
<span class="lineno"> 158 </span>-- | Calculate a value on the bezier curve.
|
||||
<span class="lineno"> 159 </span>evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) => b a -> a -> V2 a
|
||||
<span class="lineno"> 160 </span><span class="decl"><span class="istickedoff">evalBezier c p = upCast $ C.evalBezier c p</span></span>
|
||||
<span class="lineno"> 161 </span>
|
||||
<span class="lineno"> 162 </span>-- | Calculate a value and the first derivative on the curve.
|
||||
<span class="lineno"> 163 </span>evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) => b a -> a -> (V2 a, V2 a)
|
||||
<span class="lineno"> 164 </span><span class="decl"><span class="nottickedoff">evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p</span></span>
|
||||
<span class="lineno"> 165 </span>
|
||||
<span class="lineno"> 166 </span>-- | Find the parameter where the bezier curve is horizontal.
|
||||
<span class="lineno"> 167 </span>bezierHoriz :: CubicBezier Double -> [Double]
|
||||
<span class="lineno"> 168 </span><span class="decl"><span class="nottickedoff">bezierHoriz = C.bezierHoriz . downCast</span></span>
|
||||
<span class="lineno"> 169 </span>
|
||||
<span class="lineno"> 170 </span>-- | Find the parameter where the bezier curve is vertical.
|
||||
<span class="lineno"> 171 </span>bezierVert :: CubicBezier Double -> [Double]
|
||||
<span class="lineno"> 172 </span><span class="decl"><span class="nottickedoff">bezierVert = C.bezierVert . downCast</span></span>
|
||||
<span class="lineno"> 173 </span>
|
||||
<span class="lineno"> 174 </span>-- | Create a normal path from a metapath.
|
||||
<span class="lineno"> 175 </span>unmetaOpen :: OpenMetaPath Double -> OpenPath Double
|
||||
<span class="lineno"> 176 </span><span class="decl"><span class="nottickedoff">unmetaOpen = upCast . C.unmetaOpen . downCast</span></span>
|
||||
<span class="lineno"> 177 </span>
|
||||
<span class="lineno"> 178 </span>-- | Create a normal path from a metapath.
|
||||
<span class="lineno"> 179 </span>unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
|
||||
<span class="lineno"> 180 </span><span class="decl"><span class="nottickedoff">unmetaClosed = upCast . C.unmetaClosed . downCast</span></span>
|
||||
<span class="lineno"> 181 </span>
|
||||
<span class="lineno"> 182 </span>-- | `O((n+m)*log(n+m))`, for n segments and m intersections.
|
||||
<span class="lineno"> 183 </span>-- Union of paths, removing overlap and rounding to the given tolerance.
|
||||
<span class="lineno"> 184 </span>union :: [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
|
||||
<span class="lineno"> 185 </span><span class="decl"><span class="nottickedoff">union p fill tol = upCast (C.union (downCast p) (downCast fill) tol)</span></span>
|
||||
<span class="lineno"> 186 </span>
|
||||
<span class="lineno"> 187 </span>-- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
|
||||
<span class="lineno"> 188 </span>-- Returns the parameters for both curves.
|
||||
<span class="lineno"> 189 </span>bezierIntersection :: CubicBezier Double -> CubicBezier Double -> Double -> [(Double, Double)]
|
||||
<span class="lineno"> 190 </span><span class="decl"><span class="nottickedoff">bezierIntersection a b t = C.bezierIntersection (downCast a) (downCast b) t</span></span>
|
||||
<span class="lineno"> 191 </span>
|
||||
<span class="lineno"> 192 </span>-- | Find the closest value on the bezier to the given point, within tolerance.
|
||||
<span class="lineno"> 193 </span>-- Return the first value found.
|
||||
<span class="lineno"> 194 </span>closest :: CubicBezier Double -> V2 Double -> Double -> Double
|
||||
<span class="lineno"> 195 </span><span class="decl"><span class="nottickedoff">closest c p t = C.closest (downCast c) (downCast p) t</span></span>
|
||||
<span class="lineno"> 196 </span>
|
||||
<span class="lineno"> 197 </span>-- | Return the closed path as a list of curves.
|
||||
<span class="lineno"> 198 </span>closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
|
||||
<span class="lineno"> 199 </span><span class="decl"><span class="istickedoff">closedPathCurves = upCast . C.closedPathCurves . downCast</span></span>
|
||||
<span class="lineno"> 200 </span>
|
||||
<span class="lineno"> 201 </span>-- | Return the open path as a list of curves.
|
||||
<span class="lineno"> 202 </span>openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
|
||||
<span class="lineno"> 203 </span><span class="decl"><span class="nottickedoff">openPathCurves = upCast . C.openPathCurves . downCast</span></span>
|
||||
<span class="lineno"> 204 </span>
|
||||
<span class="lineno"> 205 </span>-- | Make an open path from a list of curves. The last control point of each curve is ignored.
|
||||
<span class="lineno"> 206 </span>curvesToClosed :: [CubicBezier a] -> ClosedPath a
|
||||
<span class="lineno"> 207 </span><span class="decl"><span class="nottickedoff">curvesToClosed = upCast . C.curvesToClosed . downCast</span></span>
|
||||
<span class="lineno"> 208 </span>
|
||||
<span class="lineno"> 209 </span>-- | Interpolate between two vectors.
|
||||
<span class="lineno"> 210 </span>interpolateVector :: Num a => V2 a -> V2 a -> a -> V2 a
|
||||
<span class="lineno"> 211 </span><span class="decl"><span class="nottickedoff">interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p</span></span>
|
||||
<span class="lineno"> 212 </span>
|
||||
<span class="lineno"> 213 </span>-- | Distance between two vectors.
|
||||
<span class="lineno"> 214 </span>vectorDistance :: Floating a => V2 a -> V2 a -> a
|
||||
<span class="lineno"> 215 </span><span class="decl"><span class="nottickedoff">vectorDistance a b = C.vectorDistance (downCast a) (downCast b)</span></span>
|
||||
<span class="lineno"> 216 </span>
|
||||
<span class="lineno"> 217 </span>-- | Find inflection points on the curve.
|
||||
<span class="lineno"> 218 </span>findBezierInflection :: CubicBezier Double -> [Double]
|
||||
<span class="lineno"> 219 </span><span class="decl"><span class="nottickedoff">findBezierInflection = C.findBezierInflection . downCast</span></span>
|
||||
<span class="lineno"> 220 </span>
|
||||
<span class="lineno"> 221 </span>-- | Find the cusps of a bezier.
|
||||
<span class="lineno"> 222 </span>findBezierCusp :: CubicBezier Double -> [Double]
|
||||
<span class="lineno"> 223 </span><span class="decl"><span class="nottickedoff">findBezierCusp = C.findBezierCusp . downCast</span></span>
|
||||
<span class="lineno"> 224 </span>
|
||||
<span class="lineno"> 225 </span>------------------------------------------------------------
|
||||
<span class="lineno"> 226 </span>-- Instances
|
||||
<span class="lineno"> 227 </span>
|
||||
<span class="lineno"> 228 </span>instance C.GenericBezier QuadBezier where
|
||||
<span class="lineno"> 229 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
|
||||
<span class="lineno"> 230 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
|
||||
<span class="lineno"> 231 </span> <span class="decl"><span class="nottickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
|
||||
<span class="lineno"> 232 </span>
|
||||
<span class="lineno"> 233 </span>instance C.GenericBezier CubicBezier where
|
||||
<span class="lineno"> 234 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
|
||||
<span class="lineno"> 235 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
|
||||
<span class="lineno"> 236 </span> <span class="decl"><span class="istickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
|
||||
<span class="lineno"> 237 </span>
|
||||
<span class="lineno"> 238 </span>instance C.GenericBezier AnyBezier where
|
||||
<span class="lineno"> 239 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
|
||||
<span class="lineno"> 240 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
|
||||
<span class="lineno"> 241 </span> <span class="decl"><span class="istickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
|
||||
<span class="lineno"> 242 </span>
|
||||
<span class="lineno"> 243 </span>------------------------------------------------------------
|
||||
<span class="lineno"> 244 </span>-- Casting
|
||||
<span class="lineno"> 245 </span>
|
||||
<span class="lineno"> 246 </span>class Cast a b | a -> b, b -> a where
|
||||
<span class="lineno"> 247 </span> downCast :: a -> b
|
||||
<span class="lineno"> 248 </span> upCast :: b -> a
|
||||
<span class="lineno"> 249 </span>
|
||||
<span class="lineno"> 250 </span>instance Cast a b => Cast [a] [b] where
|
||||
<span class="lineno"> 251 </span> <span class="decl"><span class="nottickedoff">downCast = map downCast</span></span>
|
||||
<span class="lineno"> 252 </span> <span class="decl"><span class="istickedoff">upCast = map upCast</span></span>
|
||||
<span class="lineno"> 253 </span>
|
||||
<span class="lineno"> 254 </span>instance (Cast a a', Cast b b') => Cast (a,b) (a',b') where
|
||||
<span class="lineno"> 255 </span> <span class="decl"><span class="nottickedoff">downCast (a, b) = (downCast a, downCast b)</span></span>
|
||||
<span class="lineno"> 256 </span> <span class="decl"><span class="nottickedoff">upCast (a, b) = (upCast a, upCast b)</span></span>
|
||||
<span class="lineno"> 257 </span>
|
||||
<span class="lineno"> 258 </span>instance Cast (V2 a) (C.Point a) where
|
||||
<span class="lineno"> 259 </span> <span class="decl"><span class="istickedoff">downCast (V2 a b) = C.Point a b</span></span>
|
||||
<span class="lineno"> 260 </span> <span class="decl"><span class="istickedoff">upCast (C.Point a b) = V2 a b</span></span>
|
||||
<span class="lineno"> 261 </span>
|
||||
<span class="lineno"> 262 </span>instance Cast FillRule C.FillRule where
|
||||
<span class="lineno"> 263 </span> <span class="decl"><span class="nottickedoff">downCast FillEvenOdd = C.EvenOdd</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="nottickedoff">downCast FillNonZero = C.NonZero</span></span>
|
||||
<span class="lineno"> 265 </span> <span class="decl"><span class="nottickedoff">upCast C.EvenOdd = FillEvenOdd</span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="nottickedoff">upCast C.NonZero = FillNonZero</span></span>
|
||||
<span class="lineno"> 267 </span>
|
||||
<span class="lineno"> 268 </span>instance Cast (CubicBezier a) (C.CubicBezier a) where
|
||||
<span class="lineno"> 269 </span> <span class="decl"><span class="istickedoff">downCast (CubicBezier a b c d) = C.CubicBezier</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="istickedoff">(downCast a) (downCast b) (downCast c) (downCast d)</span></span>
|
||||
<span class="lineno"> 271 </span> <span class="decl"><span class="istickedoff">upCast (C.CubicBezier a b c d) = CubicBezier</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">(upCast a) (upCast b) (upCast c) (upCast d)</span></span>
|
||||
<span class="lineno"> 273 </span>
|
||||
<span class="lineno"> 274 </span>instance Cast (QuadBezier a) (C.QuadBezier a) where
|
||||
<span class="lineno"> 275 </span> <span class="decl"><span class="istickedoff">downCast (QuadBezier a b c) = C.QuadBezier</span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="istickedoff">(downCast a) (downCast b) (downCast c)</span></span>
|
||||
<span class="lineno"> 277 </span> <span class="decl"><span class="nottickedoff">upCast (C.QuadBezier a b c)= QuadBezier</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="nottickedoff">(upCast a) (upCast b) (upCast c)</span></span>
|
||||
<span class="lineno"> 279 </span>
|
||||
<span class="lineno"> 280 </span>instance V.Unbox a => Cast (AnyBezier a) (C.AnyBezier a) where
|
||||
<span class="lineno"> 281 </span> <span class="decl"><span class="istickedoff">downCast (AnyBezier arr) = C.AnyBezier $</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="istickedoff">V.map (\(V2 a b) -> (a,b)) arr</span></span>
|
||||
<span class="lineno"> 283 </span> <span class="decl"><span class="istickedoff">upCast (C.AnyBezier arr) = AnyBezier $</span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="istickedoff">V.map (\(a, b) -> V2 a b) arr</span></span>
|
||||
<span class="lineno"> 285 </span>
|
||||
<span class="lineno"> 286 </span>instance Cast (MetaNodeType a) (C.MetaNodeType a) where
|
||||
<span class="lineno"> 287 </span> <span class="decl"><span class="nottickedoff">downCast Open = C.Open</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Curl gamma) = C.Curl gamma</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Direction dir) = C.Direction (downCast dir)</span></span>
|
||||
<span class="lineno"> 290 </span> <span class="decl"><span class="nottickedoff">upCast C.Open = Open</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Curl gamma) = Curl gamma</span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Direction dir) = Direction (upCast dir)</span></span>
|
||||
<span class="lineno"> 293 </span>
|
||||
<span class="lineno"> 294 </span>instance Cast (Tension a) (C.Tension a) where
|
||||
<span class="lineno"> 295 </span> <span class="decl"><span class="nottickedoff">downCast (Tension v) = C.Tension v</span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="nottickedoff">downCast (TensionAtLeast v) = C.TensionAtLeast v</span></span>
|
||||
<span class="lineno"> 297 </span> <span class="decl"><span class="nottickedoff">upCast (C.Tension v) = Tension v</span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.TensionAtLeast v) = TensionAtLeast v</span></span>
|
||||
<span class="lineno"> 299 </span>
|
||||
<span class="lineno"> 300 </span>instance Cast (MetaJoin a) (C.MetaJoin a) where
|
||||
<span class="lineno"> 301 </span> <span class="decl"><span class="nottickedoff">downCast (MetaJoin tyL tL tR tyR) =</span>
|
||||
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="nottickedoff">C.MetaJoin (downCast tyL) (downCast tL) (downCast tR) (downCast tyR)</span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)</span></span>
|
||||
<span class="lineno"> 304 </span> <span class="decl"><span class="nottickedoff">upCast (C.MetaJoin tyL tL tR tyR) =</span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="nottickedoff">MetaJoin (upCast tyL) (upCast tL) (upCast tR) (upCast tyR)</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Controls p1 p2) = Controls (upCast p1) (upCast p2)</span></span>
|
||||
<span class="lineno"> 307 </span>
|
||||
<span class="lineno"> 308 </span>instance Cast (PathJoin a) (C.PathJoin a) where
|
||||
<span class="lineno"> 309 </span> <span class="decl"><span class="istickedoff">downCast JoinLine = C.JoinLine</span>
|
||||
<span class="lineno"> 310 </span><span class="spaces"> </span><span class="istickedoff">downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)</span></span>
|
||||
<span class="lineno"> 311 </span> <span class="decl"><span class="nottickedoff">upCast C.JoinLine = JoinLine</span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)</span></span>
|
||||
<span class="lineno"> 313 </span>
|
||||
<span class="lineno"> 314 </span>instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
|
||||
<span class="lineno"> 315 </span> <span class="decl"><span class="nottickedoff">downCast (OpenMetaPath lst end) = C.OpenMetaPath</span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
|
||||
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) <- lst ] (downCast end)</span></span>
|
||||
<span class="lineno"> 318 </span> <span class="decl"><span class="nottickedoff">upCast (C.OpenMetaPath lst end) = OpenMetaPath</span>
|
||||
<span class="lineno"> 319 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
|
||||
<span class="lineno"> 320 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) <- lst ] (upCast end)</span></span>
|
||||
<span class="lineno"> 321 </span>
|
||||
<span class="lineno"> 322 </span>instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
|
||||
<span class="lineno"> 323 </span> <span class="decl"><span class="nottickedoff">downCast (ClosedMetaPath lst) = C.ClosedMetaPath</span>
|
||||
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
|
||||
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) <- lst ]</span></span>
|
||||
<span class="lineno"> 326 </span> <span class="decl"><span class="nottickedoff">upCast (C.ClosedMetaPath lst) = ClosedMetaPath</span>
|
||||
<span class="lineno"> 327 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
|
||||
<span class="lineno"> 328 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) <- lst ]</span></span>
|
||||
<span class="lineno"> 329 </span>
|
||||
<span class="lineno"> 330 </span>instance Cast (OpenPath a) (C.OpenPath a) where
|
||||
<span class="lineno"> 331 </span> <span class="decl"><span class="nottickedoff">downCast (OpenPath lst end) = C.OpenPath</span>
|
||||
<span class="lineno"> 332 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
|
||||
<span class="lineno"> 333 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) <- lst ] (downCast end)</span></span>
|
||||
<span class="lineno"> 334 </span> <span class="decl"><span class="nottickedoff">upCast (C.OpenPath lst end) = OpenPath</span>
|
||||
<span class="lineno"> 335 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
|
||||
<span class="lineno"> 336 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) <- lst ] (upCast end)</span></span>
|
||||
<span class="lineno"> 337 </span>
|
||||
<span class="lineno"> 338 </span>instance Cast (ClosedPath a) (C.ClosedPath a) where
|
||||
<span class="lineno"> 339 </span> <span class="decl"><span class="istickedoff">downCast (ClosedPath lst) = C.ClosedPath</span>
|
||||
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="istickedoff">[ (downCast p, downCast j)</span>
|
||||
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="istickedoff">| (p, j) <- lst ]</span></span>
|
||||
<span class="lineno"> 342 </span> <span class="decl"><span class="nottickedoff">upCast (C.ClosedPath lst) = ClosedPath</span>
|
||||
<span class="lineno"> 343 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
|
||||
<span class="lineno"> 344 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) <- lst ]</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
73
reanimate-0.4.2.0-inplace/Paths_reanimate.hs.html
Normal file
73
reanimate-0.4.2.0-inplace/Paths_reanimate.hs.html
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE CPP #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE NoRebindableSyntax #-}
|
||||
<span class="lineno"> 3 </span>{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
|
||||
<span class="lineno"> 4 </span>module Paths_reanimate (
|
||||
<span class="lineno"> 5 </span> version,
|
||||
<span class="lineno"> 6 </span> getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,
|
||||
<span class="lineno"> 7 </span> getDataFileName, getSysconfDir
|
||||
<span class="lineno"> 8 </span> ) where
|
||||
<span class="lineno"> 9 </span>
|
||||
<span class="lineno"> 10 </span>import qualified Control.Exception as Exception
|
||||
<span class="lineno"> 11 </span>import Data.Version (Version(..))
|
||||
<span class="lineno"> 12 </span>import System.Environment (getEnv)
|
||||
<span class="lineno"> 13 </span>import Prelude
|
||||
<span class="lineno"> 14 </span>
|
||||
<span class="lineno"> 15 </span>#if defined(VERSION_base)
|
||||
<span class="lineno"> 16 </span>
|
||||
<span class="lineno"> 17 </span>#if MIN_VERSION_base(4,0,0)
|
||||
<span class="lineno"> 18 </span>catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
|
||||
<span class="lineno"> 19 </span>#else
|
||||
<span class="lineno"> 20 </span>catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a
|
||||
<span class="lineno"> 21 </span>#endif
|
||||
<span class="lineno"> 22 </span>
|
||||
<span class="lineno"> 23 </span>#else
|
||||
<span class="lineno"> 24 </span>catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
|
||||
<span class="lineno"> 25 </span>#endif
|
||||
<span class="lineno"> 26 </span><span class="decl"><span class="istickedoff">catchIO = Exception.catch</span></span>
|
||||
<span class="lineno"> 27 </span>
|
||||
<span class="lineno"> 28 </span>version :: Version
|
||||
<span class="lineno"> 29 </span><span class="decl"><span class="nottickedoff">version = Version [0,4,2,0] []</span></span>
|
||||
<span class="lineno"> 30 </span>bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath
|
||||
<span class="lineno"> 31 </span>
|
||||
<span class="lineno"> 32 </span><span class="decl"><span class="nottickedoff">bindir = "/home/runner/.cabal/bin"</span></span>
|
||||
<span class="lineno"> 33 </span><span class="decl"><span class="nottickedoff">libdir = "/home/runner/.cabal/lib/x86_64-linux-ghc-8.8.3/reanimate-0.4.2.0-inplace"</span></span>
|
||||
<span class="lineno"> 34 </span><span class="decl"><span class="nottickedoff">dynlibdir = "/home/runner/.cabal/lib/x86_64-linux-ghc-8.8.3"</span></span>
|
||||
<span class="lineno"> 35 </span><span class="decl"><span class="nottickedoff">datadir = "/home/runner/.cabal/share/x86_64-linux-ghc-8.8.3/reanimate-0.4.2.0"</span></span>
|
||||
<span class="lineno"> 36 </span><span class="decl"><span class="nottickedoff">libexecdir = "/home/runner/.cabal/libexec/x86_64-linux-ghc-8.8.3/reanimate-0.4.2.0"</span></span>
|
||||
<span class="lineno"> 37 </span><span class="decl"><span class="nottickedoff">sysconfdir = "/home/runner/.cabal/etc"</span></span>
|
||||
<span class="lineno"> 38 </span>
|
||||
<span class="lineno"> 39 </span>getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
|
||||
<span class="lineno"> 40 </span><span class="decl"><span class="nottickedoff">getBinDir = catchIO (getEnv "reanimate_bindir") (\_ -> return bindir)</span></span>
|
||||
<span class="lineno"> 41 </span><span class="decl"><span class="nottickedoff">getLibDir = catchIO (getEnv "reanimate_libdir") (\_ -> return libdir)</span></span>
|
||||
<span class="lineno"> 42 </span><span class="decl"><span class="nottickedoff">getDynLibDir = catchIO (getEnv "reanimate_dynlibdir") (\_ -> return dynlibdir)</span></span>
|
||||
<span class="lineno"> 43 </span><span class="decl"><span class="istickedoff">getDataDir = catchIO (getEnv "reanimate_datadir") <span class="nottickedoff">(\_ -> return datadir)</span></span></span>
|
||||
<span class="lineno"> 44 </span><span class="decl"><span class="nottickedoff">getLibexecDir = catchIO (getEnv "reanimate_libexecdir") (\_ -> return libexecdir)</span></span>
|
||||
<span class="lineno"> 45 </span><span class="decl"><span class="nottickedoff">getSysconfDir = catchIO (getEnv "reanimate_sysconfdir") (\_ -> return sysconfdir)</span></span>
|
||||
<span class="lineno"> 46 </span>
|
||||
<span class="lineno"> 47 </span>getDataFileName :: FilePath -> IO FilePath
|
||||
<span class="lineno"> 48 </span><span class="decl"><span class="istickedoff">getDataFileName name = do</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">dir <- getDataDir</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">return (dir ++ "/" ++ name)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
417
reanimate-0.4.2.0-inplace/Reanimate.Animation.hs.html
Normal file
417
reanimate-0.4.2.0-inplace/Reanimate.Animation.hs.html
Normal file
|
|
@ -0,0 +1,417 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Module : Reanimate.Animation
|
||||
<span class="lineno"> 3 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 4 </span>License : Unlicense
|
||||
<span class="lineno"> 5 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 6 </span>Stability : experimental
|
||||
<span class="lineno"> 7 </span>Portability : POSIX
|
||||
<span class="lineno"> 8 </span>
|
||||
<span class="lineno"> 9 </span>Declarative animation API based on combinators. For a higher-level interface,
|
||||
<span class="lineno"> 10 </span>see 'Reanimate.Scene'.
|
||||
<span class="lineno"> 11 </span>
|
||||
<span class="lineno"> 12 </span>-}
|
||||
<span class="lineno"> 13 </span>module Reanimate.Animation
|
||||
<span class="lineno"> 14 </span> ( Duration
|
||||
<span class="lineno"> 15 </span> , Time
|
||||
<span class="lineno"> 16 </span> , SVG
|
||||
<span class="lineno"> 17 </span> , Animation
|
||||
<span class="lineno"> 18 </span> -- * Creating animations
|
||||
<span class="lineno"> 19 </span> , mkAnimation
|
||||
<span class="lineno"> 20 </span> , animate
|
||||
<span class="lineno"> 21 </span> , staticFrame
|
||||
<span class="lineno"> 22 </span> , pause
|
||||
<span class="lineno"> 23 </span> -- * Querying animations
|
||||
<span class="lineno"> 24 </span> , duration
|
||||
<span class="lineno"> 25 </span> , frameAt
|
||||
<span class="lineno"> 26 </span> -- * Composing animations
|
||||
<span class="lineno"> 27 </span> , seqA
|
||||
<span class="lineno"> 28 </span> , andThen
|
||||
<span class="lineno"> 29 </span> , parA
|
||||
<span class="lineno"> 30 </span> , parLoopA
|
||||
<span class="lineno"> 31 </span> , parDropA
|
||||
<span class="lineno"> 32 </span> -- * Modifying animations
|
||||
<span class="lineno"> 33 </span> , setDuration
|
||||
<span class="lineno"> 34 </span> , adjustDuration
|
||||
<span class="lineno"> 35 </span> , mapA
|
||||
<span class="lineno"> 36 </span> , takeA
|
||||
<span class="lineno"> 37 </span> , dropA
|
||||
<span class="lineno"> 38 </span> , lastA
|
||||
<span class="lineno"> 39 </span> , pauseAtEnd
|
||||
<span class="lineno"> 40 </span> , pauseAtBeginning
|
||||
<span class="lineno"> 41 </span> , pauseAround
|
||||
<span class="lineno"> 42 </span> , repeatA
|
||||
<span class="lineno"> 43 </span> , reverseA
|
||||
<span class="lineno"> 44 </span> , playThenReverseA
|
||||
<span class="lineno"> 45 </span> , signalA
|
||||
<span class="lineno"> 46 </span> , freezeAtPercentage
|
||||
<span class="lineno"> 47 </span> , addStatic
|
||||
<span class="lineno"> 48 </span> -- * Misc
|
||||
<span class="lineno"> 49 </span> , getAnimationFrame
|
||||
<span class="lineno"> 50 </span> , Sync(..)
|
||||
<span class="lineno"> 51 </span> -- * Rendering
|
||||
<span class="lineno"> 52 </span> , renderTree
|
||||
<span class="lineno"> 53 </span> , renderSvg
|
||||
<span class="lineno"> 54 </span> ) where
|
||||
<span class="lineno"> 55 </span>
|
||||
<span class="lineno"> 56 </span>import Control.Arrow ()
|
||||
<span class="lineno"> 57 </span>import Data.Fixed (mod')
|
||||
<span class="lineno"> 58 </span>import Graphics.SvgTree (Alignment (..), Document (..),
|
||||
<span class="lineno"> 59 </span> Number (..),
|
||||
<span class="lineno"> 60 </span> PreserveAspectRatio (..),
|
||||
<span class="lineno"> 61 </span> Tree (..), xmlOfTree)
|
||||
<span class="lineno"> 62 </span>import Graphics.SvgTree.Printer
|
||||
<span class="lineno"> 63 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 64 </span>import Reanimate.Ease
|
||||
<span class="lineno"> 65 </span>import Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 66 </span>import Text.XML.Light.Output
|
||||
<span class="lineno"> 67 </span>
|
||||
<span class="lineno"> 68 </span>-- | Duration of an animation or effect. Usually measured in seconds.
|
||||
<span class="lineno"> 69 </span>type Duration = Double
|
||||
<span class="lineno"> 70 </span>-- | Time signal. Goes from 0 to 1, inclusive.
|
||||
<span class="lineno"> 71 </span>type Time = Double
|
||||
<span class="lineno"> 72 </span>
|
||||
<span class="lineno"> 73 </span>-- | SVG node.
|
||||
<span class="lineno"> 74 </span>type SVG = Tree
|
||||
<span class="lineno"> 75 </span>
|
||||
<span class="lineno"> 76 </span>-- | Animations are SVGs over a finite time.
|
||||
<span class="lineno"> 77 </span>data Animation = Animation Duration (Time -> SVG)
|
||||
<span class="lineno"> 78 </span>
|
||||
<span class="lineno"> 79 </span>-- | Construct an animation with a given duration.
|
||||
<span class="lineno"> 80 </span>mkAnimation :: Duration -> (Time -> SVG) -> Animation
|
||||
<span class="lineno"> 81 </span><span class="decl"><span class="istickedoff">mkAnimation = Animation</span></span>
|
||||
<span class="lineno"> 82 </span>
|
||||
<span class="lineno"> 83 </span>-- | Construct an animation with a duration of @1@.
|
||||
<span class="lineno"> 84 </span>animate :: (Time -> SVG) -> Animation
|
||||
<span class="lineno"> 85 </span><span class="decl"><span class="istickedoff">animate = Animation 1</span></span>
|
||||
<span class="lineno"> 86 </span>
|
||||
<span class="lineno"> 87 </span>-- | Create an animation with provided @duration@, which consists of stationary frame displayed for its entire duration.
|
||||
<span class="lineno"> 88 </span>staticFrame :: Duration -> SVG -> Animation
|
||||
<span class="lineno"> 89 </span><span class="decl"><span class="istickedoff">staticFrame d svg = Animation d (const svg)</span></span>
|
||||
<span class="lineno"> 90 </span>
|
||||
<span class="lineno"> 91 </span>-- | Query the duration of an animation.
|
||||
<span class="lineno"> 92 </span>duration :: Animation -> Duration
|
||||
<span class="lineno"> 93 </span><span class="decl"><span class="istickedoff">duration (Animation d _) = d</span></span>
|
||||
<span class="lineno"> 94 </span>
|
||||
<span class="lineno"> 95 </span>-- | Play animations in sequence. The @lhs@ animation is removed after it has
|
||||
<span class="lineno"> 96 </span>-- completed. New animation duration is '@duration lhs + duration rhs@'.
|
||||
<span class="lineno"> 97 </span>--
|
||||
<span class="lineno"> 98 </span>-- Example:
|
||||
<span class="lineno"> 99 </span>--
|
||||
<span class="lineno"> 100 </span>-- > drawBox `seqA` drawCircle
|
||||
<span class="lineno"> 101 </span>--
|
||||
<span class="lineno"> 102 </span>-- <<docs/gifs/doc_seqA.gif>>
|
||||
<span class="lineno"> 103 </span>seqA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 104 </span><span class="decl"><span class="istickedoff">seqA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="istickedoff">if t < d1/totalD</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="istickedoff">then f1 (t * totalD/d1)</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="istickedoff">else f2 ((t-d1/totalD) * totalD/d2)</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff">totalD = d1+d2</span></span>
|
||||
<span class="lineno"> 111 </span>
|
||||
<span class="lineno"> 112 </span>-- | Play two animation concurrently. Shortest animation freezes on last frame.
|
||||
<span class="lineno"> 113 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 114 </span>--
|
||||
<span class="lineno"> 115 </span>-- Example:
|
||||
<span class="lineno"> 116 </span>--
|
||||
<span class="lineno"> 117 </span>-- > drawBox `parA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 118 </span>--
|
||||
<span class="lineno"> 119 </span>-- <<docs/gifs/doc_parA.gif>>
|
||||
<span class="lineno"> 120 </span>parA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 121 </span><span class="decl"><span class="istickedoff">parA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff">Animation (max d1 d2) $ \t -></span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="istickedoff">[ f1 (min 1 t1)</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff">, f2 (min 1 t2) ]</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 130 </span>
|
||||
<span class="lineno"> 131 </span>-- | Play two animation concurrently. Shortest animation loops.
|
||||
<span class="lineno"> 132 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 133 </span>--
|
||||
<span class="lineno"> 134 </span>-- Example:
|
||||
<span class="lineno"> 135 </span>--
|
||||
<span class="lineno"> 136 </span>-- > drawBox `parLoopA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 137 </span>--
|
||||
<span class="lineno"> 138 </span>-- <<docs/gifs/doc_parLoopA.gif>>
|
||||
<span class="lineno"> 139 </span>parLoopA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 140 </span><span class="decl"><span class="istickedoff">parLoopA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff">[ f1 (t1 `mod'` 1)</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff">, f2 (t2 `mod'` 1) ]</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 149 </span>
|
||||
<span class="lineno"> 150 </span>-- | Play two animation concurrently. Animations disappear after playing once.
|
||||
<span class="lineno"> 151 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 152 </span>--
|
||||
<span class="lineno"> 153 </span>-- Example:
|
||||
<span class="lineno"> 154 </span>--
|
||||
<span class="lineno"> 155 </span>-- > drawBox `parLoopA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 156 </span>--
|
||||
<span class="lineno"> 157 </span>-- <<docs/gifs/doc_parDropA.gif>>
|
||||
<span class="lineno"> 158 </span>parDropA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 159 </span><span class="decl"><span class="istickedoff">parDropA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="istickedoff">[ if t1>1 then None else f1 t1</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="istickedoff">, if <span class="tickonlyfalse">t2>1</span> then <span class="nottickedoff">None</span> else f2 t2 ]</span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 168 </span>
|
||||
<span class="lineno"> 169 </span>-- | Empty animation (no SVG output) with a fixed duration.
|
||||
<span class="lineno"> 170 </span>--
|
||||
<span class="lineno"> 171 </span>-- Example:
|
||||
<span class="lineno"> 172 </span>--
|
||||
<span class="lineno"> 173 </span>-- > pause 1 `seqA` drawProgress
|
||||
<span class="lineno"> 174 </span>--
|
||||
<span class="lineno"> 175 </span>-- <<docs/gifs/doc_pause.gif>>
|
||||
<span class="lineno"> 176 </span>pause :: Duration -> Animation
|
||||
<span class="lineno"> 177 </span><span class="decl"><span class="istickedoff">pause d = Animation d (const None)</span></span>
|
||||
<span class="lineno"> 178 </span>
|
||||
<span class="lineno"> 179 </span>-- | Play left animation and freeze on the last frame, then play the right
|
||||
<span class="lineno"> 180 </span>-- animation. New duration is '@duration lhs + duration rhs@'.
|
||||
<span class="lineno"> 181 </span>--
|
||||
<span class="lineno"> 182 </span>-- Example:
|
||||
<span class="lineno"> 183 </span>--
|
||||
<span class="lineno"> 184 </span>-- > drawBox `andThen` drawCircle
|
||||
<span class="lineno"> 185 </span>--
|
||||
<span class="lineno"> 186 </span>-- <<docs/gifs/doc_andThen.gif>>
|
||||
<span class="lineno"> 187 </span>andThen :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 188 </span><span class="decl"><span class="istickedoff">andThen a b = a `parA` (pause (duration a) `seqA` b)</span></span>
|
||||
<span class="lineno"> 189 </span>
|
||||
<span class="lineno"> 190 </span>-- | Calculate the frame that would be displayed at given point in @time@ of running @animation@.
|
||||
<span class="lineno"> 191 </span>--
|
||||
<span class="lineno"> 192 </span>-- The provided time parameter is clamped between 0 and animation duration.
|
||||
<span class="lineno"> 193 </span>frameAt :: Time -> Animation -> SVG
|
||||
<span class="lineno"> 194 </span><span class="decl"><span class="istickedoff">frameAt t (Animation d f) = f t'</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="istickedoff">t' = clamp 0 1 (t/d)</span></span>
|
||||
<span class="lineno"> 197 </span>
|
||||
<span class="lineno"> 198 </span>-- | Helper function for pretty-printing SVG nodes.
|
||||
<span class="lineno"> 199 </span>renderTree :: SVG -> String
|
||||
<span class="lineno"> 200 </span><span class="decl"><span class="nottickedoff">renderTree t = maybe "" ppElement $ xmlOfTree t</span></span>
|
||||
<span class="lineno"> 201 </span>
|
||||
<span class="lineno"> 202 </span>-- | Helper function for pretty-printing SVG nodes as SVG documents.
|
||||
<span class="lineno"> 203 </span>renderSvg :: Maybe Number -- ^ The number to use as value of the @width@ attribute of the resulting top-level svg element. If @Nothing@, the width attribute won't be rendered.
|
||||
<span class="lineno"> 204 </span> -> Maybe Number -- ^ Similar to previous argument, but for @height@ attribute.
|
||||
<span class="lineno"> 205 </span> -> SVG -- ^ SVG to render
|
||||
<span class="lineno"> 206 </span> -> String -- ^ String representation of SVG XML markup
|
||||
<span class="lineno"> 207 </span><span class="decl"><span class="istickedoff">renderSvg w h t = ppDocument doc</span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"></span><span class="istickedoff">-- renderSvg w h t = ppFastElement (xmlOfDocument doc)</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="istickedoff">width = 16</span>
|
||||
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="istickedoff">height = 9</span>
|
||||
<span class="lineno"> 212 </span><span class="spaces"> </span><span class="istickedoff">doc = Document</span>
|
||||
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="istickedoff">{ _viewBox = Just (-width/2, -height/2, width, height)</span>
|
||||
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="istickedoff">, _width = w</span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="istickedoff">, _height = h</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="istickedoff">, _elements = [withStrokeWidth defaultStrokeWidth $ scaleXY 1 (-1) t]</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="istickedoff">, _description = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="istickedoff">, _documentLocation = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="istickedoff">, _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing</span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="istickedoff">}</span></span>
|
||||
<span class="lineno"> 221 </span>
|
||||
<span class="lineno"> 222 </span>-- | Map over the SVG produced by an animation at every frame.
|
||||
<span class="lineno"> 223 </span>--
|
||||
<span class="lineno"> 224 </span>-- Example:
|
||||
<span class="lineno"> 225 </span>--
|
||||
<span class="lineno"> 226 </span>-- > mapA (scale 0.5) drawCircle
|
||||
<span class="lineno"> 227 </span>--
|
||||
<span class="lineno"> 228 </span>-- <<docs/gifs/doc_mapA.gif>>
|
||||
<span class="lineno"> 229 </span>
|
||||
<span class="lineno"> 230 </span>mapA :: (SVG -> SVG) -> Animation -> Animation
|
||||
<span class="lineno"> 231 </span><span class="decl"><span class="istickedoff">mapA fn (Animation d f) = Animation d (fn . f)</span></span>
|
||||
<span class="lineno"> 232 </span>
|
||||
<span class="lineno"> 233 </span>-- | Freeze the last frame for @t@ seconds at the end of the animation.
|
||||
<span class="lineno"> 234 </span>--
|
||||
<span class="lineno"> 235 </span>-- Example:
|
||||
<span class="lineno"> 236 </span>--
|
||||
<span class="lineno"> 237 </span>-- > pauseAtEnd 1 drawProgress
|
||||
<span class="lineno"> 238 </span>--
|
||||
<span class="lineno"> 239 </span>-- <<docs/gifs/doc_pauseAtEnd.gif>>
|
||||
<span class="lineno"> 240 </span>pauseAtEnd :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 241 </span><span class="decl"><span class="istickedoff">pauseAtEnd t a = a `andThen` pause t</span></span>
|
||||
<span class="lineno"> 242 </span>
|
||||
<span class="lineno"> 243 </span>-- | Freeze the first frame for @t@ seconds at the beginning of the animation.
|
||||
<span class="lineno"> 244 </span>--
|
||||
<span class="lineno"> 245 </span>-- Example:
|
||||
<span class="lineno"> 246 </span>--
|
||||
<span class="lineno"> 247 </span>-- > pauseAtBeginning 1 drawProgress
|
||||
<span class="lineno"> 248 </span>--
|
||||
<span class="lineno"> 249 </span>-- <<docs/gifs/doc_pauseAtBeginning.gif>>
|
||||
<span class="lineno"> 250 </span>pauseAtBeginning :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 251 </span><span class="decl"><span class="istickedoff">pauseAtBeginning t a =</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="istickedoff">Animation t (freezeFrame 0 a) `seqA` a</span></span>
|
||||
<span class="lineno"> 253 </span>
|
||||
<span class="lineno"> 254 </span>-- | Freeze the first and the last frame of the animation for a specified duration.
|
||||
<span class="lineno"> 255 </span>--
|
||||
<span class="lineno"> 256 </span>-- Example:
|
||||
<span class="lineno"> 257 </span>--
|
||||
<span class="lineno"> 258 </span>-- > pauseAround 1 1 drawProgress
|
||||
<span class="lineno"> 259 </span>--
|
||||
<span class="lineno"> 260 </span>-- <<docs/gifs/doc_pauseAround.gif>>
|
||||
<span class="lineno"> 261 </span>pauseAround :: Duration -> Duration -> Animation -> Animation
|
||||
<span class="lineno"> 262 </span><span class="decl"><span class="istickedoff">pauseAround start end = pauseAtEnd end . pauseAtBeginning start</span></span>
|
||||
<span class="lineno"> 263 </span>
|
||||
<span class="lineno"> 264 </span>-- Freeze frame at time @t@.
|
||||
<span class="lineno"> 265 </span>freezeFrame :: Time -> Animation -> (Time -> SVG)
|
||||
<span class="lineno"> 266 </span><span class="decl"><span class="istickedoff">freezeFrame t (Animation d f) = const $ f (t/d)</span></span>
|
||||
<span class="lineno"> 267 </span>
|
||||
<span class="lineno"> 268 </span>-- | Change the duration of an animation. Animates are stretched or squished
|
||||
<span class="lineno"> 269 </span>-- (rather than truncated) to fit the new duration.
|
||||
<span class="lineno"> 270 </span>adjustDuration :: (Duration -> Duration) -> Animation -> Animation
|
||||
<span class="lineno"> 271 </span><span class="decl"><span class="istickedoff">adjustDuration fn (Animation d gen) =</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">Animation (fn d) gen</span></span>
|
||||
<span class="lineno"> 273 </span>
|
||||
<span class="lineno"> 274 </span>-- | Set the duration of an animation by adjusting its playback rate. The
|
||||
<span class="lineno"> 275 </span>-- animation is still played from start to finish without being cropped.
|
||||
<span class="lineno"> 276 </span>setDuration :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 277 </span><span class="decl"><span class="nottickedoff">setDuration newD = adjustDuration (const newD)</span></span>
|
||||
<span class="lineno"> 278 </span>
|
||||
<span class="lineno"> 279 </span>-- | Play an animation in reverse. Duration remains unchanged. Shorthand for:
|
||||
<span class="lineno"> 280 </span>-- @'signalA' 'reverseS'@.
|
||||
<span class="lineno"> 281 </span>--
|
||||
<span class="lineno"> 282 </span>-- Example:
|
||||
<span class="lineno"> 283 </span>--
|
||||
<span class="lineno"> 284 </span>-- > reverseA drawCircle
|
||||
<span class="lineno"> 285 </span>--
|
||||
<span class="lineno"> 286 </span>-- <<docs/gifs/doc_reverseA.gif>>
|
||||
<span class="lineno"> 287 </span>reverseA :: Animation -> Animation
|
||||
<span class="lineno"> 288 </span><span class="decl"><span class="istickedoff">reverseA = signalA reverseS</span></span>
|
||||
<span class="lineno"> 289 </span>
|
||||
<span class="lineno"> 290 </span>-- | Play animation before playing it again in reverse. Duration is twice
|
||||
<span class="lineno"> 291 </span>-- the duration of the input.
|
||||
<span class="lineno"> 292 </span>--
|
||||
<span class="lineno"> 293 </span>-- Example:
|
||||
<span class="lineno"> 294 </span>--
|
||||
<span class="lineno"> 295 </span>-- > playThenReverseA drawCircle
|
||||
<span class="lineno"> 296 </span>--
|
||||
<span class="lineno"> 297 </span>-- <<docs/gifs/doc_playThenReverseA.gif>>
|
||||
<span class="lineno"> 298 </span>playThenReverseA :: Animation -> Animation
|
||||
<span class="lineno"> 299 </span><span class="decl"><span class="istickedoff">playThenReverseA a = a `seqA` reverseA a</span></span>
|
||||
<span class="lineno"> 300 </span>
|
||||
<span class="lineno"> 301 </span>-- | Loop animation @n@ number of times. This number may be fractional and it
|
||||
<span class="lineno"> 302 </span>-- may be less than 1. It must be greater than or equal to 0, though.
|
||||
<span class="lineno"> 303 </span>-- New duration is @n*duration input@.
|
||||
<span class="lineno"> 304 </span>--
|
||||
<span class="lineno"> 305 </span>-- Example:
|
||||
<span class="lineno"> 306 </span>--
|
||||
<span class="lineno"> 307 </span>-- > repeatA 1.5 drawCircle
|
||||
<span class="lineno"> 308 </span>--
|
||||
<span class="lineno"> 309 </span>-- <<docs/gifs/doc_repeatA.gif>>
|
||||
<span class="lineno"> 310 </span>repeatA :: Double -> Animation -> Animation
|
||||
<span class="lineno"> 311 </span><span class="decl"><span class="istickedoff">repeatA n (Animation d f) = Animation (d*n) $ \t -></span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="istickedoff">f ((t*n) `mod'` 1)</span></span>
|
||||
<span class="lineno"> 313 </span>
|
||||
<span class="lineno"> 314 </span>
|
||||
<span class="lineno"> 315 </span>-- | @freezeAtPercentage time animation@ creates an animation consisting of stationary frame,
|
||||
<span class="lineno"> 316 </span>-- that would be displayed in the provided @animation@ at given @time@.
|
||||
<span class="lineno"> 317 </span>-- The duration of the new animation is the same as the duration of provided @animation@.
|
||||
<span class="lineno"> 318 </span>freezeAtPercentage :: Time -- ^ value between 0 and 1. The frame displayed at this point in the original animation will be displayed for the duration of the new animation
|
||||
<span class="lineno"> 319 </span> -> Animation -- ^ original animation, from which the frame will be taken
|
||||
<span class="lineno"> 320 </span> -> Animation -- ^ new animation consisting of static frame displayed for the duration of the original animation
|
||||
<span class="lineno"> 321 </span><span class="decl"><span class="nottickedoff">freezeAtPercentage frac (Animation d genFrame) =</span>
|
||||
<span class="lineno"> 322 </span><span class="spaces"> </span><span class="nottickedoff">Animation d $ const $ genFrame frac</span></span>
|
||||
<span class="lineno"> 323 </span>
|
||||
<span class="lineno"> 324 </span>-- | Overlay animation on top of static SVG image.
|
||||
<span class="lineno"> 325 </span>--
|
||||
<span class="lineno"> 326 </span>-- Example:
|
||||
<span class="lineno"> 327 </span>--
|
||||
<span class="lineno"> 328 </span>-- > addStatic (mkBackground "lightblue") drawCircle
|
||||
<span class="lineno"> 329 </span>--
|
||||
<span class="lineno"> 330 </span>-- <<docs/gifs/doc_addStatic.gif>>
|
||||
<span class="lineno"> 331 </span>addStatic :: SVG -> Animation -> Animation
|
||||
<span class="lineno"> 332 </span><span class="decl"><span class="istickedoff">addStatic static = mapA (\frame -> mkGroup [static, frame])</span></span>
|
||||
<span class="lineno"> 333 </span>
|
||||
<span class="lineno"> 334 </span>-- | Modify the time component of an animation. Animation duration is unchanged.
|
||||
<span class="lineno"> 335 </span>--
|
||||
<span class="lineno"> 336 </span>-- Example:
|
||||
<span class="lineno"> 337 </span>--
|
||||
<span class="lineno"> 338 </span>-- > signalA (fromToS 0.25 0.75) drawCircle
|
||||
<span class="lineno"> 339 </span>--
|
||||
<span class="lineno"> 340 </span>-- <<docs/gifs/doc_signalA.gif>>
|
||||
<span class="lineno"> 341 </span>signalA :: Signal -> Animation -> Animation
|
||||
<span class="lineno"> 342 </span><span class="decl"><span class="istickedoff">signalA fn (Animation d gen) = Animation d $ gen . fn</span></span>
|
||||
<span class="lineno"> 343 </span>
|
||||
<span class="lineno"> 344 </span>-- | @takeA duration animation@ creates a new animation consisting of initial segment of
|
||||
<span class="lineno"> 345 </span>-- @animation@ of given @duration@, played at the same rate as the original animation.
|
||||
<span class="lineno"> 346 </span>--
|
||||
<span class="lineno"> 347 </span>-- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
|
||||
<span class="lineno"> 348 </span>-- New animation duration is equal to (eventually clamped) @duration@.
|
||||
<span class="lineno"> 349 </span>takeA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 350 </span><span class="decl"><span class="istickedoff">takeA len (Animation d gen) = Animation len' $ \t -></span>
|
||||
<span class="lineno"> 351 </span><span class="spaces"> </span><span class="istickedoff">gen (t * len'/d)</span>
|
||||
<span class="lineno"> 352 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 353 </span><span class="spaces"> </span><span class="istickedoff">len' = clamp 0 d len</span></span>
|
||||
<span class="lineno"> 354 </span>
|
||||
<span class="lineno"> 355 </span>-- | @dropA duration animation@ creates a new animation by dropping initial segment
|
||||
<span class="lineno"> 356 </span>-- of length @duration@ from the provided @animation@, played at the same rate as the original animation.
|
||||
<span class="lineno"> 357 </span>--
|
||||
<span class="lineno"> 358 </span>-- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
|
||||
<span class="lineno"> 359 </span>-- The duration of the resulting animation is duration of provided @animation@ minus (eventually clamped) @duration@.
|
||||
<span class="lineno"> 360 </span>dropA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 361 </span><span class="decl"><span class="istickedoff">dropA len (Animation d gen) = Animation len' $ \t -></span>
|
||||
<span class="lineno"> 362 </span><span class="spaces"> </span><span class="istickedoff">gen (t * len'/d + len/d)</span>
|
||||
<span class="lineno"> 363 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 364 </span><span class="spaces"> </span><span class="istickedoff">len' = d - clamp 0 d len</span></span>
|
||||
<span class="lineno"> 365 </span>
|
||||
<span class="lineno"> 366 </span>-- | @lastA duration animation@ return the last @duration@ seconds of the animation.
|
||||
<span class="lineno"> 367 </span>lastA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 368 </span><span class="decl"><span class="istickedoff">lastA len a = dropA (duration a - len) a</span></span>
|
||||
<span class="lineno"> 369 </span>
|
||||
<span class="lineno"> 370 </span>clamp :: Double -> Double -> Double -> Double
|
||||
<span class="lineno"> 371 </span><span class="decl"><span class="istickedoff">clamp a b number</span>
|
||||
<span class="lineno"> 372 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">a < b</span> = max a (min b number)</span>
|
||||
<span class="lineno"> 373 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">max b (min a number)</span></span></span>
|
||||
<span class="lineno"> 374 </span>
|
||||
<span class="lineno"> 375 </span>-- (#) :: a -> (a -> b) -> b
|
||||
<span class="lineno"> 376 </span>-- o # f = f o
|
||||
<span class="lineno"> 377 </span>
|
||||
<span class="lineno"> 378 </span>-- | Ask for an animation frame using a given synchronization policy.
|
||||
<span class="lineno"> 379 </span>getAnimationFrame :: Sync -> Animation -> Time -> Duration -> SVG
|
||||
<span class="lineno"> 380 </span><span class="decl"><span class="istickedoff">getAnimationFrame sync (Animation aDur aGen) t d =</span>
|
||||
<span class="lineno"> 381 </span><span class="spaces"> </span><span class="istickedoff">case sync of</span>
|
||||
<span class="lineno"> 382 </span><span class="spaces"> </span><span class="istickedoff">SyncStretch -> aGen (t/d)</span>
|
||||
<span class="lineno"> 383 </span><span class="spaces"> </span><span class="istickedoff">SyncLoop -> <span class="nottickedoff">aGen (takeFrac $ t/aDur)</span></span>
|
||||
<span class="lineno"> 384 </span><span class="spaces"> </span><span class="istickedoff">SyncDrop -> <span class="nottickedoff">if t > aDur then None else aGen (t/aDur)</span></span>
|
||||
<span class="lineno"> 385 </span><span class="spaces"> </span><span class="istickedoff">SyncFreeze -> aGen (min 1 $ t/aDur)</span>
|
||||
<span class="lineno"> 386 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 387 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">takeFrac f = snd (properFraction f :: (Int, Double))</span></span></span>
|
||||
<span class="lineno"> 388 </span>
|
||||
<span class="lineno"> 389 </span>-- | Animation synchronization policies.
|
||||
<span class="lineno"> 390 </span>data Sync
|
||||
<span class="lineno"> 391 </span> = SyncStretch
|
||||
<span class="lineno"> 392 </span> | SyncLoop
|
||||
<span class="lineno"> 393 </span> | SyncDrop
|
||||
<span class="lineno"> 394 </span> | SyncFreeze
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,86 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Module : Reanimate.Builtin.Documentation
|
||||
<span class="lineno"> 3 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 4 </span>License : Unlicense
|
||||
<span class="lineno"> 5 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 6 </span>Stability : experimental
|
||||
<span class="lineno"> 7 </span>Portability : POSIX
|
||||
<span class="lineno"> 8 </span>
|
||||
<span class="lineno"> 9 </span>This module contains convenience functions used in documention
|
||||
<span class="lineno"> 10 </span>GIFs for a consistent look and feel.
|
||||
<span class="lineno"> 11 </span>
|
||||
<span class="lineno"> 12 </span>-}
|
||||
<span class="lineno"> 13 </span>module Reanimate.Builtin.Documentation where
|
||||
<span class="lineno"> 14 </span>
|
||||
<span class="lineno"> 15 </span>import Reanimate.Animation
|
||||
<span class="lineno"> 16 </span>import Reanimate.Svg
|
||||
<span class="lineno"> 17 </span>import Reanimate.Raster
|
||||
<span class="lineno"> 18 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 19 </span>import Codec.Picture
|
||||
<span class="lineno"> 20 </span>
|
||||
<span class="lineno"> 21 </span>-- | Default environment for API documentation GIFs.
|
||||
<span class="lineno"> 22 </span>docEnv :: Animation -> Animation
|
||||
<span class="lineno"> 23 </span><span class="decl"><span class="istickedoff">docEnv = mapA $ \svg -> mkGroup</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="istickedoff">[ mkBackground "white"</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="istickedoff">, withFillOpacity 0 $</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="istickedoff">withStrokeWidth 0.1 $</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="istickedoff">withStrokeColor "black" (mkGroup [svg]) ]</span></span>
|
||||
<span class="lineno"> 28 </span>
|
||||
<span class="lineno"> 29 </span>-- | <<docs/gifs/doc_drawBox.gif>>
|
||||
<span class="lineno"> 30 </span>drawBox :: Animation
|
||||
<span class="lineno"> 31 </span><span class="decl"><span class="istickedoff">drawBox = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">partialSvg t $ pathify $</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="istickedoff">mkRect (screenWidth/2) (screenHeight/2)</span></span>
|
||||
<span class="lineno"> 34 </span>
|
||||
<span class="lineno"> 35 </span>-- | <<docs/gifs/doc_drawCircle.gif>>
|
||||
<span class="lineno"> 36 </span>drawCircle :: Animation
|
||||
<span class="lineno"> 37 </span><span class="decl"><span class="istickedoff">drawCircle = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">partialSvg t $ pathify $</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">mkCircle (screenHeight/3)</span></span>
|
||||
<span class="lineno"> 40 </span>
|
||||
<span class="lineno"> 41 </span>-- | <<docs/gifs/doc_drawProgress.gif>>
|
||||
<span class="lineno"> 42 </span>drawProgress :: Animation
|
||||
<span class="lineno"> 43 </span><span class="decl"><span class="istickedoff">drawProgress = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff">[ mkLine (-screenWidth/2*widthP,0)</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">(screenWidth/2*widthP,0)</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff">, translate (-screenWidth/2*widthP + screenWidth*widthP*t) 0 $</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $ mkCircle 0.5 ]</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">widthP = 0.8</span></span>
|
||||
<span class="lineno"> 51 </span>
|
||||
<span class="lineno"> 52 </span>-- | Render a full-screen view of a color-map.
|
||||
<span class="lineno"> 53 </span>showColorMap :: (Double -> PixelRGB8) -> SVG
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="istickedoff">showColorMap f = center $ scaleToSize screenWidth screenHeight $ embedImage img</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">width = 256</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">height = 1</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">img = generateImage pixelRenderer width height</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">pixelRenderer x _y = f (fromIntegral x / fromIntegral (width-1))</span></span>
|
||||
<span class="lineno"> 60 </span>
|
||||
<span class="lineno"> 61 </span>-- | Default background color for videos on reanimate.rtfd.io
|
||||
<span class="lineno"> 62 </span>rtfdBackgroundColor :: PixelRGBA8
|
||||
<span class="lineno"> 63 </span><span class="decl"><span class="istickedoff">rtfdBackgroundColor = PixelRGBA8 252 252 252 0xFF</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
91
reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images.hs.html
Normal file
91
reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images.hs.html
Normal file
|
|
@ -0,0 +1,91 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Module : Reanimate.Builtin.Images
|
||||
<span class="lineno"> 3 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 4 </span>License : Unlicense
|
||||
<span class="lineno"> 5 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 6 </span>Stability : experimental
|
||||
<span class="lineno"> 7 </span>Portability : POSIX
|
||||
<span class="lineno"> 8 </span>
|
||||
<span class="lineno"> 9 </span>Collection of built-in images.
|
||||
<span class="lineno"> 10 </span>
|
||||
<span class="lineno"> 11 </span>-}
|
||||
<span class="lineno"> 12 </span>module Reanimate.Builtin.Images
|
||||
<span class="lineno"> 13 </span> ( svgLogo
|
||||
<span class="lineno"> 14 </span> , haskellLogo
|
||||
<span class="lineno"> 15 </span> , githubIcon
|
||||
<span class="lineno"> 16 </span> , githubWhiteIcon
|
||||
<span class="lineno"> 17 </span> , smallEarth
|
||||
<span class="lineno"> 18 </span> ) where
|
||||
<span class="lineno"> 19 </span>
|
||||
<span class="lineno"> 20 </span>import Codec.Picture
|
||||
<span class="lineno"> 21 </span>import qualified Data.ByteString as B
|
||||
<span class="lineno"> 22 </span>import Graphics.SvgTree (parseSvgFile)
|
||||
<span class="lineno"> 23 </span>import Paths_reanimate
|
||||
<span class="lineno"> 24 </span>import Reanimate.Animation
|
||||
<span class="lineno"> 25 </span>import Reanimate.Svg
|
||||
<span class="lineno"> 26 </span>import System.IO.Unsafe
|
||||
<span class="lineno"> 27 </span>
|
||||
<span class="lineno"> 28 </span>embedImage :: FilePath -> IO SVG
|
||||
<span class="lineno"> 29 </span><span class="decl"><span class="istickedoff">embedImage key = do</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="istickedoff">svg_file <- getDataFileName key</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="istickedoff">svg_data <- B.readFile svg_file</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">case parseSvgFile <span class="nottickedoff">svg_file</span> svg_data of</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="istickedoff">Nothing -> <span class="nottickedoff">error "Malformed svg"</span></span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="istickedoff">Just svg -> return $ embedDocument svg</span></span>
|
||||
<span class="lineno"> 35 </span>
|
||||
<span class="lineno"> 36 </span>loadJPG :: FilePath -> Image PixelRGBA8
|
||||
<span class="lineno"> 37 </span><span class="decl"><span class="nottickedoff">loadJPG key = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">jpg_file <- getDataFileName key</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">dat <- B.readFile jpg_file</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">case decodeJpeg dat of</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">Left err -> error err</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="nottickedoff">Right img -> return $ convertRGBA8 img</span></span>
|
||||
<span class="lineno"> 43 </span>
|
||||
<span class="lineno"> 44 </span>{- HLINT ignore svgLogo -}
|
||||
<span class="lineno"> 45 </span>-- | <<docs/gifs/doc_svgLogo.gif>>
|
||||
<span class="lineno"> 46 </span>svgLogo :: SVG
|
||||
<span class="lineno"> 47 </span><span class="decl"><span class="istickedoff">svgLogo = unsafePerformIO $ embedImage "data/svg-logo.svg"</span></span>
|
||||
<span class="lineno"> 48 </span>
|
||||
<span class="lineno"> 49 </span>{- HLINT ignore haskellLogo -}
|
||||
<span class="lineno"> 50 </span>-- | <<docs/gifs/doc_haskellLogo.gif>>
|
||||
<span class="lineno"> 51 </span>haskellLogo :: SVG
|
||||
<span class="lineno"> 52 </span><span class="decl"><span class="istickedoff">haskellLogo = unsafePerformIO $ embedImage "data/haskell.svg"</span></span>
|
||||
<span class="lineno"> 53 </span>
|
||||
<span class="lineno"> 54 </span>{- HLINT ignore githubIcon -}
|
||||
<span class="lineno"> 55 </span>-- | <<docs/gifs/doc_githubIcon.gif>>
|
||||
<span class="lineno"> 56 </span>githubIcon :: SVG
|
||||
<span class="lineno"> 57 </span><span class="decl"><span class="istickedoff">githubIcon = unsafePerformIO $ embedImage "data/github-icon.svg"</span></span>
|
||||
<span class="lineno"> 58 </span>
|
||||
<span class="lineno"> 59 </span>{-# NOINLINE githubWhiteIcon #-}
|
||||
<span class="lineno"> 60 </span>-- | <<docs/gifs/doc_githubWhiteIcon.gif>>
|
||||
<span class="lineno"> 61 </span>githubWhiteIcon :: SVG
|
||||
<span class="lineno"> 62 </span><span class="decl"><span class="nottickedoff">githubWhiteIcon = unsafePerformIO $ embedImage "data/github-icon-white.svg"</span></span>
|
||||
<span class="lineno"> 63 </span>
|
||||
<span class="lineno"> 64 </span>-- | 300x150 equirectangular earth
|
||||
<span class="lineno"> 65 </span>--
|
||||
<span class="lineno"> 66 </span>-- <<docs/gifs/doc_smallEarth.gif>>
|
||||
<span class="lineno"> 67 </span>smallEarth :: Image PixelRGBA8
|
||||
<span class="lineno"> 68 </span><span class="decl"><span class="nottickedoff">smallEarth = loadJPG "data/small_earth.jpg"</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
60
reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide.hs.html
Normal file
60
reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide.hs.html
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 3 </span>License : Unlicense
|
||||
<span class="lineno"> 4 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 5 </span>Stability : experimental
|
||||
<span class="lineno"> 6 </span>Portability : POSIX
|
||||
<span class="lineno"> 7 </span>-}
|
||||
<span class="lineno"> 8 </span>module Reanimate.Builtin.Slide where
|
||||
<span class="lineno"> 9 </span>
|
||||
<span class="lineno"> 10 </span>import Reanimate.Transition
|
||||
<span class="lineno"> 11 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 12 </span>import Reanimate.Svg
|
||||
<span class="lineno"> 13 </span>import Reanimate.Effect
|
||||
<span class="lineno"> 14 </span>
|
||||
<span class="lineno"> 15 </span>-- | <<docs/gifs/doc_slideLeftT.gif>>
|
||||
<span class="lineno"> 16 </span>slideLeftT :: Transition
|
||||
<span class="lineno"> 17 </span><span class="decl"><span class="istickedoff">slideLeftT = effectT slideLeft (andE slideLeft moveRight)</span>
|
||||
<span class="lineno"> 18 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 19 </span><span class="spaces"> </span><span class="istickedoff">slideLeft = translateE (-screenWidth) 0</span>
|
||||
<span class="lineno"> 20 </span><span class="spaces"> </span><span class="istickedoff">moveRight = constE (translate screenWidth 0)</span>
|
||||
<span class="lineno"> 21 </span><span class="spaces"> </span><span class="istickedoff">andE a b d t = a d t . b <span class="nottickedoff">d</span> <span class="nottickedoff">t</span></span></span>
|
||||
<span class="lineno"> 22 </span>
|
||||
<span class="lineno"> 23 </span>-- | <<docs/gifs/doc_slideDownT.gif>>
|
||||
<span class="lineno"> 24 </span>slideDownT :: Transition
|
||||
<span class="lineno"> 25 </span><span class="decl"><span class="istickedoff">slideDownT = effectT slideDown (andE slideDown moveUp)</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="istickedoff">slideDown = translateE 0 (-screenHeight)</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="istickedoff">moveUp = constE (translate 0 screenHeight)</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="istickedoff">andE a b d t = a d t . b <span class="nottickedoff">d</span> <span class="nottickedoff">t</span></span></span>
|
||||
<span class="lineno"> 30 </span>
|
||||
<span class="lineno"> 31 </span>-- | <<docs/gifs/doc_slideUpT.gif>>
|
||||
<span class="lineno"> 32 </span>slideUpT :: Transition
|
||||
<span class="lineno"> 33 </span><span class="decl"><span class="istickedoff">slideUpT = effectT slideUp (andE slideUp moveDown)</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="istickedoff">slideUp = translateE 0 screenHeight</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="istickedoff">moveDown = constE (translate 0 (-screenHeight))</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">andE a b d t = a d t . b <span class="nottickedoff">d</span> <span class="nottickedoff">t</span></span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
134
reanimate-0.4.2.0-inplace/Reanimate.Cache.hs.html
Normal file
134
reanimate-0.4.2.0-inplace/Reanimate.Cache.hs.html
Normal file
|
|
@ -0,0 +1,134 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>module Reanimate.Cache
|
||||
<span class="lineno"> 2 </span> ( cacheFile -- :: FilePath -> (FilePath -> IO ()) -> IO FilePath
|
||||
<span class="lineno"> 3 </span> , cacheMem
|
||||
<span class="lineno"> 4 </span> , cacheDisk
|
||||
<span class="lineno"> 5 </span> , cacheDiskSvg
|
||||
<span class="lineno"> 6 </span> , cacheDiskKey
|
||||
<span class="lineno"> 7 </span> , cacheDiskLines
|
||||
<span class="lineno"> 8 </span> , encodeInt
|
||||
<span class="lineno"> 9 </span> ) where
|
||||
<span class="lineno"> 10 </span>
|
||||
<span class="lineno"> 11 </span>import Control.Exception
|
||||
<span class="lineno"> 12 </span>import Control.Monad (unless)
|
||||
<span class="lineno"> 13 </span>import Data.Bits
|
||||
<span class="lineno"> 14 </span>import Data.Hashable
|
||||
<span class="lineno"> 15 </span>import Data.IORef
|
||||
<span class="lineno"> 16 </span>import Data.Map (Map)
|
||||
<span class="lineno"> 17 </span>import qualified Data.Map as Map
|
||||
<span class="lineno"> 18 </span>import Data.Text (Text)
|
||||
<span class="lineno"> 19 </span>import qualified Data.Text as T
|
||||
<span class="lineno"> 20 </span>import qualified Data.Text.IO as T
|
||||
<span class="lineno"> 21 </span>import Graphics.SvgTree (Tree (..), unparse)
|
||||
<span class="lineno"> 22 </span>import Reanimate.Animation (renderTree)
|
||||
<span class="lineno"> 23 </span>import Reanimate.Misc (renameOrCopyFile)
|
||||
<span class="lineno"> 24 </span>import System.Directory
|
||||
<span class="lineno"> 25 </span>import System.FilePath
|
||||
<span class="lineno"> 26 </span>import System.IO
|
||||
<span class="lineno"> 27 </span>import System.IO.Temp
|
||||
<span class="lineno"> 28 </span>import System.IO.Unsafe
|
||||
<span class="lineno"> 29 </span>import Text.XML.Light (Content (..), parseXML)
|
||||
<span class="lineno"> 30 </span>
|
||||
<span class="lineno"> 31 </span>-- Memory cache and disk cache
|
||||
<span class="lineno"> 32 </span>
|
||||
<span class="lineno"> 33 </span>cacheFile :: FilePath -> (FilePath -> IO ()) -> IO FilePath
|
||||
<span class="lineno"> 34 </span><span class="decl"><span class="nottickedoff">cacheFile template gen = do</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="nottickedoff">root <- getXdgDirectory XdgCache "reanimate"</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">createDirectoryIfMissing True root</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="nottickedoff">let path = root </> template</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">hit <- doesFileExist path</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">unless hit $ withSystemTempFile template $ \tmp h -> do</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">hClose h</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">gen tmp</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="nottickedoff">renameOrCopyFile tmp path</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="nottickedoff">evaluate path</span></span>
|
||||
<span class="lineno"> 44 </span>
|
||||
<span class="lineno"> 45 </span>cacheDisk :: String -> (T.Text -> Maybe a) -> (a -> T.Text) -> (Text -> IO a) -> (Text -> IO a)
|
||||
<span class="lineno"> 46 </span><span class="decl"><span class="nottickedoff">cacheDisk cacheType parse render gen key = do</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="nottickedoff">root <- getXdgDirectory XdgCache "reanimate"</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">createDirectoryIfMissing True root</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">let path = root </> encodeInt (hash key) <.> cacheType</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="nottickedoff">hit <- doesFileExist path</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">if hit</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="nottickedoff">then do</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="nottickedoff">inp <- T.readFile path</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="nottickedoff">case parse inp of</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> genCache root path</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">Just val -> pure val</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">else genCache root path</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">genCache root path = do</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">(tmpPath, tmpHandle) <- openTempFile root (encodeInt (hash key))</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">new <- gen key</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">T.hPutStr tmpHandle (render new)</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="nottickedoff">hClose tmpHandle</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="nottickedoff">renameOrCopyFile tmpPath path</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="nottickedoff">return new</span></span>
|
||||
<span class="lineno"> 66 </span>
|
||||
<span class="lineno"> 67 </span>cacheDiskKey :: Text -> IO Tree -> IO Tree
|
||||
<span class="lineno"> 68 </span><span class="decl"><span class="nottickedoff">cacheDiskKey key gen = cacheDiskSvg (const gen) key</span></span>
|
||||
<span class="lineno"> 69 </span>
|
||||
<span class="lineno"> 70 </span>cacheDiskSvg :: (Text -> IO Tree) -> (Text -> IO Tree)
|
||||
<span class="lineno"> 71 </span><span class="decl"><span class="nottickedoff">cacheDiskSvg = cacheDisk "svg" parse render</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">parse txt = case parseXML txt of</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">[Elem t] -> Just (unparse t)</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">_ -> Nothing</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">render = T.pack . renderTree</span></span>
|
||||
<span class="lineno"> 77 </span>
|
||||
<span class="lineno"> 78 </span>cacheDiskLines :: (Text -> IO [Text]) -> (Text -> IO [Text])
|
||||
<span class="lineno"> 79 </span><span class="decl"><span class="nottickedoff">cacheDiskLines = cacheDisk "txt" parse render</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="nottickedoff">parse = Just . T.lines</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="nottickedoff">render = T.unlines</span></span>
|
||||
<span class="lineno"> 83 </span>
|
||||
<span class="lineno"> 84 </span>
|
||||
<span class="lineno"> 85 </span>{-# NOINLINE cache #-}
|
||||
<span class="lineno"> 86 </span>cache :: IORef (Map Text Tree)
|
||||
<span class="lineno"> 87 </span><span class="decl"><span class="nottickedoff">cache = unsafePerformIO (newIORef Map.empty)</span></span>
|
||||
<span class="lineno"> 88 </span>
|
||||
<span class="lineno"> 89 </span>cacheMem :: (Text -> IO Tree) -> (Text -> IO Tree)
|
||||
<span class="lineno"> 90 </span><span class="decl"><span class="nottickedoff">cacheMem gen key = do</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="nottickedoff">store <- readIORef cache</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="nottickedoff">case Map.lookup key store of</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="nottickedoff">Just svg -> return svg</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> do</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="nottickedoff">svg <- gen key</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="nottickedoff">case svg of</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">-- None usually indicates that latex or another tool was misconfigured. In this case,</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">-- don't store the result.</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="nottickedoff">None -> pure None</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="nottickedoff">_ -> atomicModifyIORef cache (\m -> (Map.insert key svg m, svg))</span></span>
|
||||
<span class="lineno"> 101 </span>
|
||||
<span class="lineno"> 102 </span>encodeInt :: Int -> String
|
||||
<span class="lineno"> 103 </span><span class="decl"><span class="nottickedoff">encodeInt i = worker (fromIntegral i) 60</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="nottickedoff">worker :: Word -> Int -> String</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="nottickedoff">worker key sh</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="nottickedoff">| sh < 0 = []</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">case (key `shiftR` sh) `mod` 64 of</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="nottickedoff">idx -> alphabet !! fromIntegral idx : worker key (sh-6)</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="nottickedoff">alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+$"</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
152
reanimate-0.4.2.0-inplace/Reanimate.ColorComponents.hs.html
Normal file
152
reanimate-0.4.2.0-inplace/Reanimate.ColorComponents.hs.html
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE RecordWildCards #-}
|
||||
<span class="lineno"> 2 </span>{- |
|
||||
<span class="lineno"> 3 </span> Colors are three dimensional and can be projected into many color spaces
|
||||
<span class="lineno"> 4 </span> with different properties.
|
||||
<span class="lineno"> 5 </span>
|
||||
<span class="lineno"> 6 </span> Interpolating directly in the RGB color space is unintuitive and rarely useful.
|
||||
<span class="lineno"> 7 </span> If you want to transition through color, you most likely want either the XYZ space
|
||||
<span class="lineno"> 8 </span> (for physically accurate color transitions) or the LAB space (for esthetically
|
||||
<span class="lineno"> 9 </span> pleasing colors).
|
||||
<span class="lineno"> 10 </span>-}
|
||||
<span class="lineno"> 11 </span>module Reanimate.ColorComponents
|
||||
<span class="lineno"> 12 </span> ( ColorComponents(..)
|
||||
<span class="lineno"> 13 </span> , rgbComponents
|
||||
<span class="lineno"> 14 </span> , hsvComponents
|
||||
<span class="lineno"> 15 </span> , labComponents
|
||||
<span class="lineno"> 16 </span> , xyzComponents
|
||||
<span class="lineno"> 17 </span> , lchComponents
|
||||
<span class="lineno"> 18 </span> , interpolate
|
||||
<span class="lineno"> 19 </span> , interpolateRGB8
|
||||
<span class="lineno"> 20 </span> , interpolateRGBA8
|
||||
<span class="lineno"> 21 </span> , toRGB8
|
||||
<span class="lineno"> 22 </span> , fromRGB8
|
||||
<span class="lineno"> 23 </span> ) where
|
||||
<span class="lineno"> 24 </span>
|
||||
<span class="lineno"> 25 </span>import Codec.Picture
|
||||
<span class="lineno"> 26 </span>import Codec.Picture.Types
|
||||
<span class="lineno"> 27 </span>import Data.Colour
|
||||
<span class="lineno"> 28 </span>import Data.Colour.CIE
|
||||
<span class="lineno"> 29 </span>import Data.Colour.CIE.Illuminant (d65)
|
||||
<span class="lineno"> 30 </span>import Data.Colour.RGBSpace
|
||||
<span class="lineno"> 31 </span>import Data.Colour.RGBSpace.HSV
|
||||
<span class="lineno"> 32 </span>import Data.Colour.SRGB
|
||||
<span class="lineno"> 33 </span>import Data.Fixed
|
||||
<span class="lineno"> 34 </span>import Reanimate.Ease
|
||||
<span class="lineno"> 35 </span>
|
||||
<span class="lineno"> 36 </span>-- | Constructor and destructor for color's three components.
|
||||
<span class="lineno"> 37 </span>data ColorComponents = ColorComponents
|
||||
<span class="lineno"> 38 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">colorUnpack</span></span></span> :: Colour Double -> (Double, Double, Double)
|
||||
<span class="lineno"> 39 </span> -- ^ Unpack a color into its three components.
|
||||
<span class="lineno"> 40 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">colorPack</span></span></span> :: Double -> Double -> Double -> Colour Double
|
||||
<span class="lineno"> 41 </span> -- ^ Restore a color from three coordinates.
|
||||
<span class="lineno"> 42 </span> }
|
||||
<span class="lineno"> 43 </span>
|
||||
<span class="lineno"> 44 </span>-- | > interpolate rgbComponents yellow blue
|
||||
<span class="lineno"> 45 </span>--
|
||||
<span class="lineno"> 46 </span>-- <<docs/gifs/doc_rgbComponents.gif>>
|
||||
<span class="lineno"> 47 </span>rgbComponents :: ColorComponents
|
||||
<span class="lineno"> 48 </span><span class="decl"><span class="istickedoff">rgbComponents = ColorComponents rgbUnpack sRGB</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">rgbUnpack :: Colour Double -> (Double, Double, Double)</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="istickedoff">rgbUnpack c =</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff">case toSRGB c of</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">RGB r g b -> (r,g,b)</span></span>
|
||||
<span class="lineno"> 54 </span>
|
||||
<span class="lineno"> 55 </span>-- | > interpolate hsvComponents yellow blue
|
||||
<span class="lineno"> 56 </span>--
|
||||
<span class="lineno"> 57 </span>-- <<docs/gifs/doc_hsvComponents.gif>>
|
||||
<span class="lineno"> 58 </span>hsvComponents :: ColorComponents
|
||||
<span class="lineno"> 59 </span><span class="decl"><span class="istickedoff">hsvComponents = ColorComponents unpack pack</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff">unpack = hsvView.toSRGB</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">pack a b c = uncurryRGB sRGB $ hsv a b c</span></span>
|
||||
<span class="lineno"> 63 </span>
|
||||
<span class="lineno"> 64 </span>-- | > interpolate labComponents yellow blue
|
||||
<span class="lineno"> 65 </span>--
|
||||
<span class="lineno"> 66 </span>-- <<docs/gifs/doc_labComponents.gif>>
|
||||
<span class="lineno"> 67 </span>labComponents :: ColorComponents
|
||||
<span class="lineno"> 68 </span><span class="decl"><span class="istickedoff">labComponents = ColorComponents unpack pack</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">unpack = cieLABView d65</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="istickedoff">pack = cieLAB d65</span></span>
|
||||
<span class="lineno"> 72 </span>
|
||||
<span class="lineno"> 73 </span>-- | > interpolate xyzComponents yellow blue
|
||||
<span class="lineno"> 74 </span>--
|
||||
<span class="lineno"> 75 </span>-- <<docs/gifs/doc_xyzComponents.gif>>
|
||||
<span class="lineno"> 76 </span>xyzComponents :: ColorComponents
|
||||
<span class="lineno"> 77 </span><span class="decl"><span class="istickedoff">xyzComponents = ColorComponents cieXYZView cieXYZ</span></span>
|
||||
<span class="lineno"> 78 </span>
|
||||
<span class="lineno"> 79 </span>-- | > interpolate lchComponents yellow blue
|
||||
<span class="lineno"> 80 </span>--
|
||||
<span class="lineno"> 81 </span>-- <<docs/gifs/doc_lchComponents.gif>>
|
||||
<span class="lineno"> 82 </span>lchComponents :: ColorComponents
|
||||
<span class="lineno"> 83 </span><span class="decl"><span class="istickedoff">lchComponents = ColorComponents unpack pack</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">toDeg,toRad :: Double -> Double</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">toRad deg = deg/180 * pi</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">toDeg rad = rad/pi * 180</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">unpack :: Colour Double -> (Double, Double, Double)</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">unpack color =</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff">let (l,a,b) = cieLABView d65 color</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff">c = sqrt (a*a + b*b)</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff">h :: Double</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">h = (toDeg(atan2 b a) + 360) `mod'` 360</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">isZero = round (c*10000) == (0::Integer)</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">in (l, c, if <span class="tickonlyfalse">isZero</span> then <span class="nottickedoff">0/0</span> else h)</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">pack l c h =</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">cieLAB d65 l (cos (toRad h) * c) (sin (toRad h) * c)</span></span>
|
||||
<span class="lineno"> 98 </span>
|
||||
<span class="lineno"> 99 </span>-- | Smoothly interpolate between two colors using the given color components.
|
||||
<span class="lineno"> 100 </span>interpolate :: ColorComponents -> Colour Double -> Colour Double -> (Double -> Colour Double)
|
||||
<span class="lineno"> 101 </span><span class="decl"><span class="istickedoff">interpolate ColorComponents{..} from to = \d -></span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="istickedoff">colorPack (a1 + (a2-a1)*d) (b1 + (b2-b1)*d) (c1 + (c2-c1)*d)</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="istickedoff">(a1,b1,c1) = colorUnpack from</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="istickedoff">(a2,b2,c2) = colorUnpack to</span></span>
|
||||
<span class="lineno"> 106 </span>
|
||||
<span class="lineno"> 107 </span>-- | Convenience interpolation function for RGB8 values.
|
||||
<span class="lineno"> 108 </span>interpolateRGB8 :: ColorComponents -> PixelRGB8 -> PixelRGB8 -> (Double -> PixelRGB8)
|
||||
<span class="lineno"> 109 </span><span class="decl"><span class="istickedoff">interpolateRGB8 comps from to = toRGB8 . interpolate comps (fromRGB8 from) (fromRGB8 to)</span></span>
|
||||
<span class="lineno"> 110 </span>
|
||||
<span class="lineno"> 111 </span>-- | Convenience interpolation function for RGBA8 values.
|
||||
<span class="lineno"> 112 </span>interpolateRGBA8 :: ColorComponents -> PixelRGBA8 -> PixelRGBA8 -> (Double -> PixelRGBA8)
|
||||
<span class="lineno"> 113 </span><span class="decl"><span class="nottickedoff">interpolateRGBA8 comps from to = \t -></span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="nottickedoff">case interp t of</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="nottickedoff">PixelRGB8 r g b -></span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">let alpha = fromToS (fromIntegral $ pixelOpacity from) (fromIntegral $ pixelOpacity to) t</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">in PixelRGBA8 r g b (round alpha)</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">interp = interpolateRGB8 comps (dropTransparency from) (dropTransparency to)</span></span>
|
||||
<span class="lineno"> 120 </span>
|
||||
<span class="lineno"> 121 </span>-- | Convenience function for expressing a color as an RGB8 value.
|
||||
<span class="lineno"> 122 </span>toRGB8 :: Colour Double -> PixelRGB8
|
||||
<span class="lineno"> 123 </span><span class="decl"><span class="istickedoff">toRGB8 c = PixelRGB8 r g b</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff">RGB r g b = toSRGBBounded c</span></span>
|
||||
<span class="lineno"> 126 </span>
|
||||
<span class="lineno"> 127 </span>-- | Convenience function for expressing an RGB8 value as a color.
|
||||
<span class="lineno"> 128 </span>fromRGB8 :: PixelRGB8 -> Colour Double
|
||||
<span class="lineno"> 129 </span><span class="decl"><span class="istickedoff">fromRGB8 (PixelRGB8 r g b) = sRGB24 r g b</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
533
reanimate-0.4.2.0-inplace/Reanimate.ColorMap.hs.html
Normal file
533
reanimate-0.4.2.0-inplace/Reanimate.ColorMap.hs.html
Normal file
|
|
@ -0,0 +1,533 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE OverloadedStrings #-}
|
||||
<span class="lineno"> 2 </span>{-|
|
||||
<span class="lineno"> 3 </span> A colormap takes a number between 0 and 1 (inclusive) and spits out a color.
|
||||
<span class="lineno"> 4 </span> The colors do not have an alpha component but one can be added with
|
||||
<span class="lineno"> 5 </span> `Codec.Picture.Types.promotePixel`.
|
||||
<span class="lineno"> 6 </span>-}
|
||||
<span class="lineno"> 7 </span>module Reanimate.ColorMap
|
||||
<span class="lineno"> 8 </span> ( turbo
|
||||
<span class="lineno"> 9 </span> , viridis
|
||||
<span class="lineno"> 10 </span> , magma
|
||||
<span class="lineno"> 11 </span> , inferno
|
||||
<span class="lineno"> 12 </span> , plasma
|
||||
<span class="lineno"> 13 </span> , sinebow
|
||||
<span class="lineno"> 14 </span> , parula
|
||||
<span class="lineno"> 15 </span> , cividis
|
||||
<span class="lineno"> 16 </span> , jet
|
||||
<span class="lineno"> 17 </span> , hsv
|
||||
<span class="lineno"> 18 </span> , hsvMatlab
|
||||
<span class="lineno"> 19 </span> , greyscale
|
||||
<span class="lineno"> 20 </span> ) where
|
||||
<span class="lineno"> 21 </span>
|
||||
<span class="lineno"> 22 </span>import Data.Text (Text)
|
||||
<span class="lineno"> 23 </span>import Data.Vector (Vector)
|
||||
<span class="lineno"> 24 </span>import qualified Data.Text as T
|
||||
<span class="lineno"> 25 </span>import qualified Data.Vector as V
|
||||
<span class="lineno"> 26 </span>import Codec.Picture
|
||||
<span class="lineno"> 27 </span>import Data.Char
|
||||
<span class="lineno"> 28 </span>import Data.Bits
|
||||
<span class="lineno"> 29 </span>import qualified Data.Colour.RGBSpace.HSV as HSV
|
||||
<span class="lineno"> 30 </span>import Data.Colour.RGBSpace
|
||||
<span class="lineno"> 31 </span>
|
||||
<span class="lineno"> 32 </span>-- | Given a number t in the range [0,1], returns the corresponding color from
|
||||
<span class="lineno"> 33 </span>-- the “turbo” color scheme by Anton Mikhailov.
|
||||
<span class="lineno"> 34 </span>--
|
||||
<span class="lineno"> 35 </span>-- <<docs/gifs/doc_turbo.gif>>
|
||||
<span class="lineno"> 36 </span>turbo :: Double -> PixelRGB8
|
||||
<span class="lineno"> 37 </span><span class="decl"><span class="istickedoff">turbo t = PixelRGB8 red green blue</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">red = trunc (round (34.61 + t * (1172.33 - t * (10793.56 - t * (33300.12 - t * (38394.49 - t * 14825.05))))))</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">green = trunc (round (23.31 + t * (557.33 + t * (1225.33 - t * (3574.96 - t * (1073.77 + t * 707.56))))))</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">blue = trunc (round (27.2 + t * (3211.1 - t * (15327.97 - t * (27814 - t * (22569.18 - t * 6838.66))))))</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">trunc :: Integer -> Pixel8</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="istickedoff">trunc = fromIntegral . min 255 . max 0</span></span>
|
||||
<span class="lineno"> 44 </span>
|
||||
<span class="lineno"> 45 </span>-- | Given a number t in the range [0,1], returns the corresponding color from
|
||||
<span class="lineno"> 46 </span>-- the “viridis” perceptually-uniform color scheme designed by van der Walt,
|
||||
<span class="lineno"> 47 </span>-- Smith and Firing for matplotlib, represented as an RGB string.
|
||||
<span class="lineno"> 48 </span>--
|
||||
<span class="lineno"> 49 </span>-- <<docs/gifs/doc_viridis.gif>>
|
||||
<span class="lineno"> 50 </span>viridis :: Double -> PixelRGB8
|
||||
<span class="lineno"> 51 </span><span class="decl"><span class="istickedoff">viridis = ramp (colors</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff">"44015444025645045745055946075a46085c460a5d460b5e470d60470e614710634711644713\</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">\6548146748166848176948186a481a6c481b6d481c6e481d6f481f7048207148217348237448\</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff">\2475482576482677482878482979472a7a472c7a472d7b472e7c472f7d46307e46327e46337f\</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">\463480453581453781453882443983443a83443b84433d84433e85423f854240864241864142\</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">\874144874045884046883f47883f48893e49893e4a893e4c8a3d4d8a3d4e8a3c4f8a3c508b3b\</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">\518b3b528b3a538b3a548c39558c39568c38588c38598c375a8c375b8d365c8d365d8d355e8d\</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">\355f8d34608d34618d33628d33638d32648e32658e31668e31678e31688e30698e306a8e2f6b\</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">\8e2f6c8e2e6d8e2e6e8e2e6f8e2d708e2d718e2c718e2c728e2c738e2b748e2b758e2a768e2a\</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">\778e2a788e29798e297a8e297b8e287c8e287d8e277e8e277f8e27808e26818e26828e26828e\</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff">\25838e25848e25858e24868e24878e23888e23898e238a8d228b8d228c8d228d8d218e8d218f\</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">\8d21908d21918c20928c20928c20938c1f948c1f958b1f968b1f978b1f988b1f998a1f9a8a1e\</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff">\9b8a1e9c891e9d891f9e891f9f881fa0881fa1881fa1871fa28720a38620a48621a58521a685\</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="istickedoff">\22a78522a88423a98324aa8325ab8225ac8226ad8127ad8128ae8029af7f2ab07f2cb17e2db2\</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="istickedoff">\7d2eb37c2fb47c31b57b32b67a34b67935b77937b87838b9773aba763bbb753dbc743fbc7340\</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="istickedoff">\bd7242be7144bf7046c06f48c16e4ac16d4cc26c4ec36b50c46a52c56954c56856c66758c765\</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">\5ac8645cc8635ec96260ca6063cb5f65cb5e67cc5c69cd5b6ccd5a6ece5870cf5773d05675d0\</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff">\5477d1537ad1517cd2507fd34e81d34d84d44b86d54989d5488bd6468ed64590d74393d74195\</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="istickedoff">\d84098d83e9bd93c9dd93ba0da39a2da37a5db36a8db34aadc32addc30b0dd2fb2dd2db5de2b\</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">\b8de29bade28bddf26c0df25c2df23c5e021c8e020cae11fcde11dd0e11cd2e21bd5e21ad8e2\</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="istickedoff">\19dae319dde318dfe318e2e418e5e419e7e419eae51aece51befe51cf1e51df4e61ef6e620f8\</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="istickedoff">\e621fbe723fde725")</span></span>
|
||||
<span class="lineno"> 73 </span>
|
||||
<span class="lineno"> 74 </span>-- | Given a number t in the range [0,1], returns the corresponding color from
|
||||
<span class="lineno"> 75 </span>-- the “magma” perceptually-uniform color scheme designed by van der Walt and
|
||||
<span class="lineno"> 76 </span>-- Smith for matplotlib, represented as an RGB string.
|
||||
<span class="lineno"> 77 </span>--
|
||||
<span class="lineno"> 78 </span>-- <<docs/gifs/doc_magma.gif>>
|
||||
<span class="lineno"> 79 </span>magma :: Double -> PixelRGB8
|
||||
<span class="lineno"> 80 </span><span class="decl"><span class="istickedoff">magma = ramp (colors</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="istickedoff">"00000401000501010601010802010902020b02020d03030f0303120404140504160605180605\</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">\1a07061c08071e0907200a08220b09240c09260d0a290e0b2b100b2d110c2f120d31130d3414\</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">\0e36150e38160f3b180f3d19103f1a10421c10441d11471e114920114b21114e221150241253\</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">\25125527125829115a2a115c2c115f2d11612f116331116533106734106936106b38106c390f\</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">\6e3b0f703d0f713f0f72400f74420f75440f764510774710784910784a10794c117a4e117b4f\</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">\127b51127c52137c54137d56147d57157e59157e5a167e5c167f5d177f5f187f601880621980\</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">\641a80651a80671b80681c816a1c816b1d816d1d816e1e81701f81721f817320817521817621\</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">\817822817922827b23827c23827e24828025828125818326818426818627818827818928818b\</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">\29818c29818e2a81902a81912b81932b80942c80962c80982d80992d809b2e7f9c2e7f9e2f7f\</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff">\a02f7fa1307ea3307ea5317ea6317da8327daa337dab337cad347cae347bb0357bb2357bb336\</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff">\7ab5367ab73779b83779ba3878bc3978bd3977bf3a77c03a76c23b75c43c75c53c74c73d73c8\</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff">\3e73ca3e72cc3f71cd4071cf4070d0416fd2426fd3436ed5446dd6456cd8456cd9466bdb476a\</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">\dc4869de4968df4a68e04c67e24d66e34e65e44f64e55064e75263e85362e95462ea5661eb57\</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">\60ec5860ed5a5fee5b5eef5d5ef05f5ef1605df2625df2645cf3655cf4675cf4695cf56b5cf6\</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">\6c5cf66e5cf7705cf7725cf8745cf8765cf9785df9795df97b5dfa7d5efa7f5efa815ffb835f\</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">\fb8560fb8761fc8961fc8a62fc8c63fc8e64fc9065fd9266fd9467fd9668fd9869fd9a6afd9b\</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">\6bfe9d6cfe9f6dfea16efea36ffea571fea772fea973feaa74feac76feae77feb078feb27afe\</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">\b47bfeb67cfeb77efeb97ffebb81febd82febf84fec185fec287fec488fec68afec88cfeca8d\</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff">\fecc8ffecd90fecf92fed194fed395fed597fed799fed89afdda9cfddc9efddea0fde0a1fde2\</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="istickedoff">\a3fde3a5fde5a7fde7a9fde9aafdebacfcecaefceeb0fcf0b2fcf2b4fcf4b6fcf6b8fcf7b9fc\</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="istickedoff">\f9bbfcfbbdfcfdbf")</span></span>
|
||||
<span class="lineno"> 102 </span>
|
||||
<span class="lineno"> 103 </span>-- | Given a number t in the range [0,1], returns the corresponding color from
|
||||
<span class="lineno"> 104 </span>-- the “inferno” perceptually-uniform color scheme designed by van der Walt
|
||||
<span class="lineno"> 105 </span>-- and Smith for matplotlib, represented as an RGB string.
|
||||
<span class="lineno"> 106 </span>--
|
||||
<span class="lineno"> 107 </span>-- <<docs/gifs/doc_inferno.gif>>
|
||||
<span class="lineno"> 108 </span>inferno :: Double -> PixelRGB8
|
||||
<span class="lineno"> 109 </span><span class="decl"><span class="istickedoff">inferno = ramp (colors</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff">"00000401000501010601010802010a02020c02020e0302100403120403140504170604190705\</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">\1b08051d09061f0a07220b07240c08260d08290e092b10092d110a30120a32140b34150b3716\</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff">\0b39180c3c190c3e1b0c411c0c431e0c451f0c48210c4a230c4c240c4f260c51280b53290b55\</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff">\2b0b572d0b592f0a5b310a5c320a5e340a5f3609613809623909633b09643d09653e0966400a\</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff">\67420a68440a68450a69470b6a490b6a4a0c6b4c0c6b4d0d6c4f0d6c510e6c520e6d540f6d55\</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">\0f6d57106e59106e5a116e5c126e5d126e5f136e61136e62146e64156e65156e67166e69166e\</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">\6a176e6c186e6d186e6f196e71196e721a6e741a6e751b6e771c6d781c6d7a1d6d7c1d6d7d1e\</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">\6d7f1e6c801f6c82206c84206b85216b87216b88226a8a226a8c23698d23698f246990256892\</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">\25689326679526679727669827669a28659b29649d29649f2a63a02a63a22b62a32c61a52c60\</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">\a62d60a82e5fa92e5eab2f5ead305dae305cb0315bb1325ab3325ab43359b63458b73557b935\</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff">\56ba3655bc3754bd3853bf3952c03a51c13a50c33b4fc43c4ec63d4dc73e4cc83f4bca404acb\</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff">\4149cc4248ce4347cf4446d04545d24644d34743d44842d54a41d74b3fd84c3ed94d3dda4e3c\</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff">\db503bdd513ade5238df5337e05536e15635e25734e35933e45a31e55c30e65d2fe75e2ee860\</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff">\2de9612bea632aeb6429eb6628ec6726ed6925ee6a24ef6c23ef6e21f06f20f1711ff1731df2\</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff">\741cf3761bf37819f47918f57b17f57d15f67e14f68013f78212f78410f8850ff8870ef8890c\</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff">\f98b0bf98c0af98e09fa9008fa9207fa9407fb9606fb9706fb9906fb9b06fb9d07fc9f07fca1\</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="istickedoff">\08fca309fca50afca60cfca80dfcaa0ffcac11fcae12fcb014fcb216fcb418fbb61afbb81dfb\</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff">\ba1ffbbc21fbbe23fac026fac228fac42afac62df9c72ff9c932f9cb35f8cd37f8cf3af7d13d\</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff">\f7d340f6d543f6d746f5d949f5db4cf4dd4ff4df53f4e156f3e35af3e55df2e661f2e865f2ea\</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff">\69f1ec6df1ed71f1ef75f1f179f2f27df2f482f3f586f3f68af4f88ef5f992f6fa96f8fb9af9\</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff">\fc9dfafda1fcffa4")</span></span>
|
||||
<span class="lineno"> 131 </span>
|
||||
<span class="lineno"> 132 </span>-- | Given a number t in the range [0,1], returns the corresponding color from
|
||||
<span class="lineno"> 133 </span>-- the “plasma” perceptually-uniform color scheme designed by van der Walt and
|
||||
<span class="lineno"> 134 </span>-- Smith for matplotlib, represented as an RGB string.
|
||||
<span class="lineno"> 135 </span>--
|
||||
<span class="lineno"> 136 </span>-- <<docs/gifs/doc_plasma.gif>>
|
||||
<span class="lineno"> 137 </span>plasma :: Double -> PixelRGB8
|
||||
<span class="lineno"> 138 </span><span class="decl"><span class="istickedoff">plasma = ramp (colors</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff">"0d088710078813078916078a19068c1b068d1d068e20068f2206902406912605912805922a05\</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff">\932c05942e05952f059631059733059735049837049938049a3a049a3c049b3e049c3f049c41\</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff">\049d43039e44039e46039f48039f4903a04b03a14c02a14e02a25002a25102a35302a35502a4\</span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff">\5601a45801a45901a55b01a55c01a65e01a66001a66100a76300a76400a76600a76700a86900\</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff">\a86a00a86c00a86e00a86f00a87100a87201a87401a87501a87701a87801a87a02a87b02a87d\</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff">\03a87e03a88004a88104a78305a78405a78606a68707a68808a68a09a58b0aa58d0ba58e0ca4\</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff">\8f0da4910ea3920fa39410a29511a19613a19814a099159f9a169f9c179e9d189d9e199da01a\</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff">\9ca11b9ba21d9aa31e9aa51f99a62098a72197a82296aa2395ab2494ac2694ad2793ae2892b0\</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff">\2991b12a90b22b8fb32c8eb42e8db52f8cb6308bb7318ab83289ba3388bb3488bc3587bd3786\</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff">\be3885bf3984c03a83c13b82c23c81c33d80c43e7fc5407ec6417dc7427cc8437bc9447aca45\</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff">\7acb4679cc4778cc4977cd4a76ce4b75cf4c74d04d73d14e72d24f71d35171d45270d5536fd5\</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="istickedoff">\546ed6556dd7566cd8576bd9586ada5a6ada5b69db5c68dc5d67dd5e66de5f65de6164df6263\</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="istickedoff">\e06363e16462e26561e26660e3685fe4695ee56a5de56b5de66c5ce76e5be76f5ae87059e971\</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff">\58e97257ea7457eb7556eb7655ec7754ed7953ed7a52ee7b51ef7c51ef7e50f07f4ff0804ef1\</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="istickedoff">\814df1834cf2844bf3854bf3874af48849f48948f58b47f58c46f68d45f68f44f79044f79143\</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff">\f79342f89441f89540f9973ff9983ef99a3efa9b3dfa9c3cfa9e3bfb9f3afba139fba238fca3\</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff">\38fca537fca636fca835fca934fdab33fdac33fdae32fdaf31fdb130fdb22ffdb42ffdb52efe\</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff">\b72dfeb82cfeba2cfebb2bfebd2afebe2afec029fdc229fdc328fdc527fdc627fdc827fdca26\</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="istickedoff">\fdcb26fccd25fcce25fcd025fcd225fbd324fbd524fbd724fad824fada24f9dc24f9dd25f8df\</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="istickedoff">\25f8e125f7e225f7e425f6e626f6e826f5e926f5eb27f4ed27f3ee27f3f027f2f227f1f426f1\</span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="istickedoff">\f525f0f724f0f921")</span></span>
|
||||
<span class="lineno"> 160 </span>
|
||||
<span class="lineno"> 161 </span>-- | Given a number t in the range [0,1], returns the corresponding color from
|
||||
<span class="lineno"> 162 </span>-- the “sinebow” color scheme by Jim Bumgardner and Charlie Loyd.
|
||||
<span class="lineno"> 163 </span>--
|
||||
<span class="lineno"> 164 </span>-- <<docs/gifs/doc_sinebow.gif>>
|
||||
<span class="lineno"> 165 </span>sinebow :: Double -> PixelRGB8
|
||||
<span class="lineno"> 166 </span><span class="decl"><span class="istickedoff">sinebow t = PixelRGB8 r g b</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="istickedoff">pi_1_3 = pi / 3</span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="istickedoff">pi_2_3 = pi * 2 / 3</span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="istickedoff">x = (0.5 - t) * pi</span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="istickedoff">r = round $ 255 * sin x**2</span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="istickedoff">g = round $ 255 * sin (x+pi_1_3)**2</span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="istickedoff">b = round $ 255 * sin (x+pi_2_3)**2</span></span>
|
||||
<span class="lineno"> 174 </span>
|
||||
<span class="lineno"> 175 </span>-- | Given a number t in the range [0,1], returns the corresponding color from
|
||||
<span class="lineno"> 176 </span>-- the “cividis” color vision deficiency-optimized color scheme designed by
|
||||
<span class="lineno"> 177 </span>-- Nuñez, Anderton, and Renslow, represented as an RGB string.
|
||||
<span class="lineno"> 178 </span>--
|
||||
<span class="lineno"> 179 </span>-- <<docs/gifs/doc_cividis.gif>>
|
||||
<span class="lineno"> 180 </span>cividis :: Double -> PixelRGB8
|
||||
<span class="lineno"> 181 </span><span class="decl"><span class="istickedoff">cividis t = PixelRGB8 red green blue</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="istickedoff">red = trunc $ round(-4.54 - t * (35.34 - t * (2381.73 - t * (6402.7 - t * (7024.72 - t * 2710.57)))))</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff">green = trunc $ round(32.49 + t * (170.73 + t * (52.82 - t * (131.46 - t * (176.58 - t * 67.37)))))</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff">blue = trunc $ round(81.24 + t * (442.36 - t * (2482.43 - t * (6167.24 - t * (6614.94 - t * 2475.67)))))</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="istickedoff">trunc :: Integer -> Pixel8</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="istickedoff">trunc = fromIntegral . min 255 . max 0</span></span>
|
||||
<span class="lineno"> 188 </span>
|
||||
<span class="lineno"> 189 </span>-- | Jet colormap. Used to be the default in matlab. Obsolete.
|
||||
<span class="lineno"> 190 </span>--
|
||||
<span class="lineno"> 191 </span>-- <<docs/gifs/doc_jet.gif>>
|
||||
<span class="lineno"> 192 </span>jet :: Double -> PixelRGB8
|
||||
<span class="lineno"> 193 </span><span class="decl"><span class="istickedoff">jet t = PixelRGB8 red green blue</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff">red = trunc $ min (4*t - 1.5) (-4*t + 4.5)</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="istickedoff">green = trunc $ min (4*t - 0.5) (-4*t + 3.5)</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="istickedoff">blue = trunc $ min (4*t + 0.5) (-4*t + 2.5)</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff">trunc :: Double -> Pixel8</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff">trunc = round . min 255 . max 0 . (*) 255</span></span>
|
||||
<span class="lineno"> 200 </span>
|
||||
<span class="lineno"> 201 </span>-- | hsv colormap. Goes from 0 degrees to 360 degrees.
|
||||
<span class="lineno"> 202 </span>--
|
||||
<span class="lineno"> 203 </span>-- <<docs/gifs/doc_hsv.gif>>
|
||||
<span class="lineno"> 204 </span>hsv :: Double -> PixelRGB8
|
||||
<span class="lineno"> 205 </span><span class="decl"><span class="istickedoff">hsv t = PixelRGB8 (round $ r*255) (round $ g*255) (round $ b*255)</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="istickedoff">RGB r g b = HSV.hsv (t * 360) 1 1</span></span>
|
||||
<span class="lineno"> 208 </span>
|
||||
<span class="lineno"> 209 </span>-- | Matlab hsv colormap. Goes from 0 degrees to 330 degrees.
|
||||
<span class="lineno"> 210 </span>--
|
||||
<span class="lineno"> 211 </span>-- <<docs/gifs/doc_hsvMatlab.gif>>
|
||||
<span class="lineno"> 212 </span>hsvMatlab :: Double -> PixelRGB8
|
||||
<span class="lineno"> 213 </span><span class="decl"><span class="istickedoff">hsvMatlab t = PixelRGB8 (round $ r*255) (round $ g*255) (round $ b*255)</span>
|
||||
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="istickedoff">RGB r g b = HSV.hsv (t * 330) 1 1</span></span>
|
||||
<span class="lineno"> 216 </span>
|
||||
<span class="lineno"> 217 </span>-- | Greyscale colormap.
|
||||
<span class="lineno"> 218 </span>--
|
||||
<span class="lineno"> 219 </span>-- <<docs/gifs/doc_greyscale.gif>>
|
||||
<span class="lineno"> 220 </span>greyscale :: Double -> PixelRGB8
|
||||
<span class="lineno"> 221 </span><span class="decl"><span class="istickedoff">greyscale t = PixelRGB8 v v v</span>
|
||||
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="istickedoff">v = round $ t * 255</span></span>
|
||||
<span class="lineno"> 224 </span>
|
||||
<span class="lineno"> 225 </span>-- | Parula is the default colormap for matlab.
|
||||
<span class="lineno"> 226 </span>--
|
||||
<span class="lineno"> 227 </span>-- <<docs/gifs/doc_parula.gif>>
|
||||
<span class="lineno"> 228 </span>parula :: Double -> PixelRGB8
|
||||
<span class="lineno"> 229 </span><span class="decl"><span class="istickedoff">parula = ramp vec</span>
|
||||
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="istickedoff">vec = V.fromList $ pixels colorList</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="istickedoff">pixels [] = []</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="istickedoff">pixels (r:g:b:xs) =</span>
|
||||
<span class="lineno"> 234 </span><span class="spaces"> </span><span class="istickedoff">PixelRGB8 (round $ r*255) (round $ g*255) (round $ b*255) :</span>
|
||||
<span class="lineno"> 235 </span><span class="spaces"> </span><span class="istickedoff">pixels xs</span>
|
||||
<span class="lineno"> 236 </span><span class="spaces"> </span><span class="istickedoff">pixels _ = <span class="nottickedoff">error "Reanimate.ColorMap.parula: Broken data"</span></span>
|
||||
<span class="lineno"> 237 </span><span class="spaces"> </span><span class="istickedoff">colorList :: [Double]</span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="istickedoff">colorList =</span>
|
||||
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="istickedoff">[0.2081, 0.1663, 0.5292</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="istickedoff">,0.2091, 0.1721, 0.5411</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="istickedoff">,0.2101, 0.1779, 0.5530</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="istickedoff">,0.2109, 0.1837, 0.5650</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="istickedoff">,0.2116, 0.1895, 0.5771</span>
|
||||
<span class="lineno"> 244 </span><span class="spaces"> </span><span class="istickedoff">,0.2121, 0.1954, 0.5892</span>
|
||||
<span class="lineno"> 245 </span><span class="spaces"> </span><span class="istickedoff">,0.2124, 0.2013, 0.6013</span>
|
||||
<span class="lineno"> 246 </span><span class="spaces"> </span><span class="istickedoff">,0.2125, 0.2072, 0.6135</span>
|
||||
<span class="lineno"> 247 </span><span class="spaces"> </span><span class="istickedoff">,0.2123, 0.2132, 0.6258</span>
|
||||
<span class="lineno"> 248 </span><span class="spaces"> </span><span class="istickedoff">,0.2118, 0.2192, 0.6381</span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="istickedoff">,0.2111, 0.2253, 0.6505</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="istickedoff">,0.2099, 0.2315, 0.6629</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="istickedoff">,0.2084, 0.2377, 0.6753</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="istickedoff">,0.2063, 0.2440, 0.6878</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="istickedoff">,0.2038, 0.2503, 0.7003</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="istickedoff">,0.2006, 0.2568, 0.7129</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="istickedoff">,0.1968, 0.2632, 0.7255</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="istickedoff">,0.1921, 0.2698, 0.7381</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="istickedoff">,0.1867, 0.2764, 0.7507</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="istickedoff">,0.1802, 0.2832, 0.7634</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="istickedoff">,0.1728, 0.2902, 0.7762</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="istickedoff">,0.1641, 0.2975, 0.7890</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="istickedoff">,0.1541, 0.3052, 0.8017</span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="istickedoff">,0.1427, 0.3132, 0.8145</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">,0.1295, 0.3217, 0.8269</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="istickedoff">,0.1147, 0.3306, 0.8387</span>
|
||||
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="istickedoff">,0.0986, 0.3397, 0.8495</span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="istickedoff">,0.0816, 0.3486, 0.8588</span>
|
||||
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="istickedoff">,0.0646, 0.3572, 0.8664</span>
|
||||
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="istickedoff">,0.0482, 0.3651, 0.8722</span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="istickedoff">,0.0329, 0.3724, 0.8765</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="istickedoff">,0.0213, 0.3792, 0.8796</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">,0.0136, 0.3853, 0.8815</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">,0.0086, 0.3911, 0.8827</span>
|
||||
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="istickedoff">,0.0060, 0.3965, 0.8833</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="istickedoff">,0.0051, 0.4017, 0.8834</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="istickedoff">,0.0054, 0.4066, 0.8831</span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="istickedoff">,0.0067, 0.4113, 0.8825</span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="istickedoff">,0.0089, 0.4159, 0.8816</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="istickedoff">,0.0116, 0.4203, 0.8805</span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="istickedoff">,0.0148, 0.4246, 0.8793</span>
|
||||
<span class="lineno"> 280 </span><span class="spaces"> </span><span class="istickedoff">,0.0184, 0.4288, 0.8779</span>
|
||||
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="istickedoff">,0.0223, 0.4329, 0.8763</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="istickedoff">,0.0264, 0.4370, 0.8747</span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="istickedoff">,0.0306, 0.4410, 0.8729</span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="istickedoff">,0.0349, 0.4449, 0.8711</span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="istickedoff">,0.0394, 0.4488, 0.8692</span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="istickedoff">,0.0437, 0.4526, 0.8672</span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="istickedoff">,0.0477, 0.4564, 0.8652</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="istickedoff">,0.0514, 0.4602, 0.8632</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="istickedoff">,0.0549, 0.4640, 0.8611</span>
|
||||
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="istickedoff">,0.0582, 0.4677, 0.8589</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="istickedoff">,0.0612, 0.4714, 0.8568</span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="istickedoff">,0.0640, 0.4751, 0.8546</span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="istickedoff">,0.0666, 0.4788, 0.8525</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="istickedoff">,0.0689, 0.4825, 0.8503</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="istickedoff">,0.0710, 0.4862, 0.8481</span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="istickedoff">,0.0729, 0.4899, 0.8460</span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="istickedoff">,0.0746, 0.4937, 0.8439</span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="istickedoff">,0.0761, 0.4974, 0.8418</span>
|
||||
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="istickedoff">,0.0773, 0.5012, 0.8398</span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="istickedoff">,0.0782, 0.5051, 0.8378</span>
|
||||
<span class="lineno"> 301 </span><span class="spaces"> </span><span class="istickedoff">,0.0789, 0.5089, 0.8359</span>
|
||||
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="istickedoff">,0.0794, 0.5129, 0.8341</span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="istickedoff">,0.0795, 0.5169, 0.8324</span>
|
||||
<span class="lineno"> 304 </span><span class="spaces"> </span><span class="istickedoff">,0.0793, 0.5210, 0.8308</span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="istickedoff">,0.0788, 0.5251, 0.8293</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="istickedoff">,0.0778, 0.5295, 0.8280</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="istickedoff">,0.0764, 0.5339, 0.8270</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="istickedoff">,0.0746, 0.5384, 0.8261</span>
|
||||
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="istickedoff">,0.0724, 0.5431, 0.8253</span>
|
||||
<span class="lineno"> 310 </span><span class="spaces"> </span><span class="istickedoff">,0.0698, 0.5479, 0.8247</span>
|
||||
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="istickedoff">,0.0668, 0.5527, 0.8243</span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="istickedoff">,0.0636, 0.5577, 0.8239</span>
|
||||
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="istickedoff">,0.0600, 0.5627, 0.8237</span>
|
||||
<span class="lineno"> 314 </span><span class="spaces"> </span><span class="istickedoff">,0.0562, 0.5677, 0.8234</span>
|
||||
<span class="lineno"> 315 </span><span class="spaces"> </span><span class="istickedoff">,0.0523, 0.5727, 0.8231</span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="istickedoff">,0.0484, 0.5777, 0.8228</span>
|
||||
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="istickedoff">,0.0445, 0.5826, 0.8223</span>
|
||||
<span class="lineno"> 318 </span><span class="spaces"> </span><span class="istickedoff">,0.0408, 0.5874, 0.8217</span>
|
||||
<span class="lineno"> 319 </span><span class="spaces"> </span><span class="istickedoff">,0.0372, 0.5922, 0.8209</span>
|
||||
<span class="lineno"> 320 </span><span class="spaces"> </span><span class="istickedoff">,0.0342, 0.5968, 0.8198</span>
|
||||
<span class="lineno"> 321 </span><span class="spaces"> </span><span class="istickedoff">,0.0317, 0.6012, 0.8186</span>
|
||||
<span class="lineno"> 322 </span><span class="spaces"> </span><span class="istickedoff">,0.0296, 0.6055, 0.8171</span>
|
||||
<span class="lineno"> 323 </span><span class="spaces"> </span><span class="istickedoff">,0.0279, 0.6097, 0.8154</span>
|
||||
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="istickedoff">,0.0265, 0.6137, 0.8135</span>
|
||||
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="istickedoff">,0.0255, 0.6176, 0.8114</span>
|
||||
<span class="lineno"> 326 </span><span class="spaces"> </span><span class="istickedoff">,0.0248, 0.6214, 0.8091</span>
|
||||
<span class="lineno"> 327 </span><span class="spaces"> </span><span class="istickedoff">,0.0243, 0.6250, 0.8066</span>
|
||||
<span class="lineno"> 328 </span><span class="spaces"> </span><span class="istickedoff">,0.0239, 0.6285, 0.8039</span>
|
||||
<span class="lineno"> 329 </span><span class="spaces"> </span><span class="istickedoff">,0.0237, 0.6319, 0.8010</span>
|
||||
<span class="lineno"> 330 </span><span class="spaces"> </span><span class="istickedoff">,0.0235, 0.6352, 0.7980</span>
|
||||
<span class="lineno"> 331 </span><span class="spaces"> </span><span class="istickedoff">,0.0233, 0.6384, 0.7948</span>
|
||||
<span class="lineno"> 332 </span><span class="spaces"> </span><span class="istickedoff">,0.0231, 0.6415, 0.7916</span>
|
||||
<span class="lineno"> 333 </span><span class="spaces"> </span><span class="istickedoff">,0.0230, 0.6445, 0.7881</span>
|
||||
<span class="lineno"> 334 </span><span class="spaces"> </span><span class="istickedoff">,0.0229, 0.6474, 0.7846</span>
|
||||
<span class="lineno"> 335 </span><span class="spaces"> </span><span class="istickedoff">,0.0227, 0.6503, 0.7810</span>
|
||||
<span class="lineno"> 336 </span><span class="spaces"> </span><span class="istickedoff">,0.0227, 0.6531, 0.7773</span>
|
||||
<span class="lineno"> 337 </span><span class="spaces"> </span><span class="istickedoff">,0.0232, 0.6558, 0.7735</span>
|
||||
<span class="lineno"> 338 </span><span class="spaces"> </span><span class="istickedoff">,0.0238, 0.6585, 0.7696</span>
|
||||
<span class="lineno"> 339 </span><span class="spaces"> </span><span class="istickedoff">,0.0246, 0.6611, 0.7656</span>
|
||||
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="istickedoff">,0.0263, 0.6637, 0.7615</span>
|
||||
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="istickedoff">,0.0282, 0.6663, 0.7574</span>
|
||||
<span class="lineno"> 342 </span><span class="spaces"> </span><span class="istickedoff">,0.0306, 0.6688, 0.7532</span>
|
||||
<span class="lineno"> 343 </span><span class="spaces"> </span><span class="istickedoff">,0.0338, 0.6712, 0.7490</span>
|
||||
<span class="lineno"> 344 </span><span class="spaces"> </span><span class="istickedoff">,0.0373, 0.6737, 0.7446</span>
|
||||
<span class="lineno"> 345 </span><span class="spaces"> </span><span class="istickedoff">,0.0418, 0.6761, 0.7402</span>
|
||||
<span class="lineno"> 346 </span><span class="spaces"> </span><span class="istickedoff">,0.0467, 0.6784, 0.7358</span>
|
||||
<span class="lineno"> 347 </span><span class="spaces"> </span><span class="istickedoff">,0.0516, 0.6808, 0.7313</span>
|
||||
<span class="lineno"> 348 </span><span class="spaces"> </span><span class="istickedoff">,0.0574, 0.6831, 0.7267</span>
|
||||
<span class="lineno"> 349 </span><span class="spaces"> </span><span class="istickedoff">,0.0629, 0.6854, 0.7221</span>
|
||||
<span class="lineno"> 350 </span><span class="spaces"> </span><span class="istickedoff">,0.0692, 0.6877, 0.7173</span>
|
||||
<span class="lineno"> 351 </span><span class="spaces"> </span><span class="istickedoff">,0.0755, 0.6899, 0.7126</span>
|
||||
<span class="lineno"> 352 </span><span class="spaces"> </span><span class="istickedoff">,0.0820, 0.6921, 0.7078</span>
|
||||
<span class="lineno"> 353 </span><span class="spaces"> </span><span class="istickedoff">,0.0889, 0.6943, 0.7029</span>
|
||||
<span class="lineno"> 354 </span><span class="spaces"> </span><span class="istickedoff">,0.0956, 0.6965, 0.6979</span>
|
||||
<span class="lineno"> 355 </span><span class="spaces"> </span><span class="istickedoff">,0.1031, 0.6986, 0.6929</span>
|
||||
<span class="lineno"> 356 </span><span class="spaces"> </span><span class="istickedoff">,0.1104, 0.7007, 0.6878</span>
|
||||
<span class="lineno"> 357 </span><span class="spaces"> </span><span class="istickedoff">,0.1180, 0.7028, 0.6827</span>
|
||||
<span class="lineno"> 358 </span><span class="spaces"> </span><span class="istickedoff">,0.1258, 0.7049, 0.6775</span>
|
||||
<span class="lineno"> 359 </span><span class="spaces"> </span><span class="istickedoff">,0.1335, 0.7069, 0.6723</span>
|
||||
<span class="lineno"> 360 </span><span class="spaces"> </span><span class="istickedoff">,0.1418, 0.7089, 0.6669</span>
|
||||
<span class="lineno"> 361 </span><span class="spaces"> </span><span class="istickedoff">,0.1499, 0.7109, 0.6616</span>
|
||||
<span class="lineno"> 362 </span><span class="spaces"> </span><span class="istickedoff">,0.1585, 0.7129, 0.6561</span>
|
||||
<span class="lineno"> 363 </span><span class="spaces"> </span><span class="istickedoff">,0.1671, 0.7148, 0.6507</span>
|
||||
<span class="lineno"> 364 </span><span class="spaces"> </span><span class="istickedoff">,0.1758, 0.7168, 0.6451</span>
|
||||
<span class="lineno"> 365 </span><span class="spaces"> </span><span class="istickedoff">,0.1849, 0.7186, 0.6395</span>
|
||||
<span class="lineno"> 366 </span><span class="spaces"> </span><span class="istickedoff">,0.1938, 0.7205, 0.6338</span>
|
||||
<span class="lineno"> 367 </span><span class="spaces"> </span><span class="istickedoff">,0.2033, 0.7223, 0.6281</span>
|
||||
<span class="lineno"> 368 </span><span class="spaces"> </span><span class="istickedoff">,0.2128, 0.7241, 0.6223</span>
|
||||
<span class="lineno"> 369 </span><span class="spaces"> </span><span class="istickedoff">,0.2224, 0.7259, 0.6165</span>
|
||||
<span class="lineno"> 370 </span><span class="spaces"> </span><span class="istickedoff">,0.2324, 0.7275, 0.6107</span>
|
||||
<span class="lineno"> 371 </span><span class="spaces"> </span><span class="istickedoff">,0.2423, 0.7292, 0.6048</span>
|
||||
<span class="lineno"> 372 </span><span class="spaces"> </span><span class="istickedoff">,0.2527, 0.7308, 0.5988</span>
|
||||
<span class="lineno"> 373 </span><span class="spaces"> </span><span class="istickedoff">,0.2631, 0.7324, 0.5929</span>
|
||||
<span class="lineno"> 374 </span><span class="spaces"> </span><span class="istickedoff">,0.2735, 0.7339, 0.5869</span>
|
||||
<span class="lineno"> 375 </span><span class="spaces"> </span><span class="istickedoff">,0.2845, 0.7354, 0.5809</span>
|
||||
<span class="lineno"> 376 </span><span class="spaces"> </span><span class="istickedoff">,0.2953, 0.7368, 0.5749</span>
|
||||
<span class="lineno"> 377 </span><span class="spaces"> </span><span class="istickedoff">,0.3064, 0.7381, 0.5689</span>
|
||||
<span class="lineno"> 378 </span><span class="spaces"> </span><span class="istickedoff">,0.3177, 0.7394, 0.5630</span>
|
||||
<span class="lineno"> 379 </span><span class="spaces"> </span><span class="istickedoff">,0.3289, 0.7406, 0.5570</span>
|
||||
<span class="lineno"> 380 </span><span class="spaces"> </span><span class="istickedoff">,0.3405, 0.7417, 0.5512</span>
|
||||
<span class="lineno"> 381 </span><span class="spaces"> </span><span class="istickedoff">,0.3520, 0.7428, 0.5453</span>
|
||||
<span class="lineno"> 382 </span><span class="spaces"> </span><span class="istickedoff">,0.3635, 0.7438, 0.5396</span>
|
||||
<span class="lineno"> 383 </span><span class="spaces"> </span><span class="istickedoff">,0.3753, 0.7446, 0.5339</span>
|
||||
<span class="lineno"> 384 </span><span class="spaces"> </span><span class="istickedoff">,0.3869, 0.7454, 0.5283</span>
|
||||
<span class="lineno"> 385 </span><span class="spaces"> </span><span class="istickedoff">,0.3986, 0.7461, 0.5229</span>
|
||||
<span class="lineno"> 386 </span><span class="spaces"> </span><span class="istickedoff">,0.4103, 0.7467, 0.5175</span>
|
||||
<span class="lineno"> 387 </span><span class="spaces"> </span><span class="istickedoff">,0.4218, 0.7473, 0.5123</span>
|
||||
<span class="lineno"> 388 </span><span class="spaces"> </span><span class="istickedoff">,0.4334, 0.7477, 0.5072</span>
|
||||
<span class="lineno"> 389 </span><span class="spaces"> </span><span class="istickedoff">,0.4447, 0.7482, 0.5021</span>
|
||||
<span class="lineno"> 390 </span><span class="spaces"> </span><span class="istickedoff">,0.4561, 0.7485, 0.4972</span>
|
||||
<span class="lineno"> 391 </span><span class="spaces"> </span><span class="istickedoff">,0.4672, 0.7487, 0.4924</span>
|
||||
<span class="lineno"> 392 </span><span class="spaces"> </span><span class="istickedoff">,0.4783, 0.7489, 0.4877</span>
|
||||
<span class="lineno"> 393 </span><span class="spaces"> </span><span class="istickedoff">,0.4892, 0.7491, 0.4831</span>
|
||||
<span class="lineno"> 394 </span><span class="spaces"> </span><span class="istickedoff">,0.5000, 0.7491, 0.4786</span>
|
||||
<span class="lineno"> 395 </span><span class="spaces"> </span><span class="istickedoff">,0.5106, 0.7492, 0.4741</span>
|
||||
<span class="lineno"> 396 </span><span class="spaces"> </span><span class="istickedoff">,0.5212, 0.7492, 0.4698</span>
|
||||
<span class="lineno"> 397 </span><span class="spaces"> </span><span class="istickedoff">,0.5315, 0.7491, 0.4655</span>
|
||||
<span class="lineno"> 398 </span><span class="spaces"> </span><span class="istickedoff">,0.5418, 0.7490, 0.4613</span>
|
||||
<span class="lineno"> 399 </span><span class="spaces"> </span><span class="istickedoff">,0.5519, 0.7489, 0.4571</span>
|
||||
<span class="lineno"> 400 </span><span class="spaces"> </span><span class="istickedoff">,0.5619, 0.7487, 0.4531</span>
|
||||
<span class="lineno"> 401 </span><span class="spaces"> </span><span class="istickedoff">,0.5718, 0.7485, 0.4490</span>
|
||||
<span class="lineno"> 402 </span><span class="spaces"> </span><span class="istickedoff">,0.5816, 0.7482, 0.4451</span>
|
||||
<span class="lineno"> 403 </span><span class="spaces"> </span><span class="istickedoff">,0.5913, 0.7479, 0.4412</span>
|
||||
<span class="lineno"> 404 </span><span class="spaces"> </span><span class="istickedoff">,0.6009, 0.7476, 0.4374</span>
|
||||
<span class="lineno"> 405 </span><span class="spaces"> </span><span class="istickedoff">,0.6103, 0.7473, 0.4335</span>
|
||||
<span class="lineno"> 406 </span><span class="spaces"> </span><span class="istickedoff">,0.6197, 0.7469, 0.4298</span>
|
||||
<span class="lineno"> 407 </span><span class="spaces"> </span><span class="istickedoff">,0.6290, 0.7465, 0.4261</span>
|
||||
<span class="lineno"> 408 </span><span class="spaces"> </span><span class="istickedoff">,0.6382, 0.7460, 0.4224</span>
|
||||
<span class="lineno"> 409 </span><span class="spaces"> </span><span class="istickedoff">,0.6473, 0.7456, 0.4188</span>
|
||||
<span class="lineno"> 410 </span><span class="spaces"> </span><span class="istickedoff">,0.6564, 0.7451, 0.4152</span>
|
||||
<span class="lineno"> 411 </span><span class="spaces"> </span><span class="istickedoff">,0.6653, 0.7446, 0.4116</span>
|
||||
<span class="lineno"> 412 </span><span class="spaces"> </span><span class="istickedoff">,0.6742, 0.7441, 0.4081</span>
|
||||
<span class="lineno"> 413 </span><span class="spaces"> </span><span class="istickedoff">,0.6830, 0.7435, 0.4046</span>
|
||||
<span class="lineno"> 414 </span><span class="spaces"> </span><span class="istickedoff">,0.6918, 0.7430, 0.4011</span>
|
||||
<span class="lineno"> 415 </span><span class="spaces"> </span><span class="istickedoff">,0.7004, 0.7424, 0.3976</span>
|
||||
<span class="lineno"> 416 </span><span class="spaces"> </span><span class="istickedoff">,0.7091, 0.7418, 0.3942</span>
|
||||
<span class="lineno"> 417 </span><span class="spaces"> </span><span class="istickedoff">,0.7176, 0.7412, 0.3908</span>
|
||||
<span class="lineno"> 418 </span><span class="spaces"> </span><span class="istickedoff">,0.7261, 0.7405, 0.3874</span>
|
||||
<span class="lineno"> 419 </span><span class="spaces"> </span><span class="istickedoff">,0.7346, 0.7399, 0.3840</span>
|
||||
<span class="lineno"> 420 </span><span class="spaces"> </span><span class="istickedoff">,0.7430, 0.7392, 0.3806</span>
|
||||
<span class="lineno"> 421 </span><span class="spaces"> </span><span class="istickedoff">,0.7513, 0.7385, 0.3773</span>
|
||||
<span class="lineno"> 422 </span><span class="spaces"> </span><span class="istickedoff">,0.7596, 0.7378, 0.3739</span>
|
||||
<span class="lineno"> 423 </span><span class="spaces"> </span><span class="istickedoff">,0.7679, 0.7372, 0.3706</span>
|
||||
<span class="lineno"> 424 </span><span class="spaces"> </span><span class="istickedoff">,0.7761, 0.7364, 0.3673</span>
|
||||
<span class="lineno"> 425 </span><span class="spaces"> </span><span class="istickedoff">,0.7843, 0.7357, 0.3639</span>
|
||||
<span class="lineno"> 426 </span><span class="spaces"> </span><span class="istickedoff">,0.7924, 0.7350, 0.3606</span>
|
||||
<span class="lineno"> 427 </span><span class="spaces"> </span><span class="istickedoff">,0.8005, 0.7343, 0.3573</span>
|
||||
<span class="lineno"> 428 </span><span class="spaces"> </span><span class="istickedoff">,0.8085, 0.7336, 0.3539</span>
|
||||
<span class="lineno"> 429 </span><span class="spaces"> </span><span class="istickedoff">,0.8166, 0.7329, 0.3506</span>
|
||||
<span class="lineno"> 430 </span><span class="spaces"> </span><span class="istickedoff">,0.8246, 0.7322, 0.3472</span>
|
||||
<span class="lineno"> 431 </span><span class="spaces"> </span><span class="istickedoff">,0.8325, 0.7315, 0.3438</span>
|
||||
<span class="lineno"> 432 </span><span class="spaces"> </span><span class="istickedoff">,0.8405, 0.7308, 0.3404</span>
|
||||
<span class="lineno"> 433 </span><span class="spaces"> </span><span class="istickedoff">,0.8484, 0.7301, 0.3370</span>
|
||||
<span class="lineno"> 434 </span><span class="spaces"> </span><span class="istickedoff">,0.8563, 0.7294, 0.3336</span>
|
||||
<span class="lineno"> 435 </span><span class="spaces"> </span><span class="istickedoff">,0.8642, 0.7288, 0.3300</span>
|
||||
<span class="lineno"> 436 </span><span class="spaces"> </span><span class="istickedoff">,0.8720, 0.7282, 0.3265</span>
|
||||
<span class="lineno"> 437 </span><span class="spaces"> </span><span class="istickedoff">,0.8798, 0.7276, 0.3229</span>
|
||||
<span class="lineno"> 438 </span><span class="spaces"> </span><span class="istickedoff">,0.8877, 0.7271, 0.3193</span>
|
||||
<span class="lineno"> 439 </span><span class="spaces"> </span><span class="istickedoff">,0.8954, 0.7266, 0.3156</span>
|
||||
<span class="lineno"> 440 </span><span class="spaces"> </span><span class="istickedoff">,0.9032, 0.7262, 0.3117</span>
|
||||
<span class="lineno"> 441 </span><span class="spaces"> </span><span class="istickedoff">,0.9110, 0.7259, 0.3078</span>
|
||||
<span class="lineno"> 442 </span><span class="spaces"> </span><span class="istickedoff">,0.9187, 0.7256, 0.3038</span>
|
||||
<span class="lineno"> 443 </span><span class="spaces"> </span><span class="istickedoff">,0.9264, 0.7256, 0.2996</span>
|
||||
<span class="lineno"> 444 </span><span class="spaces"> </span><span class="istickedoff">,0.9341, 0.7256, 0.2953</span>
|
||||
<span class="lineno"> 445 </span><span class="spaces"> </span><span class="istickedoff">,0.9417, 0.7259, 0.2907</span>
|
||||
<span class="lineno"> 446 </span><span class="spaces"> </span><span class="istickedoff">,0.9493, 0.7264, 0.2859</span>
|
||||
<span class="lineno"> 447 </span><span class="spaces"> </span><span class="istickedoff">,0.9567, 0.7273, 0.2808</span>
|
||||
<span class="lineno"> 448 </span><span class="spaces"> </span><span class="istickedoff">,0.9639, 0.7285, 0.2754</span>
|
||||
<span class="lineno"> 449 </span><span class="spaces"> </span><span class="istickedoff">,0.9708, 0.7303, 0.2696</span>
|
||||
<span class="lineno"> 450 </span><span class="spaces"> </span><span class="istickedoff">,0.9773, 0.7326, 0.2634</span>
|
||||
<span class="lineno"> 451 </span><span class="spaces"> </span><span class="istickedoff">,0.9831, 0.7355, 0.2570</span>
|
||||
<span class="lineno"> 452 </span><span class="spaces"> </span><span class="istickedoff">,0.9882, 0.7390, 0.2504</span>
|
||||
<span class="lineno"> 453 </span><span class="spaces"> </span><span class="istickedoff">,0.9922, 0.7431, 0.2437</span>
|
||||
<span class="lineno"> 454 </span><span class="spaces"> </span><span class="istickedoff">,0.9952, 0.7476, 0.2373</span>
|
||||
<span class="lineno"> 455 </span><span class="spaces"> </span><span class="istickedoff">,0.9973, 0.7524, 0.2310</span>
|
||||
<span class="lineno"> 456 </span><span class="spaces"> </span><span class="istickedoff">,0.9986, 0.7573, 0.2251</span>
|
||||
<span class="lineno"> 457 </span><span class="spaces"> </span><span class="istickedoff">,0.9991, 0.7624, 0.2195</span>
|
||||
<span class="lineno"> 458 </span><span class="spaces"> </span><span class="istickedoff">,0.9990, 0.7675, 0.2141</span>
|
||||
<span class="lineno"> 459 </span><span class="spaces"> </span><span class="istickedoff">,0.9985, 0.7726, 0.2090</span>
|
||||
<span class="lineno"> 460 </span><span class="spaces"> </span><span class="istickedoff">,0.9976, 0.7778, 0.2042</span>
|
||||
<span class="lineno"> 461 </span><span class="spaces"> </span><span class="istickedoff">,0.9964, 0.7829, 0.1995</span>
|
||||
<span class="lineno"> 462 </span><span class="spaces"> </span><span class="istickedoff">,0.9950, 0.7880, 0.1949</span>
|
||||
<span class="lineno"> 463 </span><span class="spaces"> </span><span class="istickedoff">,0.9933, 0.7931, 0.1905</span>
|
||||
<span class="lineno"> 464 </span><span class="spaces"> </span><span class="istickedoff">,0.9914, 0.7981, 0.1863</span>
|
||||
<span class="lineno"> 465 </span><span class="spaces"> </span><span class="istickedoff">,0.9894, 0.8032, 0.1821</span>
|
||||
<span class="lineno"> 466 </span><span class="spaces"> </span><span class="istickedoff">,0.9873, 0.8083, 0.1780</span>
|
||||
<span class="lineno"> 467 </span><span class="spaces"> </span><span class="istickedoff">,0.9851, 0.8133, 0.1740</span>
|
||||
<span class="lineno"> 468 </span><span class="spaces"> </span><span class="istickedoff">,0.9828, 0.8184, 0.1700</span>
|
||||
<span class="lineno"> 469 </span><span class="spaces"> </span><span class="istickedoff">,0.9805, 0.8235, 0.1661</span>
|
||||
<span class="lineno"> 470 </span><span class="spaces"> </span><span class="istickedoff">,0.9782, 0.8286, 0.1622</span>
|
||||
<span class="lineno"> 471 </span><span class="spaces"> </span><span class="istickedoff">,0.9759, 0.8337, 0.1583</span>
|
||||
<span class="lineno"> 472 </span><span class="spaces"> </span><span class="istickedoff">,0.9736, 0.8389, 0.1544</span>
|
||||
<span class="lineno"> 473 </span><span class="spaces"> </span><span class="istickedoff">,0.9713, 0.8441, 0.1505</span>
|
||||
<span class="lineno"> 474 </span><span class="spaces"> </span><span class="istickedoff">,0.9692, 0.8494, 0.1465</span>
|
||||
<span class="lineno"> 475 </span><span class="spaces"> </span><span class="istickedoff">,0.9672, 0.8548, 0.1425</span>
|
||||
<span class="lineno"> 476 </span><span class="spaces"> </span><span class="istickedoff">,0.9654, 0.8603, 0.1385</span>
|
||||
<span class="lineno"> 477 </span><span class="spaces"> </span><span class="istickedoff">,0.9638, 0.8659, 0.1343</span>
|
||||
<span class="lineno"> 478 </span><span class="spaces"> </span><span class="istickedoff">,0.9623, 0.8716, 0.1301</span>
|
||||
<span class="lineno"> 479 </span><span class="spaces"> </span><span class="istickedoff">,0.9611, 0.8774, 0.1258</span>
|
||||
<span class="lineno"> 480 </span><span class="spaces"> </span><span class="istickedoff">,0.9600, 0.8834, 0.1215</span>
|
||||
<span class="lineno"> 481 </span><span class="spaces"> </span><span class="istickedoff">,0.9593, 0.8895, 0.1171</span>
|
||||
<span class="lineno"> 482 </span><span class="spaces"> </span><span class="istickedoff">,0.9588, 0.8958, 0.1126</span>
|
||||
<span class="lineno"> 483 </span><span class="spaces"> </span><span class="istickedoff">,0.9586, 0.9022, 0.1082</span>
|
||||
<span class="lineno"> 484 </span><span class="spaces"> </span><span class="istickedoff">,0.9587, 0.9088, 0.1036</span>
|
||||
<span class="lineno"> 485 </span><span class="spaces"> </span><span class="istickedoff">,0.9591, 0.9155, 0.0990</span>
|
||||
<span class="lineno"> 486 </span><span class="spaces"> </span><span class="istickedoff">,0.9599, 0.9225, 0.0944</span>
|
||||
<span class="lineno"> 487 </span><span class="spaces"> </span><span class="istickedoff">,0.9610, 0.9296, 0.0897</span>
|
||||
<span class="lineno"> 488 </span><span class="spaces"> </span><span class="istickedoff">,0.9624, 0.9368, 0.0850</span>
|
||||
<span class="lineno"> 489 </span><span class="spaces"> </span><span class="istickedoff">,0.9641, 0.9443, 0.0802</span>
|
||||
<span class="lineno"> 490 </span><span class="spaces"> </span><span class="istickedoff">,0.9662, 0.9518, 0.0753</span>
|
||||
<span class="lineno"> 491 </span><span class="spaces"> </span><span class="istickedoff">,0.9685, 0.9595, 0.0703</span>
|
||||
<span class="lineno"> 492 </span><span class="spaces"> </span><span class="istickedoff">,0.9710, 0.9673, 0.0651</span>
|
||||
<span class="lineno"> 493 </span><span class="spaces"> </span><span class="istickedoff">,0.9736, 0.9752, 0.0597</span>
|
||||
<span class="lineno"> 494 </span><span class="spaces"> </span><span class="istickedoff">,0.9763, 0.9831, 0.0538]</span></span>
|
||||
<span class="lineno"> 495 </span>
|
||||
<span class="lineno"> 496 </span>--------------------------------------------------------------------------------
|
||||
<span class="lineno"> 497 </span>-- Helpers
|
||||
<span class="lineno"> 498 </span>
|
||||
<span class="lineno"> 499 </span>colors :: Text -> Vector PixelRGB8
|
||||
<span class="lineno"> 500 </span><span class="decl"><span class="istickedoff">colors = V.fromList . map (toColor . map (fromIntegral . digitToInt) . T.unpack) . T.chunksOf 6</span>
|
||||
<span class="lineno"> 501 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 502 </span><span class="spaces"> </span><span class="istickedoff">toColor [r1,r2,g1,g2,b1,b2] =</span>
|
||||
<span class="lineno"> 503 </span><span class="spaces"> </span><span class="istickedoff">PixelRGB8 (r1 `shiftL` 4 + r2) (g1 `shiftL` 4 + g2) (b1 `shiftL` 4+b2)</span>
|
||||
<span class="lineno"> 504 </span><span class="spaces"> </span><span class="istickedoff">toColor _ = <span class="nottickedoff">error "Reanimate.ColorMap.colors: Broken data"</span></span></span>
|
||||
<span class="lineno"> 505 </span>
|
||||
<span class="lineno"> 506 </span>ramp :: Vector PixelRGB8 -> Double -> PixelRGB8
|
||||
<span class="lineno"> 507 </span><span class="decl"><span class="istickedoff">ramp v = \t -> v V.! max 0 (min (len-1) $ round $ t * (len'-1))</span>
|
||||
<span class="lineno"> 508 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 509 </span><span class="spaces"> </span><span class="istickedoff">len = V.length v</span>
|
||||
<span class="lineno"> 510 </span><span class="spaces"> </span><span class="istickedoff">len' = fromIntegral len</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
74
reanimate-0.4.2.0-inplace/Reanimate.Constants.hs.html
Normal file
74
reanimate-0.4.2.0-inplace/Reanimate.Constants.hs.html
Normal file
|
|
@ -0,0 +1,74 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{- |
|
||||
<span class="lineno"> 2 </span> Reanimate configures a consistent, default canvas. The values of this default
|
||||
<span class="lineno"> 3 </span> can be observed via the constants in this module. Keep in mind, these values
|
||||
<span class="lineno"> 4 </span> describe the /default/ canvas and will not apply to custom viewports.
|
||||
<span class="lineno"> 5 </span>-}
|
||||
<span class="lineno"> 6 </span>module Reanimate.Constants
|
||||
<span class="lineno"> 7 </span> ( screenWidth
|
||||
<span class="lineno"> 8 </span> , screenHeight
|
||||
<span class="lineno"> 9 </span> , screenTop
|
||||
<span class="lineno"> 10 </span> , screenBottom
|
||||
<span class="lineno"> 11 </span> , screenLeft
|
||||
<span class="lineno"> 12 </span> , screenRight
|
||||
<span class="lineno"> 13 </span> , defaultDPI
|
||||
<span class="lineno"> 14 </span> , defaultStrokeWidth
|
||||
<span class="lineno"> 15 </span> ) where
|
||||
<span class="lineno"> 16 </span>
|
||||
<span class="lineno"> 17 </span>import Graphics.SvgTree
|
||||
<span class="lineno"> 18 </span>
|
||||
<span class="lineno"> 19 </span>-- | Number of units from the left-most point to the right-most point on the screen.
|
||||
<span class="lineno"> 20 </span>screenWidth :: Fractional a => a
|
||||
<span class="lineno"> 21 </span>
|
||||
<span class="lineno"> 22 </span>-- | Number of units from the bottom to the top of the screen.
|
||||
<span class="lineno"> 23 </span>screenHeight :: Fractional a => a
|
||||
<span class="lineno"> 24 </span>
|
||||
<span class="lineno"> 25 </span>-- | Position of the top of the screen.
|
||||
<span class="lineno"> 26 </span>screenTop :: Fractional a => a
|
||||
<span class="lineno"> 27 </span>
|
||||
<span class="lineno"> 28 </span>-- | Position of the bottom of the screen.
|
||||
<span class="lineno"> 29 </span>screenBottom :: Fractional a => a
|
||||
<span class="lineno"> 30 </span>
|
||||
<span class="lineno"> 31 </span>-- | Position of the left side of the screen.
|
||||
<span class="lineno"> 32 </span>screenLeft :: Fractional a => a
|
||||
<span class="lineno"> 33 </span>
|
||||
<span class="lineno"> 34 </span>-- | Position of the right side of the screen.
|
||||
<span class="lineno"> 35 </span>screenRight :: Fractional a => a
|
||||
<span class="lineno"> 36 </span>
|
||||
<span class="lineno"> 37 </span><span class="decl"><span class="istickedoff">screenWidth = 16</span></span>
|
||||
<span class="lineno"> 38 </span><span class="decl"><span class="istickedoff">screenHeight = 9</span></span>
|
||||
<span class="lineno"> 39 </span><span class="decl"><span class="nottickedoff">screenTop = screenHeight/2</span></span>
|
||||
<span class="lineno"> 40 </span><span class="decl"><span class="nottickedoff">screenBottom = -screenHeight/2</span></span>
|
||||
<span class="lineno"> 41 </span><span class="decl"><span class="nottickedoff">screenLeft = -screenWidth/2</span></span>
|
||||
<span class="lineno"> 42 </span><span class="decl"><span class="nottickedoff">screenRight = screenWidth/2</span></span>
|
||||
<span class="lineno"> 43 </span>
|
||||
<span class="lineno"> 44 </span>-- | SVG allows measurements in inches which have to be converted to local units.
|
||||
<span class="lineno"> 45 </span>-- This value describes how many local units there are in an inch.
|
||||
<span class="lineno"> 46 </span>defaultDPI :: Dpi
|
||||
<span class="lineno"> 47 </span><span class="decl"><span class="nottickedoff">defaultDPI = 96</span></span>
|
||||
<span class="lineno"> 48 </span>
|
||||
<span class="lineno"> 49 </span>-- | Default thickness of lines.
|
||||
<span class="lineno"> 50 </span>defaultStrokeWidth :: Double
|
||||
<span class="lineno"> 51 </span><span class="decl"><span class="istickedoff">defaultStrokeWidth = 0.05</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
246
reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI.hs.html
Normal file
246
reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI.hs.html
Normal file
|
|
@ -0,0 +1,246 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>module Reanimate.Driver.CLI
|
||||
<span class="lineno"> 2 </span> ( getDriverOptions
|
||||
<span class="lineno"> 3 </span> , Options(..)
|
||||
<span class="lineno"> 4 </span> , Command(..)
|
||||
<span class="lineno"> 5 </span> , Preset(..)
|
||||
<span class="lineno"> 6 </span> , Format(..)
|
||||
<span class="lineno"> 7 </span> , Raster(..)
|
||||
<span class="lineno"> 8 </span> , showFormat
|
||||
<span class="lineno"> 9 </span> , showRaster
|
||||
<span class="lineno"> 10 </span> ) where
|
||||
<span class="lineno"> 11 </span>
|
||||
<span class="lineno"> 12 </span>import Data.Char
|
||||
<span class="lineno"> 13 </span>import Data.Monoid
|
||||
<span class="lineno"> 14 </span>import Options.Applicative
|
||||
<span class="lineno"> 15 </span>import Prelude
|
||||
<span class="lineno"> 16 </span>import Reanimate.Render (FPS, Format (..), Height, Raster (..),
|
||||
<span class="lineno"> 17 </span> Width)
|
||||
<span class="lineno"> 18 </span>
|
||||
<span class="lineno"> 19 </span>newtype Options = Options
|
||||
<span class="lineno"> 20 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">optsCommand</span></span></span> :: Command
|
||||
<span class="lineno"> 21 </span> } deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 22 </span>
|
||||
<span class="lineno"> 23 </span>data Command
|
||||
<span class="lineno"> 24 </span> = Raw
|
||||
<span class="lineno"> 25 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">rawOutputFolder</span></span></span> :: FilePath
|
||||
<span class="lineno"> 26 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">rawFrameOffset</span></span></span> :: Int
|
||||
<span class="lineno"> 27 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">rawPrettyPrint</span></span></span> :: Bool
|
||||
<span class="lineno"> 28 </span> }
|
||||
<span class="lineno"> 29 </span> | Test
|
||||
<span class="lineno"> 30 </span> | Check
|
||||
<span class="lineno"> 31 </span> | View
|
||||
<span class="lineno"> 32 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">viewVerbose</span></span></span> :: Bool
|
||||
<span class="lineno"> 33 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">viewGHCPath</span></span></span> :: Maybe FilePath
|
||||
<span class="lineno"> 34 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">viewGHCOpts</span></span></span> :: [String]
|
||||
<span class="lineno"> 35 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">viewOrigin</span></span></span> :: Maybe FilePath
|
||||
<span class="lineno"> 36 </span> }
|
||||
<span class="lineno"> 37 </span> | Render
|
||||
<span class="lineno"> 38 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderTarget</span></span></span> :: Maybe String
|
||||
<span class="lineno"> 39 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderFPS</span></span></span> :: Maybe FPS
|
||||
<span class="lineno"> 40 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderWidth</span></span></span> :: Maybe Width
|
||||
<span class="lineno"> 41 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderHeight</span></span></span> :: Maybe Height
|
||||
<span class="lineno"> 42 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderCompile</span></span></span> :: Bool
|
||||
<span class="lineno"> 43 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderFormat</span></span></span> :: Maybe Format
|
||||
<span class="lineno"> 44 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderPreset</span></span></span> :: Maybe Preset
|
||||
<span class="lineno"> 45 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderRaster</span></span></span> :: Raster
|
||||
<span class="lineno"> 46 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">renderPartial</span></span></span> :: Bool
|
||||
<span class="lineno"> 47 </span> }
|
||||
<span class="lineno"> 48 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 49 </span>
|
||||
<span class="lineno"> 50 </span>data Preset = Youtube | ExampleGif | Quick | MediumQ | HighQ | LowFPS
|
||||
<span class="lineno"> 51 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 52 </span>
|
||||
<span class="lineno"> 53 </span>readRaster :: String -> Maybe Raster
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">readRaster raster =</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">case map toLower raster of</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">"none" -> Just RasterNone</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">"auto" -> Just RasterAuto</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">"inkscape" -> Just RasterInkscape</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">"rsvg" -> Just RasterRSvg</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">"imagemagick" -> Just RasterMagick</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">_ -> Nothing</span></span>
|
||||
<span class="lineno"> 62 </span>
|
||||
<span class="lineno"> 63 </span>showRaster :: Raster -> String
|
||||
<span class="lineno"> 64 </span><span class="decl"><span class="nottickedoff">showRaster RasterNone = "none"</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"></span><span class="nottickedoff">showRaster RasterAuto = "auto"</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"></span><span class="nottickedoff">showRaster RasterInkscape = "inkscape"</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"></span><span class="nottickedoff">showRaster RasterRSvg = "rsvg"</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"></span><span class="nottickedoff">showRaster RasterMagick = "imagemagick"</span></span>
|
||||
<span class="lineno"> 69 </span>
|
||||
<span class="lineno"> 70 </span>readFormat :: String -> Maybe Format
|
||||
<span class="lineno"> 71 </span><span class="decl"><span class="nottickedoff">readFormat fmt =</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">case map toLower fmt of</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">"mp4" -> Just RenderMp4</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">"gif" -> Just RenderGif</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">"webm" -> Just RenderWebm</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">_ -> Nothing</span></span>
|
||||
<span class="lineno"> 77 </span>
|
||||
<span class="lineno"> 78 </span>showFormat :: Format -> String
|
||||
<span class="lineno"> 79 </span><span class="decl"><span class="nottickedoff">showFormat RenderMp4 = "mp4"</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"></span><span class="nottickedoff">showFormat RenderGif = "gif"</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"></span><span class="nottickedoff">showFormat RenderWebm = "webm"</span></span>
|
||||
<span class="lineno"> 82 </span>
|
||||
<span class="lineno"> 83 </span>readPreset :: String -> Maybe Preset
|
||||
<span class="lineno"> 84 </span><span class="decl"><span class="nottickedoff">readPreset preset =</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="nottickedoff">case map toLower preset of</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="nottickedoff">"youtube" -> Just Youtube</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="nottickedoff">"gif" -> Just ExampleGif</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="nottickedoff">"quick" -> Just Quick</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="nottickedoff">"medium" -> Just MediumQ</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="nottickedoff">"high" -> Just HighQ</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="nottickedoff">"lowfps" -> Just LowFPS</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="nottickedoff">_ -> Nothing</span></span>
|
||||
<span class="lineno"> 93 </span>
|
||||
<span class="lineno"> 94 </span>showPreset :: Preset -> String
|
||||
<span class="lineno"> 95 </span><span class="decl"><span class="nottickedoff">showPreset Youtube = "youtube"</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"></span><span class="nottickedoff">showPreset ExampleGif = "gif"</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"></span><span class="nottickedoff">showPreset Quick = "quick"</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"></span><span class="nottickedoff">showPreset MediumQ = "medium"</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"></span><span class="nottickedoff">showPreset HighQ = "high"</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"></span><span class="nottickedoff">showPreset LowFPS = "lowfps"</span></span>
|
||||
<span class="lineno"> 101 </span>
|
||||
<span class="lineno"> 102 </span>options :: Parser Options
|
||||
<span class="lineno"> 103 </span><span class="decl"><span class="istickedoff">options = Options <$> commandP</span></span>
|
||||
<span class="lineno"> 104 </span>
|
||||
<span class="lineno"> 105 </span>commandP :: Parser Command
|
||||
<span class="lineno"> 106 </span><span class="decl"><span class="istickedoff">commandP = subparser(</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="istickedoff">command "test" testCommand</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="istickedoff"><> commandGroup <span class="nottickedoff">"Internal commands"</span></span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="istickedoff"><> internal )</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff"><|> <span class="nottickedoff">hsubparser</span></span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">( command "check" checkCommand</span></span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff"><> command "view" viewCommand</span></span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff"><> command "render" renderCommand</span></span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff"><> command "raw" rawCommand</span></span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">)</span></span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff"><|> <span class="nottickedoff">infoParser viewCommand</span></span></span>
|
||||
<span class="lineno"> 117 </span>
|
||||
<span class="lineno"> 118 </span>rawCommand :: ParserInfo Command
|
||||
<span class="lineno"> 119 </span><span class="decl"><span class="nottickedoff">rawCommand = info parse</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">(progDesc "Output raw SVGs for animation at 60 fps. Used internally by viewer.")</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">parse = Raw</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff"><$> strOption</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">( long "output" <></span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">short 'o' <></span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">metavar "PATH" <></span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">help "Output folder" <></span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">value ".")</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="nottickedoff"><*> option auto</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">( long "offset" <></span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">metavar "NUMBER" <></span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">help "Frame offset" <></span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">value 0)</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff"><*> switch</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">( long "pretty-print" <></span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">short 'p' <></span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">help "Pretty print svg")</span></span>
|
||||
<span class="lineno"> 138 </span>
|
||||
<span class="lineno"> 139 </span>testCommand :: ParserInfo Command
|
||||
<span class="lineno"> 140 </span><span class="decl"><span class="istickedoff">testCommand = info (parse <**> helper)</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff">(progDesc <span class="nottickedoff">"Generate 10 frames spread out evenly across the animation. Used \</span></span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\internally by the test-suite."</span>)</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff">parse = pure Test</span></span>
|
||||
<span class="lineno"> 145 </span>
|
||||
<span class="lineno"> 146 </span>checkCommand :: ParserInfo Command
|
||||
<span class="lineno"> 147 </span><span class="decl"><span class="nottickedoff">checkCommand = info parse</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="nottickedoff">(progDesc "Run a system's diagnostic and report any missing external dependencies.")</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">parse = pure Check</span></span>
|
||||
<span class="lineno"> 151 </span>
|
||||
<span class="lineno"> 152 </span>viewCommand :: ParserInfo Command
|
||||
<span class="lineno"> 153 </span><span class="decl"><span class="nottickedoff">viewCommand = info parse</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">(progDesc "Play animation in browser window.")</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">parse = View</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="nottickedoff"><$> switch</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="nottickedoff">(long "verbose" <> short 'v')</span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="nottickedoff"><*> optional (strOption (long "ghc"</span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="nottickedoff"><> metavar "PATH"</span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Path to GHC binary"))</span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="nottickedoff"><*> many (strOption (long "ghc-opt"</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff"><> short 'G'</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Additional option to pass to ghc"))</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="nottickedoff"><*> optional (strOption (long "self"</span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="nottickedoff"><> metavar "PATH"</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Source file used for live-reloading"))</span></span>
|
||||
<span class="lineno"> 168 </span>
|
||||
<span class="lineno"> 169 </span>renderCommand :: ParserInfo Command
|
||||
<span class="lineno"> 170 </span><span class="decl"><span class="nottickedoff">renderCommand = info parse</span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="nottickedoff">(progDesc "Render animation to file.")</span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="nottickedoff">-- fromPreset :: (Maybe Preset -> (Command -> Command))</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="nottickedoff">-- fromPreset Nothing = id</span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="nottickedoff">-- fromPreset (Just ExampleGif) = \cmd -> cmd{renderFPS=24}</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="nottickedoff">-- modParser :: Parser (Command -> Command)</span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="nottickedoff">-- modParser = fmap fromPreset $</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">-- optional (option (maybeReader readPreset)</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">-- (long "preset" <> showDefaultWith showPreset</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">-- <> metavar "TYPE"</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">-- <> help "Parameter presets: youtube, gif, quick"))</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="nottickedoff">parse = Render</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="nottickedoff"><$> optional (strOption (long "target"</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="nottickedoff"><> short 'o'</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff"><> metavar "FILE"</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Write output to FILE"))</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff"><*> optional (option auto</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="nottickedoff">(long "fps" <> metavar "FPS"</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Set frames per second."))</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="nottickedoff"><*> optional (option auto</span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="nottickedoff">(long "width" <> short 'w' <> metavar "PIXELS"</span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Set video width."))</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="nottickedoff"><*> optional (option auto</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="nottickedoff">(long "height" <> short 'h'</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="nottickedoff"><> metavar "PIXELS" <> help "Set video height."))</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="nottickedoff"><*> switch (long "compile"</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Compile source code before rendering.")</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="nottickedoff"><*> optional (option (maybeReader readFormat)</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="nottickedoff">(long "format" <> metavar "FMT"</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Video format: mp4, gif, webm"))</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="nottickedoff"><*> optional (option (maybeReader readPreset)</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="nottickedoff">(long "preset" <> showDefaultWith showPreset</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="nottickedoff"><> metavar "TYPE"</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Parameter presets: youtube, gif, quick, medium, high"))</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="nottickedoff"><*> option (maybeReader readRaster)</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="nottickedoff">(long "raster" <> showDefaultWith showRaster</span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="nottickedoff"><> metavar "RASTER"</span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="nottickedoff"><> value RasterNone</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Raster engine: none, auto, inkscape, rsvg, imagemagick")</span>
|
||||
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="nottickedoff"><*> switch</span>
|
||||
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="nottickedoff">(long "partial"</span>
|
||||
<span class="lineno"> 212 </span><span class="spaces"> </span><span class="nottickedoff"><> help "Produce partial animation even if frame generation was \</span>
|
||||
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="nottickedoff">\interrupted by ctrl-c")</span></span>
|
||||
<span class="lineno"> 214 </span>
|
||||
<span class="lineno"> 215 </span>opts :: ParserInfo Options
|
||||
<span class="lineno"> 216 </span><span class="decl"><span class="istickedoff">opts = info (options <**> helper )</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="istickedoff">( fullDesc</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="istickedoff"><> progDesc <span class="nottickedoff">"This program contains an animation which can either be viewed \</span></span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\in a web-browser or rendered to disk."</span></span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="istickedoff">)</span></span>
|
||||
<span class="lineno"> 221 </span>
|
||||
<span class="lineno"> 222 </span>getDriverOptions :: IO Options
|
||||
<span class="lineno"> 223 </span><span class="decl"><span class="istickedoff">getDriverOptions = customExecParser (prefs showHelpOnError) opts</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
229
reanimate-0.4.2.0-inplace/Reanimate.Driver.Check.hs.html
Normal file
229
reanimate-0.4.2.0-inplace/Reanimate.Driver.Check.hs.html
Normal file
|
|
@ -0,0 +1,229 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE ScopedTypeVariables #-}
|
||||
<span class="lineno"> 2 </span>module Reanimate.Driver.Check
|
||||
<span class="lineno"> 3 </span> ( checkEnvironment
|
||||
<span class="lineno"> 4 </span> , hasRSvg
|
||||
<span class="lineno"> 5 </span> , hasInkscape
|
||||
<span class="lineno"> 6 </span> , hasMagick
|
||||
<span class="lineno"> 7 </span> , hasFFmpegRSvg
|
||||
<span class="lineno"> 8 </span> ) where
|
||||
<span class="lineno"> 9 </span>
|
||||
<span class="lineno"> 10 </span>import Control.Exception (SomeException, handle)
|
||||
<span class="lineno"> 11 </span>import Control.Monad
|
||||
<span class="lineno"> 12 </span>import Data.Maybe
|
||||
<span class="lineno"> 13 </span>import Data.Version
|
||||
<span class="lineno"> 14 </span>import Reanimate.Misc (runCmd_)
|
||||
<span class="lineno"> 15 </span>import Reanimate.Driver.Magick (magickCmd)
|
||||
<span class="lineno"> 16 </span>import System.Console.ANSI.Codes
|
||||
<span class="lineno"> 17 </span>import System.Directory (findExecutable)
|
||||
<span class="lineno"> 18 </span>import System.IO
|
||||
<span class="lineno"> 19 </span>import System.IO.Temp
|
||||
<span class="lineno"> 20 </span>import Text.ParserCombinators.ReadP
|
||||
<span class="lineno"> 21 </span>import Text.Printf
|
||||
<span class="lineno"> 22 </span>
|
||||
<span class="lineno"> 23 </span>--------------------------------------------------------------------------
|
||||
<span class="lineno"> 24 </span>-- Check environment
|
||||
<span class="lineno"> 25 </span>
|
||||
<span class="lineno"> 26 </span>checkEnvironment :: IO ()
|
||||
<span class="lineno"> 27 </span><span class="decl"><span class="nottickedoff">checkEnvironment = do</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="nottickedoff">putStrLn "reanimate checks:"</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has ffmpeg" hasFFmpeg</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has ffmpeg(rsvg)" hasFFmpegRSvg</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has dvisvgm" hasDvisvgm</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has povray" hasPovray</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has blender" hasBlender</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has rsvg-convert" hasRSvg</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has inkscape" hasInkscape</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has imagemagick" hasMagick</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has LaTeX" hasLaTeX</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">runCheck ("Has LaTeX package '"++ "babel" ++ "'") $ hasTeXPackage "latex"</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">"[english]{babel}"</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">forM_ latexPackages $ \pkg -></span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">runCheck ("Has LaTeX package '"++ pkg ++ "'") $ hasTeXPackage "latex" $</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="nottickedoff">"{"++pkg++"}"</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="nottickedoff">runCheck "Has XeLaTeX" hasXeLaTeX</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="nottickedoff">forM_ xelatexPackages $ \pkg -></span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="nottickedoff">runCheck ("Has XeLaTeX package '"++ pkg ++ "'") $ hasTeXPackage "xelatex" $</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="nottickedoff">"{"++pkg++"}"</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">latexPackages =</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">["preview"</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="nottickedoff">,"amsmath"</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">--,"amssymb"</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="nottickedoff">--,"dsfont"</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="nottickedoff">--,"setspace"</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="nottickedoff">--,"relsize"</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">--,"textcomp"</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">--,"mathrsfs"</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">--,"calligra"</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">--,"wasysym"</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">--,"ragged2e"</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">--,"physics"</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">--,"xcolor"</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">--,"textcomp"</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="nottickedoff">--,"xfrac"</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="nottickedoff">--,"microtype"</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="nottickedoff">xelatexPackages =</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">["ctex"]</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">runCheck msg fn = do</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">printf " %-35s" (msg ++ ":")</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">val <- fn</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">case val of</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">Left err -> putStrLnColor Red err</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">Right ok -> putStrLnColor Green ok</span></span>
|
||||
<span class="lineno"> 74 </span>
|
||||
<span class="lineno"> 75 </span>putStrLnColor :: Color -> String -> IO ()
|
||||
<span class="lineno"> 76 </span><span class="decl"><span class="nottickedoff">putStrLnColor color msg =</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="nottickedoff">putStrLn $ setSGRCode [SetColor Foreground Vivid color] ++ msg ++ setSGRCode [Reset]</span></span>
|
||||
<span class="lineno"> 78 </span>
|
||||
<span class="lineno"> 79 </span>-- latex, dvisvgm, xelatex
|
||||
<span class="lineno"> 80 </span>
|
||||
<span class="lineno"> 81 </span>hasLaTeX :: IO (Either String String)
|
||||
<span class="lineno"> 82 </span><span class="decl"><span class="nottickedoff">hasLaTeX = hasProgram "latex"</span></span>
|
||||
<span class="lineno"> 83 </span>
|
||||
<span class="lineno"> 84 </span>hasXeLaTeX :: IO (Either String String)
|
||||
<span class="lineno"> 85 </span><span class="decl"><span class="nottickedoff">hasXeLaTeX = hasProgram "xelatex"</span></span>
|
||||
<span class="lineno"> 86 </span>
|
||||
<span class="lineno"> 87 </span>hasDvisvgm :: IO (Either String String)
|
||||
<span class="lineno"> 88 </span><span class="decl"><span class="nottickedoff">hasDvisvgm = hasProgram "dvisvgm"</span></span>
|
||||
<span class="lineno"> 89 </span>
|
||||
<span class="lineno"> 90 </span>hasPovray :: IO (Either String String)
|
||||
<span class="lineno"> 91 </span><span class="decl"><span class="nottickedoff">hasPovray = hasProgram "povray"</span></span>
|
||||
<span class="lineno"> 92 </span>
|
||||
<span class="lineno"> 93 </span>hasFFmpeg :: IO (Either String String)
|
||||
<span class="lineno"> 94 </span><span class="decl"><span class="nottickedoff">hasFFmpeg = checkMinVersion minVersion <$> ffmpegVersion</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="nottickedoff">minVersion = Version [4,1,3] []</span></span>
|
||||
<span class="lineno"> 97 </span>
|
||||
<span class="lineno"> 98 </span>hasFFmpegRSvg :: IO (Either String String)
|
||||
<span class="lineno"> 99 </span><span class="decl"><span class="nottickedoff">hasFFmpegRSvg = do</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="nottickedoff">mbPath <- findExecutable "ffmpeg"</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="nottickedoff">case mbPath of</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> return $ Left "n/a"</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="nottickedoff">Just path -> do</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="nottickedoff">ret <- runCmd_ path ["-version"]</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="nottickedoff">pure $ case ret of</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="nottickedoff">Right out | "--enable-librsvg" `elem` words out</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="nottickedoff">-> Right "yes"</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">_ -> Left "no"</span></span>
|
||||
<span class="lineno"> 109 </span>
|
||||
<span class="lineno"> 110 </span>hasBlender :: IO (Either String String)
|
||||
<span class="lineno"> 111 </span><span class="decl"><span class="nottickedoff">hasBlender = checkMinVersion minVersion <$> blenderVersion</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="nottickedoff">minVersion = Version [2,80] []</span></span>
|
||||
<span class="lineno"> 114 </span>
|
||||
<span class="lineno"> 115 </span>hasRSvg :: IO (Either String String)
|
||||
<span class="lineno"> 116 </span><span class="decl"><span class="nottickedoff">hasRSvg = checkMinVersion minVersion <$> rsvgVersion</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">minVersion = Version [2,44,0] []</span></span>
|
||||
<span class="lineno"> 119 </span>
|
||||
<span class="lineno"> 120 </span>hasInkscape :: IO (Either String String)
|
||||
<span class="lineno"> 121 </span><span class="decl"><span class="nottickedoff">hasInkscape = checkMinVersion minVersion <$> inkscapeVersion</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">minVersion = Version [0,92] []</span></span>
|
||||
<span class="lineno"> 124 </span>
|
||||
<span class="lineno"> 125 </span>hasMagick :: IO (Either String String)
|
||||
<span class="lineno"> 126 </span><span class="decl"><span class="nottickedoff">hasMagick = checkMinVersion minVersion <$> magickVersion</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">minVersion = Version [6,0,0] []</span></span>
|
||||
<span class="lineno"> 129 </span>
|
||||
<span class="lineno"> 130 </span>ffmpegVersion :: IO (Maybe Version)
|
||||
<span class="lineno"> 131 </span><span class="decl"><span class="nottickedoff">ffmpegVersion = extractVersion "ffmpeg" ["-version"] $ \line -></span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">case take 3 $ words line of</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">["ffmpeg", "version", vs] -> vs</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff">_ -> ""</span></span>
|
||||
<span class="lineno"> 135 </span>
|
||||
<span class="lineno"> 136 </span>blenderVersion :: IO (Maybe Version)
|
||||
<span class="lineno"> 137 </span><span class="decl"><span class="nottickedoff">blenderVersion = extractVersion "blender" ["--version"] $ \line -></span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">case take 2 (words line) of</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">["Blender", vs] -> vs</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="nottickedoff">_ -> ""</span></span>
|
||||
<span class="lineno"> 141 </span>
|
||||
<span class="lineno"> 142 </span>rsvgVersion :: IO (Maybe Version)
|
||||
<span class="lineno"> 143 </span><span class="decl"><span class="nottickedoff">rsvgVersion = extractVersion "rsvg-convert" ["--version"] $ \line -></span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">case words line of</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="nottickedoff">["rsvg-convert", "version", vs] -> vs</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="nottickedoff">_ -> ""</span></span>
|
||||
<span class="lineno"> 147 </span>
|
||||
<span class="lineno"> 148 </span>inkscapeVersion :: IO (Maybe Version)
|
||||
<span class="lineno"> 149 </span><span class="decl"><span class="nottickedoff">inkscapeVersion = extractVersion "inkscape" ["--version"] $ \line -></span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">case take 2 $ words line of</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">["Inkscape", vs] -> vs</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">_ -> ""</span></span>
|
||||
<span class="lineno"> 153 </span>
|
||||
<span class="lineno"> 154 </span>magickVersion :: IO (Maybe Version)
|
||||
<span class="lineno"> 155 </span><span class="decl"><span class="nottickedoff">magickVersion = extractVersion magickCmd ["-version"] $ \line -></span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">case take 3 $ words line of</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="nottickedoff">["Version:", "ImageMagick", vs] -> vs</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="nottickedoff">_ -> ""</span></span>
|
||||
<span class="lineno"> 159 </span>
|
||||
<span class="lineno"> 160 </span>checkMinVersion :: Version -> Maybe Version -> Either String String
|
||||
<span class="lineno"> 161 </span><span class="decl"><span class="nottickedoff">checkMinVersion _minVersion Nothing = Left "no"</span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"></span><span class="nottickedoff">checkMinVersion minVersion (Just vs)</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff">| vs < minVersion = Left $ "too old: " ++ showVersion vs ++ " < " ++ showVersion minVersion</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = Right (showVersion vs)</span></span>
|
||||
<span class="lineno"> 165 </span>
|
||||
<span class="lineno"> 166 </span>extractVersion :: FilePath -> [String] -> (String -> String) -> IO (Maybe Version)
|
||||
<span class="lineno"> 167 </span><span class="decl"><span class="nottickedoff">extractVersion execPath args outputFilter = do</span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="nottickedoff">mbPath <- findExecutable execPath</span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="nottickedoff">case mbPath of</span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> return Nothing</span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="nottickedoff">Just path -> do</span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="nottickedoff">ret <- runCmd_ path args</span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="nottickedoff">case ret of</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="nottickedoff">Left{} -> return $ Just noVersion</span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="nottickedoff">Right out -></span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="nottickedoff">pure $ Just $ fromMaybe noVersion $ parseVS $ outputFilter out</span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">noVersion = Version [] []</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">parseVS vs = listToMaybe $ reverse</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">[ v | (v, _) <- readP_to_S parseVersion vs ]</span></span>
|
||||
<span class="lineno"> 181 </span>
|
||||
<span class="lineno"> 182 </span>hasTeXPackage :: FilePath -> String -> IO (Either String String)
|
||||
<span class="lineno"> 183 </span><span class="decl"><span class="nottickedoff">hasTeXPackage exec pkg = handle (\(_::SomeException) -> return $ Left "n/a") $</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="nottickedoff">withSystemTempDirectory "reanimate" $ \tmp_dir -> withTempFile tmp_dir "test.tex" $ \tex_file tex_handle -> do</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff">hPutStr tex_handle tex_document</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff">hPutStr tex_handle $ "\\usepackage" ++ pkg ++ "\n"</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff">hPutStr tex_handle "\\begin{document}\n"</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="nottickedoff">hPutStr tex_handle "blah\n"</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="nottickedoff">hPutStr tex_handle tex_epilogue</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="nottickedoff">hClose tex_handle</span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="nottickedoff">ret <- runCmd_ exec ["-interaction=batchmode", "-halt-on-error", "-output-directory="++tmp_dir, tex_file]</span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="nottickedoff">return $ case ret of</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="nottickedoff">Right{} -> Right "OK"</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="nottickedoff">Left{} -> Left "missing"</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="nottickedoff">tex_document = "\\documentclass[preview]{standalone}\n"</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="nottickedoff">tex_epilogue =</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="nottickedoff">"\n\</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="nottickedoff">\\\end{document}"</span></span>
|
||||
<span class="lineno"> 200 </span>
|
||||
<span class="lineno"> 201 </span>hasProgram :: String -> IO (Either String String)
|
||||
<span class="lineno"> 202 </span><span class="decl"><span class="nottickedoff">hasProgram exec = do</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="nottickedoff">mbPath <- findExecutable exec</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="nottickedoff">return $ case mbPath of</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> Left $ "'" ++ exec ++ "' not found"</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="nottickedoff">Just path -> Right path</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
58
reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile.hs.html
Normal file
58
reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile.hs.html
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>module Reanimate.Driver.Compile ( compile ) where
|
||||
<span class="lineno"> 2 </span>
|
||||
<span class="lineno"> 3 </span>import Reanimate.Driver.Server (findOwnSource)
|
||||
<span class="lineno"> 4 </span>import System.Directory
|
||||
<span class="lineno"> 5 </span>import System.Exit
|
||||
<span class="lineno"> 6 </span>import System.FilePath
|
||||
<span class="lineno"> 7 </span>import System.Process
|
||||
<span class="lineno"> 8 </span>import System.IO
|
||||
<span class="lineno"> 9 </span>
|
||||
<span class="lineno"> 10 </span>compile :: [String] -> IO ()
|
||||
<span class="lineno"> 11 </span><span class="decl"><span class="nottickedoff">compile opts = do</span>
|
||||
<span class="lineno"> 12 </span><span class="spaces"> </span><span class="nottickedoff">mbSelf <- findOwnSource</span>
|
||||
<span class="lineno"> 13 </span><span class="spaces"> </span><span class="nottickedoff">case mbSelf of</span>
|
||||
<span class="lineno"> 14 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> do</span>
|
||||
<span class="lineno"> 15 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn stderr</span>
|
||||
<span class="lineno"> 16 </span><span class="spaces"> </span><span class="nottickedoff">"Failed to find source code. Did you already compile the animations?\n\</span>
|
||||
<span class="lineno"> 17 </span><span class="spaces"> </span><span class="nottickedoff">\Try running again without the --compile flag."</span>
|
||||
<span class="lineno"> 18 </span><span class="spaces"> </span><span class="nottickedoff">exitFailure</span>
|
||||
<span class="lineno"> 19 </span><span class="spaces"> </span><span class="nottickedoff">Just self -> do</span>
|
||||
<span class="lineno"> 20 </span><span class="spaces"> </span><span class="nottickedoff">let selfDir = takeDirectory self</span>
|
||||
<span class="lineno"> 21 </span><span class="spaces"> </span><span class="nottickedoff">selfName = takeBaseName self</span>
|
||||
<span class="lineno"> 22 </span><span class="spaces"> </span><span class="nottickedoff">outDir = selfDir </> ".reanimate" </> selfName</span>
|
||||
<span class="lineno"> 23 </span><span class="spaces"> </span><span class="nottickedoff">target = outDir </> selfName</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="nottickedoff">ghcOptions =</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="nottickedoff">["-rtsopts", "--make", "-threaded", "-O2"] ++</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="nottickedoff">["-odir", outDir, "-hidir", outDir] ++</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="nottickedoff">[self, "-o", target]</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="nottickedoff">createDirectoryIfMissing True outDir</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="nottickedoff">withCurrentDirectory selfDir $ do</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="nottickedoff">checkExitCode =<< rawSystem "stack" (["ghc", "--"] ++ ghcOptions)</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">checkExitCode =<< rawSystem target opts</span></span>
|
||||
<span class="lineno"> 32 </span>
|
||||
<span class="lineno"> 33 </span>checkExitCode :: ExitCode -> IO ()
|
||||
<span class="lineno"> 34 </span><span class="decl"><span class="nottickedoff">checkExitCode ExitSuccess = return ()</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"></span><span class="nottickedoff">checkExitCode (ExitFailure n) = exitWith (ExitFailure n)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
41
reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick.hs.html
Normal file
41
reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick.hs.html
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>module Reanimate.Driver.Magick
|
||||
<span class="lineno"> 2 </span> ( magickCmd
|
||||
<span class="lineno"> 3 </span> ) where
|
||||
<span class="lineno"> 4 </span>
|
||||
<span class="lineno"> 5 </span>import System.IO.Unsafe (unsafePerformIO)
|
||||
<span class="lineno"> 6 </span>import System.Directory (findExecutable)
|
||||
<span class="lineno"> 7 </span>
|
||||
<span class="lineno"> 8 </span>-- |The name of the ImageMagick command. On Unix-like operating systems, the
|
||||
<span class="lineno"> 9 </span>-- command \'convert\' does not conflict with the name of other commands. On
|
||||
<span class="lineno"> 10 </span>-- Windows, ImageMagick version 7 is readily available, the command \'magick\'
|
||||
<span class="lineno"> 11 </span>-- should be present, and is preferred over \'convert\'. If it is not present,
|
||||
<span class="lineno"> 12 </span>-- \'convert\' is assumed to be the relevant command.
|
||||
<span class="lineno"> 13 </span>magickCmd :: String
|
||||
<span class="lineno"> 14 </span>-- The use of 'unsafeperformIO' is justified on the basis that if \'magick\' is
|
||||
<span class="lineno"> 15 </span>-- found once, it will always be present.
|
||||
<span class="lineno"> 16 </span><span class="decl"><span class="nottickedoff">magickCmd = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 17 </span><span class="spaces"> </span><span class="nottickedoff">mPath <- findExecutable "magick"</span>
|
||||
<span class="lineno"> 18 </span><span class="spaces"> </span><span class="nottickedoff">pure $ maybe "convert" (const "magick") mPath</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
321
reanimate-0.4.2.0-inplace/Reanimate.Driver.Server.hs.html
Normal file
321
reanimate-0.4.2.0-inplace/Reanimate.Driver.Server.hs.html
Normal file
|
|
@ -0,0 +1,321 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE OverloadedStrings #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE ScopedTypeVariables #-}
|
||||
<span class="lineno"> 3 </span>module Reanimate.Driver.Server
|
||||
<span class="lineno"> 4 </span> ( serve
|
||||
<span class="lineno"> 5 </span> , findOwnSource
|
||||
<span class="lineno"> 6 </span> ) where
|
||||
<span class="lineno"> 7 </span>
|
||||
<span class="lineno"> 8 </span>import Control.Concurrent
|
||||
<span class="lineno"> 9 </span>import Control.Exception (SomeException, catch, finally)
|
||||
<span class="lineno"> 10 </span>import Control.Monad
|
||||
<span class="lineno"> 11 </span>import Data.IORef
|
||||
<span class="lineno"> 12 </span>import Data.Text (Text)
|
||||
<span class="lineno"> 13 </span>import qualified Data.Text as T
|
||||
<span class="lineno"> 14 </span>import qualified Data.Text.Read as T
|
||||
<span class="lineno"> 15 </span>import Data.Time
|
||||
<span class="lineno"> 16 </span>import GHC.Environment (getFullArgs)
|
||||
<span class="lineno"> 17 </span>import Language.Haskell.Ghcid
|
||||
<span class="lineno"> 18 </span>import Network.WebSockets
|
||||
<span class="lineno"> 19 </span>import Paths_reanimate
|
||||
<span class="lineno"> 20 </span>import Reanimate.Misc (runCmdLazy, runCmd_)
|
||||
<span class="lineno"> 21 </span>import System.Directory (createDirectoryIfMissing,
|
||||
<span class="lineno"> 22 </span> doesFileExist, findFile, listDirectory,
|
||||
<span class="lineno"> 23 </span> makeAbsolute,
|
||||
<span class="lineno"> 24 </span> withCurrentDirectory)
|
||||
<span class="lineno"> 25 </span>import System.Environment (getProgName)
|
||||
<span class="lineno"> 26 </span>import System.Exit
|
||||
<span class="lineno"> 27 </span>import System.FilePath
|
||||
<span class="lineno"> 28 </span>import System.FSNotify
|
||||
<span class="lineno"> 29 </span>import System.IO
|
||||
<span class="lineno"> 30 </span>import System.IO.Temp
|
||||
<span class="lineno"> 31 </span>import System.Process
|
||||
<span class="lineno"> 32 </span>import Web.Browser (openBrowser)
|
||||
<span class="lineno"> 33 </span>
|
||||
<span class="lineno"> 34 </span>opts :: ConnectionOptions
|
||||
<span class="lineno"> 35 </span><span class="decl"><span class="nottickedoff">opts = defaultConnectionOptions</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">{ connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate }</span></span>
|
||||
<span class="lineno"> 37 </span>
|
||||
<span class="lineno"> 38 </span>serve :: Bool -> Maybe FilePath -> [String] -> Maybe FilePath -> IO ()
|
||||
<span class="lineno"> 39 </span><span class="decl"><span class="nottickedoff">serve verbose mbGHCPath extraGHCOpts mbSelfPath = withManager $ \watch -> do</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">hSetBuffering stdin NoBuffering</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">self <- maybe requireOwnSource pure mbSelfPath</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="nottickedoff">when verbose $</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="nottickedoff">logMsg $ "Found own source code at: " ++ self</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="nottickedoff">hasConnectionVar <- newMVar False</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="nottickedoff">ghci <- ghciBackend mbGHCPath self</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">-- There might already browser window open. Wait 2s to see if that window</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">-- connects to us. If not, open a new window.</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="nottickedoff">_ <- forkIO $ do</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">threadDelay (2*10^(6::Int))</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="nottickedoff">hasConn <- readMVar hasConnectionVar</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="nottickedoff">unless hasConn openViewer</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "Listening..."</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">let options = ServerOptions</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">{ serverHost = "127.0.0.1"</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">, serverPort = 9161</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">, serverConnectionOptions = opts</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">, serverRequirePong = Nothing }</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">withSystemTempDirectory "reanimate-svgs" $ \tmpDir -></span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">runServerWithOptions options $ \pending -> do</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "New connection received."</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="nottickedoff">hasConn <- swapMVar hasConnectionVar True</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="nottickedoff">if hasConn</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="nottickedoff">then do</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "Already connected to browser. Rejecting."</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">rejectRequestWith pending defaultRejectRequest</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">else do</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">createDirectoryIfMissing True tmpDir</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">conn <- acceptRequest pending</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">slave <- newEmptyMVar</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">let handler = modifyMVar_ slave $ \tid -> do</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "Reloading code..."</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">killThread tid</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">forkIO $ ignoreErrors $ slaveHandler verbose mbGHCPath extraGHCOpts conn ghci self tmpDir</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">killSlave = do</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="nottickedoff">tid <- takeMVar slave</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="nottickedoff">killThread tid</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="nottickedoff">stop <- watchFile watch self handler</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="nottickedoff">putMVar slave =<< forkIO (return ())</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="nottickedoff">handler</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="nottickedoff">let loop = do</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="nottickedoff">-- FIXME: We don't use msg here.</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="nottickedoff">_msg <- receiveData conn :: IO T.Text</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="nottickedoff">handler</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="nottickedoff">loop</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="nottickedoff">cleanup = do</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="nottickedoff">stop</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="nottickedoff">killSlave</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="nottickedoff">_ <- swapMVar hasConnectionVar False</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="nottickedoff">return ()</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="nottickedoff">loop `finally` cleanup</span></span>
|
||||
<span class="lineno"> 93 </span>
|
||||
<span class="lineno"> 94 </span>ignoreErrors :: IO () -> IO ()
|
||||
<span class="lineno"> 95 </span><span class="decl"><span class="nottickedoff">ignoreErrors action = action `catch` \(_::SomeException) -> return ()</span></span>
|
||||
<span class="lineno"> 96 </span>
|
||||
<span class="lineno"> 97 </span>openViewer :: IO ()
|
||||
<span class="lineno"> 98 </span><span class="decl"><span class="nottickedoff">openViewer = do</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="nottickedoff">url <- getDataFileName "viewer-elm/dist/index.html"</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "Opening browser..."</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="nottickedoff">bSucc <- openBrowser url</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="nottickedoff">if bSucc</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="nottickedoff">then logMsg "Browser opened."</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="nottickedoff">else hPutStrLn stderr $ "Failed to open browser. Manually visit: " ++ url</span></span>
|
||||
<span class="lineno"> 105 </span>
|
||||
<span class="lineno"> 106 </span>slaveHandler :: Bool -> Maybe FilePath -> [String] -> Connection -> GhciBackend
|
||||
<span class="lineno"> 107 </span> -> FilePath -> FilePath -> IO ()
|
||||
<span class="lineno"> 108 </span><span class="decl"><span class="nottickedoff">slaveHandler verbose mbGHCPath extraGHCOpts conn ghci self svgDir =</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">withCurrentDirectory (takeDirectory self) $</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="nottickedoff">withSystemTempDirectory "reanimate" $ \tmpDir -></span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="nottickedoff">withTempFile tmpDir "reanimate.exe" $ \tmpExecutable handle -> do</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="nottickedoff">outputFolder <- createTempDirectory svgDir "svgs"</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="nottickedoff">let frameFileName frameIdx =</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="nottickedoff">outputFolder </> show frameIdx <.> "svg"</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">sentFrameCount <- newMVar False</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">hClose handle</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">lock <- newMVar ()</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebStatus "Compiling"</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">ghciThread <- forkIO $ do</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">firstFrame <- newIORef True</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">ghciReload ghci</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "GHCi reload done."</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">ghciGenerate ghci outputFolder $ \frameIdx -> do</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">first <- readIORef firstFrame</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">writeIORef firstFrame False</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">if first</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">then do</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="nottickedoff">modifyMVar_ sentFrameCount $ \sent -> do</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">unless sent $</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebFrameCount frameIdx</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "Framecount sent."</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">return True</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff">else</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">withMVar lock $ \_ -></span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebFrame frameIdx (frameFileName frameIdx)</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "GHCi render done."</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">ret <- case mbGHCPath of</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> do</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="nottickedoff">let args = ["ghc", "--"] ++ ghcOptions tmpDir ++ extraGHCOpts ++ [takeFileName self, "-o", tmpExecutable]</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="nottickedoff">when verbose $</span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="nottickedoff">logMsg $ "Running: " ++ showCommandForUser "stack" args</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="nottickedoff">runCmd_ "stack" args</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">Just ghc -> do</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="nottickedoff">let args = ghcOptions tmpDir ++ extraGHCOpts ++ [takeFileName self, "-o", tmpExecutable]</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="nottickedoff">when verbose $</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="nottickedoff">logMsg $ "Running: " ++ showCommandForUser ghc args</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="nottickedoff">runCmd_ ghc args</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "Compile done."</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">case ret of</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">Left err -></span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebError $ unlines (lines err)</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">Right{} -> runCmdLazy tmpExecutable (execOpts outputFolder) $ \getFrame -> do</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">frameCount <- expectFrame =<< getFrame</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">modifyMVar_ sentFrameCount $ \sent -> do</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">unless sent $</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebFrameCount frameCount</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="nottickedoff">return True</span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="nottickedoff">replicateM_ frameCount $ do</span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="nottickedoff">frameIdx <- expectFrame =<< getFrame</span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="nottickedoff">withMVar lock $ \_ -></span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebFrame frameIdx (frameFileName frameIdx)</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff">logMsg "Optimized render done."</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">killThread ghciThread</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="nottickedoff">execOpts output =</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="nottickedoff">[ "raw", "--output", output, "--offset", "1"</span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="nottickedoff">, "+RTS", "-N", "-M2G", "-RTS"]</span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="nottickedoff">expectFrame :: Either String Text -> IO Int</span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="nottickedoff">expectFrame (Left "") = do</span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebStatus "Done"</span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="nottickedoff">exitSuccess</span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="nottickedoff">expectFrame (Left err) = do</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebError err</span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="nottickedoff">exitWith (ExitFailure 1)</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="nottickedoff">expectFrame (Right frame) =</span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="nottickedoff">case T.decimal frame of</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">Left err -> do</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn stderr (T.unpack frame)</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn stderr $ "expectFrame: " ++ err</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebError err</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="nottickedoff">exitWith (ExitFailure 1)</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="nottickedoff">Right (frameNumber, "") -></span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="nottickedoff">pure frameNumber</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff">Right {} -> do</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff">let err = "Unexpected output"</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn stderr (T.unpack frame)</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn stderr $ "expectFrame: " ++ err</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="nottickedoff">sendWebMessage conn $ WebError err</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="nottickedoff">exitWith (ExitFailure 1)</span></span>
|
||||
<span class="lineno"> 191 </span>
|
||||
<span class="lineno"> 192 </span>watchFile :: WatchManager -> FilePath -> IO () -> IO StopListening
|
||||
<span class="lineno"> 193 </span><span class="decl"><span class="nottickedoff">watchFile watch file action = watchTree watch (takeDirectory file) check (const action)</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="nottickedoff">check event =</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="nottickedoff">takeFileName (eventPath event) == takeFileName file ||</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="nottickedoff">takeExtension (eventPath event) `elem` sourceExtensions ||</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="nottickedoff">takeExtension (eventPath event) `elem` dataExtensions</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="nottickedoff">sourceExtensions = [".hs", ".lhs"]</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="nottickedoff">dataExtensions = [".jpg", ".png", ".bmp", ".pov", ".tex", ".csv"]</span></span>
|
||||
<span class="lineno"> 201 </span>
|
||||
<span class="lineno"> 202 </span>ghcOptions :: FilePath -> [String]
|
||||
<span class="lineno"> 203 </span><span class="decl"><span class="nottickedoff">ghcOptions tmpDir =</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="nottickedoff">["-rtsopts", "--make", "-threaded", "-O2"] ++</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="nottickedoff">["-odir", tmpDir, "-hidir", tmpDir]</span></span>
|
||||
<span class="lineno"> 206 </span>
|
||||
<span class="lineno"> 207 </span>-- FIXME: Move to a different module
|
||||
<span class="lineno"> 208 </span>requireOwnSource :: IO FilePath
|
||||
<span class="lineno"> 209 </span><span class="decl"><span class="nottickedoff">requireOwnSource = do</span>
|
||||
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="nottickedoff">mbSelf <- findOwnSource</span>
|
||||
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="nottickedoff">case mbSelf of</span>
|
||||
<span class="lineno"> 212 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> do</span>
|
||||
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn stderr</span>
|
||||
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="nottickedoff">"Rendering in browser window is only available when interpreting.\n\</span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="nottickedoff">\To render a video file, use the 'render' command or run again with --help\n\</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="nottickedoff">\to see all available options."</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">exitFailure</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="nottickedoff">Just self -> pure self</span></span>
|
||||
<span class="lineno"> 219 </span>
|
||||
<span class="lineno"> 220 </span>findOwnSource :: IO (Maybe FilePath)
|
||||
<span class="lineno"> 221 </span><span class="decl"><span class="nottickedoff">findOwnSource = do</span>
|
||||
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="nottickedoff">fullArgs <- getFullArgs</span>
|
||||
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="nottickedoff">stackSource <- makeAbsolute (last fullArgs)</span>
|
||||
<span class="lineno"> 224 </span><span class="spaces"> </span><span class="nottickedoff">exist <- doesFileExist stackSource</span>
|
||||
<span class="lineno"> 225 </span><span class="spaces"> </span><span class="nottickedoff">if exist && isHaskellFile stackSource</span>
|
||||
<span class="lineno"> 226 </span><span class="spaces"> </span><span class="nottickedoff">then return (Just stackSource)</span>
|
||||
<span class="lineno"> 227 </span><span class="spaces"> </span><span class="nottickedoff">else do</span>
|
||||
<span class="lineno"> 228 </span><span class="spaces"> </span><span class="nottickedoff">prog <- getProgName</span>
|
||||
<span class="lineno"> 229 </span><span class="spaces"> </span><span class="nottickedoff">let hsProg</span>
|
||||
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="nottickedoff">| isHaskellFile prog = prog</span>
|
||||
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = replaceExtension prog "hs"</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="nottickedoff">lst <- listDirectory "."</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="nottickedoff">findFile ("." : lst) hsProg</span></span>
|
||||
<span class="lineno"> 234 </span>
|
||||
<span class="lineno"> 235 </span>isHaskellFile :: FilePath -> Bool
|
||||
<span class="lineno"> 236 </span><span class="decl"><span class="nottickedoff">isHaskellFile path = takeExtension path `elem` [".hs", ".lhs"]</span></span>
|
||||
<span class="lineno"> 237 </span>
|
||||
<span class="lineno"> 238 </span>logMsg :: String -> IO ()
|
||||
<span class="lineno"> 239 </span><span class="decl"><span class="nottickedoff">logMsg msg = do</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="nottickedoff">now <- getCurrentTime</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="nottickedoff">putStrLn $ formatTime defaultTimeLocale fmt now ++ ": " ++ msg</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="nottickedoff">fmt = "%F %T%2Q"</span></span>
|
||||
<span class="lineno"> 244 </span>
|
||||
<span class="lineno"> 245 </span>-------------------------------------------------------------------------------
|
||||
<span class="lineno"> 246 </span>-- Ghci interface
|
||||
<span class="lineno"> 247 </span>
|
||||
<span class="lineno"> 248 </span>-- stack
|
||||
<span class="lineno"> 249 </span>-- cabal
|
||||
<span class="lineno"> 250 </span>-- raw
|
||||
<span class="lineno"> 251 </span>-- none?
|
||||
<span class="lineno"> 252 </span>data GhciBackend = GhciBackend (MVar Ghci)
|
||||
<span class="lineno"> 253 </span>
|
||||
<span class="lineno"> 254 </span>ghciBackend :: Maybe FilePath -> FilePath -> IO GhciBackend
|
||||
<span class="lineno"> 255 </span><span class="decl"><span class="nottickedoff">ghciBackend mbGHCPath self = do</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="nottickedoff">let ghciProc =</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="nottickedoff">case mbGHCPath of</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="nottickedoff">Just ghcPath -></span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="nottickedoff">proc ghcPath $ ["--interactive", "+RTS"] ++ words memoryLimit ++ ["-RTS"]</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -></span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="nottickedoff">proc "stack" ["exec", "ghci", "--rts-options="++memoryLimit]</span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="nottickedoff">(ghci, _loads) <- startGhciProcess ghciProc $ \_stream _msg -> return ()</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="nottickedoff">void $ exec ghci $ ":load " ++ self</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="nottickedoff">ref <- newMVar ghci</span>
|
||||
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="nottickedoff">return $ GhciBackend ref</span></span>
|
||||
<span class="lineno"> 266 </span>
|
||||
<span class="lineno"> 267 </span>ghciReload :: GhciBackend -> IO ()
|
||||
<span class="lineno"> 268 </span><span class="decl"><span class="nottickedoff">ghciReload (GhciBackend ref) =</span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="nottickedoff">withMVar ref $ \ghci -></span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="nottickedoff">void $ reload ghci</span></span>
|
||||
<span class="lineno"> 271 </span>
|
||||
<span class="lineno"> 272 </span>ghciGenerate :: GhciBackend -> FilePath -> (Int -> IO ()) -> IO ()
|
||||
<span class="lineno"> 273 </span><span class="decl"><span class="nottickedoff">ghciGenerate (GhciBackend ref) target cb = withMVar ref $ \ghci -> do</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="nottickedoff">execStream ghci (":main raw --output=" ++ target ++ " --offset=1")</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="nottickedoff">$ \_ msg -></span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="nottickedoff">case reads msg of</span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="nottickedoff">[(frameIdx,"")] -> cb frameIdx</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="nottickedoff">_ -> return ()</span></span>
|
||||
<span class="lineno"> 279 </span>
|
||||
<span class="lineno"> 280 </span>memoryLimit :: String
|
||||
<span class="lineno"> 281 </span><span class="decl"><span class="nottickedoff">memoryLimit = "-M1G"</span></span>
|
||||
<span class="lineno"> 282 </span>
|
||||
<span class="lineno"> 283 </span>-------------------------------------------------------------------------------
|
||||
<span class="lineno"> 284 </span>-- Websocket API
|
||||
<span class="lineno"> 285 </span>
|
||||
<span class="lineno"> 286 </span>data WebMessage
|
||||
<span class="lineno"> 287 </span> = WebStatus String
|
||||
<span class="lineno"> 288 </span> | WebError String
|
||||
<span class="lineno"> 289 </span> | WebFrameCount Int
|
||||
<span class="lineno"> 290 </span> | WebFrame Int FilePath
|
||||
<span class="lineno"> 291 </span>
|
||||
<span class="lineno"> 292 </span>sendWebMessage :: Connection -> WebMessage -> IO ()
|
||||
<span class="lineno"> 293 </span><span class="decl"><span class="nottickedoff">sendWebMessage conn msg = sendTextData conn $</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="nottickedoff">case msg of</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">WebStatus txt -> T.pack "status\n" <> T.pack txt</span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="nottickedoff">WebError txt -> T.pack "error\n" <> T.pack txt</span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="nottickedoff">WebFrameCount n -> T.pack $ "frame_count\n" ++ show n</span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="nottickedoff">WebFrame n path -> T.pack $ "frame\n" ++ show n ++ "\n" ++ path</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
246
reanimate-0.4.2.0-inplace/Reanimate.Driver.hs.html
Normal file
246
reanimate-0.4.2.0-inplace/Reanimate.Driver.hs.html
Normal file
|
|
@ -0,0 +1,246 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE MultiWayIf #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE RecordWildCards #-}
|
||||
<span class="lineno"> 3 </span>module Reanimate.Driver
|
||||
<span class="lineno"> 4 </span> ( reanimate
|
||||
<span class="lineno"> 5 </span> )
|
||||
<span class="lineno"> 6 </span>where
|
||||
<span class="lineno"> 7 </span>
|
||||
<span class="lineno"> 8 </span>import Control.Applicative ((<|>))
|
||||
<span class="lineno"> 9 </span>import Control.Monad
|
||||
<span class="lineno"> 10 </span>import Data.Maybe
|
||||
<span class="lineno"> 11 </span>import Data.Either
|
||||
<span class="lineno"> 12 </span>import Reanimate.Animation (Animation)
|
||||
<span class="lineno"> 13 </span>import Reanimate.Driver.Check
|
||||
<span class="lineno"> 14 </span>import Reanimate.Driver.CLI
|
||||
<span class="lineno"> 15 </span>import Reanimate.Driver.Compile
|
||||
<span class="lineno"> 16 </span>import Reanimate.Driver.Server
|
||||
<span class="lineno"> 17 </span>import Reanimate.Parameters
|
||||
<span class="lineno"> 18 </span>import Reanimate.Render (render, renderSnippets, renderSvgs,
|
||||
<span class="lineno"> 19 </span> selectRaster)
|
||||
<span class="lineno"> 20 </span>import System.Directory
|
||||
<span class="lineno"> 21 </span>import System.Exit
|
||||
<span class="lineno"> 22 </span>import System.FilePath
|
||||
<span class="lineno"> 23 </span>import System.IO
|
||||
<span class="lineno"> 24 </span>import Text.Printf
|
||||
<span class="lineno"> 25 </span>
|
||||
<span class="lineno"> 26 </span>presetFormat :: Preset -> Format
|
||||
<span class="lineno"> 27 </span><span class="decl"><span class="nottickedoff">presetFormat Youtube = RenderMp4</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"></span><span class="nottickedoff">presetFormat ExampleGif = RenderGif</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"></span><span class="nottickedoff">presetFormat Quick = RenderMp4</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"></span><span class="nottickedoff">presetFormat MediumQ = RenderMp4</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"></span><span class="nottickedoff">presetFormat HighQ = RenderMp4</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"></span><span class="nottickedoff">presetFormat LowFPS = RenderMp4</span></span>
|
||||
<span class="lineno"> 33 </span>
|
||||
<span class="lineno"> 34 </span>presetFPS :: Preset -> FPS
|
||||
<span class="lineno"> 35 </span><span class="decl"><span class="nottickedoff">presetFPS Youtube = 60</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"></span><span class="nottickedoff">presetFPS ExampleGif = 25</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"></span><span class="nottickedoff">presetFPS Quick = 15</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"></span><span class="nottickedoff">presetFPS MediumQ = 30</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"></span><span class="nottickedoff">presetFPS HighQ = 30</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"></span><span class="nottickedoff">presetFPS LowFPS = 10</span></span>
|
||||
<span class="lineno"> 41 </span>
|
||||
<span class="lineno"> 42 </span>presetWidth :: Preset -> Width
|
||||
<span class="lineno"> 43 </span><span class="decl"><span class="nottickedoff">presetWidth Youtube = 2560</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"></span><span class="nottickedoff">presetWidth ExampleGif = 320</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"></span><span class="nottickedoff">presetWidth Quick = 320</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"></span><span class="nottickedoff">presetWidth MediumQ = 800</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"></span><span class="nottickedoff">presetWidth HighQ = 1920</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"></span><span class="nottickedoff">presetWidth LowFPS = presetWidth HighQ</span></span>
|
||||
<span class="lineno"> 49 </span>
|
||||
<span class="lineno"> 50 </span>presetHeight :: Preset -> Height
|
||||
<span class="lineno"> 51 </span><span class="decl"><span class="nottickedoff">presetHeight preset = presetWidth preset * 9 `div` 16</span></span>
|
||||
<span class="lineno"> 52 </span>
|
||||
<span class="lineno"> 53 </span>formatFPS :: Format -> FPS
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">formatFPS RenderMp4 = 60</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"></span><span class="nottickedoff">formatFPS RenderGif = 25</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"></span><span class="nottickedoff">formatFPS RenderWebm = 60</span></span>
|
||||
<span class="lineno"> 57 </span>
|
||||
<span class="lineno"> 58 </span>formatWidth :: Format -> Width
|
||||
<span class="lineno"> 59 </span><span class="decl"><span class="nottickedoff">formatWidth RenderMp4 = 2560</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"></span><span class="nottickedoff">formatWidth RenderGif = 320</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"></span><span class="nottickedoff">formatWidth RenderWebm = 2560</span></span>
|
||||
<span class="lineno"> 62 </span>
|
||||
<span class="lineno"> 63 </span>formatHeight :: Format -> Height
|
||||
<span class="lineno"> 64 </span><span class="decl"><span class="nottickedoff">formatHeight RenderMp4 = 1440</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"></span><span class="nottickedoff">formatHeight RenderGif = 180</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"></span><span class="nottickedoff">formatHeight RenderWebm = 1440</span></span>
|
||||
<span class="lineno"> 67 </span>
|
||||
<span class="lineno"> 68 </span>formatExtension :: Format -> String
|
||||
<span class="lineno"> 69 </span><span class="decl"><span class="nottickedoff">formatExtension RenderMp4 = "mp4"</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"></span><span class="nottickedoff">formatExtension RenderGif = "gif"</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"></span><span class="nottickedoff">formatExtension RenderWebm = "webm"</span></span>
|
||||
<span class="lineno"> 72 </span>
|
||||
<span class="lineno"> 73 </span>{-|
|
||||
<span class="lineno"> 74 </span>Main entry-point for accessing an animation. Creates a program that takes the
|
||||
<span class="lineno"> 75 </span>following command-line arguments:
|
||||
<span class="lineno"> 76 </span>
|
||||
<span class="lineno"> 77 </span>> Usage: PROG [COMMAND]
|
||||
<span class="lineno"> 78 </span>> This program contains an animation which can either be viewed in a web-browser
|
||||
<span class="lineno"> 79 </span>> or rendered to disk.
|
||||
<span class="lineno"> 80 </span>>
|
||||
<span class="lineno"> 81 </span>> Available options:
|
||||
<span class="lineno"> 82 </span>> -h,--help Show this help text
|
||||
<span class="lineno"> 83 </span>>
|
||||
<span class="lineno"> 84 </span>> Available commands:
|
||||
<span class="lineno"> 85 </span>> check Run a system's diagnostic and report any missing
|
||||
<span class="lineno"> 86 </span>> external dependencies.
|
||||
<span class="lineno"> 87 </span>> view Play animation in browser window.
|
||||
<span class="lineno"> 88 </span>> render Render animation to file.
|
||||
<span class="lineno"> 89 </span>
|
||||
<span class="lineno"> 90 </span>Neither the \'check\' nor the \'view\' command take any additional arguments.
|
||||
<span class="lineno"> 91 </span>Rendering animation can be controlled with these arguments:
|
||||
<span class="lineno"> 92 </span>
|
||||
<span class="lineno"> 93 </span>> Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
|
||||
<span class="lineno"> 94 </span>> [-h|--height PIXELS] [--compile] [--format FMT]
|
||||
<span class="lineno"> 95 </span>> [--preset TYPE]
|
||||
<span class="lineno"> 96 </span>> Render animation to file.
|
||||
<span class="lineno"> 97 </span>>
|
||||
<span class="lineno"> 98 </span>> Available options:
|
||||
<span class="lineno"> 99 </span>> -o,--target FILE Write output to FILE
|
||||
<span class="lineno"> 100 </span>> --fps FPS Set frames per second.
|
||||
<span class="lineno"> 101 </span>> -w,--width PIXELS Set video width.
|
||||
<span class="lineno"> 102 </span>> -h,--height PIXELS Set video height.
|
||||
<span class="lineno"> 103 </span>> --compile Compile source code before rendering.
|
||||
<span class="lineno"> 104 </span>> --format FMT Video format: mp4, gif, webm
|
||||
<span class="lineno"> 105 </span>> --preset TYPE Parameter presets: youtube, gif, quick
|
||||
<span class="lineno"> 106 </span>> -h,--help Show this help text
|
||||
<span class="lineno"> 107 </span>-}
|
||||
<span class="lineno"> 108 </span>reanimate :: Animation -> IO ()
|
||||
<span class="lineno"> 109 </span><span class="decl"><span class="istickedoff">reanimate animation = do</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff">Options {..} <- getDriverOptions</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">case optsCommand of</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff">Raw {..} -> <span class="nottickedoff">do</span></span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setFPS 60</span></span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">renderSvgs rawOutputFolder rawFrameOffset rawPrettyPrint animation</span></span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">Test -> do</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">setNoExternals True</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">-- hSetBinaryMode stdout True</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">renderSnippets animation</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">Check -> <span class="nottickedoff">checkEnvironment</span></span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff">View {..} -> <span class="nottickedoff">serve viewVerbose viewGHCPath viewGHCOpts viewOrigin</span></span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff">Render {..} -> <span class="nottickedoff">do</span></span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let fmt =</span></span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">guessParameter renderFormat (fmap presetFormat renderPreset)</span></span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">$ case renderTarget of</span></span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Format guessed from output</span></span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Just target -> case takeExtension target of</span></span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">".mp4" -> RenderMp4</span></span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">".gif" -> RenderGif</span></span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">".webm" -> RenderWebm</span></span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> RenderMp4</span></span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Default to mp4 rendering.</span></span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Nothing -> RenderMp4</span></span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">target <- case renderTarget of</span></span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Nothing -> do</span></span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mbSelf <- findOwnSource</span></span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let ext = formatExtension fmt</span></span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">self = fromMaybe "output" mbSelf</span></span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ replaceExtension self ext</span></span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Just target -> makeAbsolute target</span></span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let</span></span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">fps =</span></span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">guessParameter renderFPS (fmap presetFPS renderPreset) $ formatFPS fmt</span></span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(width, height) = fromMaybe</span></span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">( maybe (formatWidth fmt) presetWidth renderPreset</span></span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, maybe (formatHeight fmt) presetHeight renderPreset</span></span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">)</span></span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(userPreferredDimensions renderWidth renderHeight)</span></span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">raster <-</span></span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if renderRaster == RasterNone || renderRaster == RasterAuto then do</span></span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">svgSupport <- hasFFmpegRSvg</span></span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if isRight svgSupport</span></span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">then selectRaster renderRaster</span></span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else do</span></span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">raster <- selectRaster RasterAuto</span></span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">when (raster == RasterNone) $ do</span></span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">hPutStrLn stderr $</span></span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">"Error: your FFmpeg was built without SVG support and no raster engines \</span></span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\are available. Please install either inkscape, imagemagick, or rsvg."</span></span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">exitWith (ExitFailure 1)</span></span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">return raster</span></span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else selectRaster renderRaster</span></span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if renderCompile</span></span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">then compile $</span></span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[ "render"</span></span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "--fps"</span></span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show fps</span></span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "--width"</span></span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show width</span></span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "--height"</span></span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show height</span></span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "--format"</span></span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, showFormat fmt</span></span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "--raster"</span></span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, showRaster raster</span></span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "--target"</span></span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, target</span></span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "+RTS"</span></span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "-N"</span></span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, "-RTS"</span></span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">] ++ [ "--partial" | renderPartial ]</span></span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else do</span></span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setRaster raster</span></span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setFPS fps</span></span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setWidth width</span></span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setHeight height</span></span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">printf</span></span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">"Animation options:\n\</span></span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ fps: %d\n\</span></span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ width: %d\n\</span></span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ height: %d\n\</span></span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ fmt: %s\n\</span></span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ target: %s\n\</span></span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ raster: %s\n"</span></span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">fps</span></span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">width</span></span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">height</span></span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(showFormat fmt)</span></span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">target</span></span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(show raster)</span></span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">render animation target raster fmt width height fps renderPartial</span></span></span>
|
||||
<span class="lineno"> 206 </span>
|
||||
<span class="lineno"> 207 </span>guessParameter :: Maybe a -> Maybe a -> a -> a
|
||||
<span class="lineno"> 208 </span><span class="decl"><span class="nottickedoff">guessParameter a b def = fromMaybe def (a <|> b)</span></span>
|
||||
<span class="lineno"> 209 </span>
|
||||
<span class="lineno"> 210 </span>
|
||||
<span class="lineno"> 211 </span>-- If user specifies exactly one dimension explicitly, calculate the other
|
||||
<span class="lineno"> 212 </span>userPreferredDimensions :: Maybe Width -> Maybe Height -> Maybe (Width, Height)
|
||||
<span class="lineno"> 213 </span><span class="decl"><span class="nottickedoff">userPreferredDimensions (Just width) (Just height) = Just (width, height)</span>
|
||||
<span class="lineno"> 214 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions (Just width) Nothing =</span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="nottickedoff">Just (width, makeEven $ width * 9 `div` 16)</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions Nothing (Just height) =</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">Just (makeEven $ height * 16 `div` 9, height)</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions Nothing Nothing = Nothing</span></span>
|
||||
<span class="lineno"> 219 </span>
|
||||
<span class="lineno"> 220 </span>-- Avoid ffmpeg failures "height not divisible by 2"
|
||||
<span class="lineno"> 221 </span>makeEven :: Int -> Int
|
||||
<span class="lineno"> 222 </span><span class="decl"><span class="nottickedoff">makeEven x | even x = x</span>
|
||||
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x - 1</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
131
reanimate-0.4.2.0-inplace/Reanimate.Ease.hs.html
Normal file
131
reanimate-0.4.2.0-inplace/Reanimate.Ease.hs.html
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span> Easing functions modify the rate of change in animations.
|
||||
<span class="lineno"> 3 </span> More examples can be seen here: <https://easings.net/>.
|
||||
<span class="lineno"> 4 </span>-}
|
||||
<span class="lineno"> 5 </span>module Reanimate.Ease
|
||||
<span class="lineno"> 6 </span> ( Signal
|
||||
<span class="lineno"> 7 </span> , constantS
|
||||
<span class="lineno"> 8 </span> , fromToS
|
||||
<span class="lineno"> 9 </span> , reverseS
|
||||
<span class="lineno"> 10 </span> , curveS
|
||||
<span class="lineno"> 11 </span> , powerS
|
||||
<span class="lineno"> 12 </span> , bellS
|
||||
<span class="lineno"> 13 </span> , oscillateS
|
||||
<span class="lineno"> 14 </span> , cubicBezierS
|
||||
<span class="lineno"> 15 </span> ) where
|
||||
<span class="lineno"> 16 </span>
|
||||
<span class="lineno"> 17 </span>-- | Signals are time-varying variables. Signals can be composed using function
|
||||
<span class="lineno"> 18 </span>-- composition.
|
||||
<span class="lineno"> 19 </span>type Signal = Double -> Double
|
||||
<span class="lineno"> 20 </span>
|
||||
<span class="lineno"> 21 </span>-- | Constant signal.
|
||||
<span class="lineno"> 22 </span>--
|
||||
<span class="lineno"> 23 </span>-- Example:
|
||||
<span class="lineno"> 24 </span>--
|
||||
<span class="lineno"> 25 </span>-- > signalA (constantS 0.5) drawProgress
|
||||
<span class="lineno"> 26 </span>--
|
||||
<span class="lineno"> 27 </span>-- <<docs/gifs/doc_constantS.gif>>
|
||||
<span class="lineno"> 28 </span>constantS :: Double -> Signal
|
||||
<span class="lineno"> 29 </span><span class="decl"><span class="istickedoff">constantS = const</span></span>
|
||||
<span class="lineno"> 30 </span>
|
||||
<span class="lineno"> 31 </span>-- | Signal with new starting and end values.
|
||||
<span class="lineno"> 32 </span>--
|
||||
<span class="lineno"> 33 </span>-- Example:
|
||||
<span class="lineno"> 34 </span>--
|
||||
<span class="lineno"> 35 </span>-- > signalA (fromToS 0.8 0.2) drawProgress
|
||||
<span class="lineno"> 36 </span>--
|
||||
<span class="lineno"> 37 </span>-- <<docs/gifs/doc_fromToS.gif>>
|
||||
<span class="lineno"> 38 </span>fromToS :: Double -> Double -> Signal
|
||||
<span class="lineno"> 39 </span><span class="decl"><span class="istickedoff">fromToS from to t = from + (to-from)*t</span></span>
|
||||
<span class="lineno"> 40 </span>
|
||||
<span class="lineno"> 41 </span>-- | Reverse signal order.
|
||||
<span class="lineno"> 42 </span>--
|
||||
<span class="lineno"> 43 </span>-- Example:
|
||||
<span class="lineno"> 44 </span>--
|
||||
<span class="lineno"> 45 </span>-- > signalA reverseS drawProgress
|
||||
<span class="lineno"> 46 </span>--
|
||||
<span class="lineno"> 47 </span>-- <<docs/gifs/doc_reverseS.gif>>
|
||||
<span class="lineno"> 48 </span>reverseS :: Signal
|
||||
<span class="lineno"> 49 </span><span class="decl"><span class="istickedoff">reverseS t = 1-t</span></span>
|
||||
<span class="lineno"> 50 </span>
|
||||
<span class="lineno"> 51 </span>-- | S-curve signal. Takes a steepness parameter. 2 is a good default.
|
||||
<span class="lineno"> 52 </span>--
|
||||
<span class="lineno"> 53 </span>-- Example:
|
||||
<span class="lineno"> 54 </span>--
|
||||
<span class="lineno"> 55 </span>-- > signalA (curveS 2) drawProgress
|
||||
<span class="lineno"> 56 </span>--
|
||||
<span class="lineno"> 57 </span>-- <<docs/gifs/doc_curveS.gif>>
|
||||
<span class="lineno"> 58 </span>curveS :: Double -> Signal
|
||||
<span class="lineno"> 59 </span><span class="decl"><span class="istickedoff">curveS steepness s =</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">if s < 0.5</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff">then 0.5 * (2*s)**steepness</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">else 1-0.5 * (2 - 2*s)**steepness</span></span>
|
||||
<span class="lineno"> 63 </span>
|
||||
<span class="lineno"> 64 </span>-- | Power curve signal. Takes a steepness parameter. 2 is a good default.
|
||||
<span class="lineno"> 65 </span>--
|
||||
<span class="lineno"> 66 </span>-- Example:
|
||||
<span class="lineno"> 67 </span>--
|
||||
<span class="lineno"> 68 </span>-- > signalA (powerS 2) drawProgress
|
||||
<span class="lineno"> 69 </span>--
|
||||
<span class="lineno"> 70 </span>-- <<docs/gifs/doc_powerS.gif>>
|
||||
<span class="lineno"> 71 </span>powerS :: Double -> Signal
|
||||
<span class="lineno"> 72 </span><span class="decl"><span class="nottickedoff">powerS steepness s = s**steepness</span></span>
|
||||
<span class="lineno"> 73 </span>
|
||||
<span class="lineno"> 74 </span>-- | Oscillate signal.
|
||||
<span class="lineno"> 75 </span>--
|
||||
<span class="lineno"> 76 </span>-- Example:
|
||||
<span class="lineno"> 77 </span>--
|
||||
<span class="lineno"> 78 </span>-- > signalA oscillateS drawProgress
|
||||
<span class="lineno"> 79 </span>--
|
||||
<span class="lineno"> 80 </span>-- <<docs/gifs/doc_oscillateS.gif>>
|
||||
<span class="lineno"> 81 </span>oscillateS :: Signal
|
||||
<span class="lineno"> 82 </span><span class="decl"><span class="istickedoff">oscillateS t =</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">if t < 1/2</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">then t*2</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">else 2-t*2</span></span>
|
||||
<span class="lineno"> 86 </span>
|
||||
<span class="lineno"> 87 </span>-- | Bell-curve signal. Takes a steepness parameter. 2 is a good default.
|
||||
<span class="lineno"> 88 </span>--
|
||||
<span class="lineno"> 89 </span>-- Example:
|
||||
<span class="lineno"> 90 </span>--
|
||||
<span class="lineno"> 91 </span>-- > signalA (bellS 2) drawProgress
|
||||
<span class="lineno"> 92 </span>--
|
||||
<span class="lineno"> 93 </span>-- <<docs/gifs/doc_bellS.gif>>
|
||||
<span class="lineno"> 94 </span>bellS :: Double -> Signal
|
||||
<span class="lineno"> 95 </span><span class="decl"><span class="istickedoff">bellS steepness = curveS steepness . oscillateS</span></span>
|
||||
<span class="lineno"> 96 </span>
|
||||
<span class="lineno"> 97 </span>-- | Cubic Bezier signal. Gives you a fair amount of control over how the
|
||||
<span class="lineno"> 98 </span>-- signal will curve.
|
||||
<span class="lineno"> 99 </span>--
|
||||
<span class="lineno"> 100 </span>-- Example:
|
||||
<span class="lineno"> 101 </span>--
|
||||
<span class="lineno"> 102 </span>-- > signalA (cubicBezierS (0.0, 0.8, 0.9, 1.0)) drawProgress
|
||||
<span class="lineno"> 103 </span>--
|
||||
<span class="lineno"> 104 </span>-- <<docs/gifs/doc_cubicBezierS.gif>>
|
||||
<span class="lineno"> 105 </span>cubicBezierS :: (Double, Double, Double, Double) -> Signal
|
||||
<span class="lineno"> 106 </span><span class="decl"><span class="istickedoff">cubicBezierS (x1, x2, x3, x4) s = </span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="istickedoff">let ms = 1-s</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="istickedoff">in x1*ms^(3::Int) + 3*x2*ms^(2::Int)*s + 3*x3*ms*s^(2::Int) + x4*s^(3::Int)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
154
reanimate-0.4.2.0-inplace/Reanimate.Effect.hs.html
Normal file
154
reanimate-0.4.2.0-inplace/Reanimate.Effect.hs.html
Normal file
|
|
@ -0,0 +1,154 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-| Effects represent modifications applied to frames of the 'Animation'.
|
||||
<span class="lineno"> 2 </span>Effects can (and usually do) depend on time.
|
||||
<span class="lineno"> 3 </span>One or more effects can be applied over the entire duration of animation, or modified to affect
|
||||
<span class="lineno"> 4 </span>only a specific portion at the beginning \/ middle \/ end of the animation.
|
||||
<span class="lineno"> 5 </span>-}
|
||||
<span class="lineno"> 6 </span>module Reanimate.Effect
|
||||
<span class="lineno"> 7 </span> ( -- * Primitive Effects
|
||||
<span class="lineno"> 8 </span> Effect
|
||||
<span class="lineno"> 9 </span> , fadeInE
|
||||
<span class="lineno"> 10 </span> , fadeOutE
|
||||
<span class="lineno"> 11 </span> , fadeLineInE
|
||||
<span class="lineno"> 12 </span> , fadeLineOutE
|
||||
<span class="lineno"> 13 </span> , fillInE
|
||||
<span class="lineno"> 14 </span> , drawInE
|
||||
<span class="lineno"> 15 </span> , drawOutE
|
||||
<span class="lineno"> 16 </span> , translateE
|
||||
<span class="lineno"> 17 </span> , scaleE
|
||||
<span class="lineno"> 18 </span> , constE
|
||||
<span class="lineno"> 19 </span> -- * Modifying Effects
|
||||
<span class="lineno"> 20 </span> , overBeginning
|
||||
<span class="lineno"> 21 </span> , overEnding
|
||||
<span class="lineno"> 22 </span> , overInterval
|
||||
<span class="lineno"> 23 </span> , reverseE
|
||||
<span class="lineno"> 24 </span> , delayE
|
||||
<span class="lineno"> 25 </span> , aroundCenterE
|
||||
<span class="lineno"> 26 </span> -- * Applying Effects to Animations
|
||||
<span class="lineno"> 27 </span> , applyE
|
||||
<span class="lineno"> 28 </span> ) where
|
||||
<span class="lineno"> 29 </span>
|
||||
<span class="lineno"> 30 </span>import Graphics.SvgTree (Tree)
|
||||
<span class="lineno"> 31 </span>import Reanimate.Animation
|
||||
<span class="lineno"> 32 </span>import Reanimate.Svg
|
||||
<span class="lineno"> 33 </span>
|
||||
<span class="lineno"> 34 </span>-- | An Effect represents a modification of a SVG 'Tree' that can vary with time.
|
||||
<span class="lineno"> 35 </span>type Effect = Duration -- ^ Duration of the effect (in seconds)
|
||||
<span class="lineno"> 36 </span> -> Time -- ^ Time elapsed from when the effect started (in seconds)
|
||||
<span class="lineno"> 37 </span> -> Tree -- ^ Image to be modified
|
||||
<span class="lineno"> 38 </span> -> Tree -- ^ Image after modification
|
||||
<span class="lineno"> 39 </span>
|
||||
<span class="lineno"> 40 </span>-- | Modify the effect so that it only applies to the initial part of the animation.
|
||||
<span class="lineno"> 41 </span>overBeginning :: Duration -- ^ Duration of the initial segment of the animation over which the Effect should be applied
|
||||
<span class="lineno"> 42 </span> -> Effect -- ^ The Effect to modify
|
||||
<span class="lineno"> 43 </span> -> Effect -- ^ Effect which will only affect the initial segment of the animation
|
||||
<span class="lineno"> 44 </span><span class="decl"><span class="istickedoff">overBeginning maxT effect _d t =</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff">if t < maxT</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">then effect maxT t</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff">else id</span></span>
|
||||
<span class="lineno"> 48 </span>
|
||||
<span class="lineno"> 49 </span>-- | Modify the effect so that it only applies to the ending part of the animation.
|
||||
<span class="lineno"> 50 </span>overEnding :: Duration -- ^ Duration of the ending segment of the animation over which the Effect should be applied
|
||||
<span class="lineno"> 51 </span> -> Effect -- ^ The Effect to modify
|
||||
<span class="lineno"> 52 </span> -> Effect -- ^ Effect which will only affect the ending segment of the animation
|
||||
<span class="lineno"> 53 </span><span class="decl"><span class="istickedoff">overEnding minT effect d t =</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff">if t >= blankDur</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">then effect minT (t-blankDur)</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">else id</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">blankDur = d-minT</span></span>
|
||||
<span class="lineno"> 59 </span>
|
||||
<span class="lineno"> 60 </span>-- | Modify the effect so that it only applies within given interval of animation's running time.
|
||||
<span class="lineno"> 61 </span>overInterval :: Time -- ^ time after start of animation when the effect should start
|
||||
<span class="lineno"> 62 </span> -> Time -- ^ time after start of the animation when the effect should finish
|
||||
<span class="lineno"> 63 </span> -> Effect -- ^ The Effect to modify
|
||||
<span class="lineno"> 64 </span> -> Effect -- ^ Effect which will only affect the specified interval within the animation
|
||||
<span class="lineno"> 65 </span><span class="decl"><span class="nottickedoff">overInterval start end effect _d t =</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="nottickedoff">if start <= t && t <= end</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">then effect dur ((t - start) / dur)</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">else id</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">dur = end - start</span></span>
|
||||
<span class="lineno"> 71 </span>
|
||||
<span class="lineno"> 72 </span>-- | @reverseE effect@ starts where the @effect@ ends and vice versa.
|
||||
<span class="lineno"> 73 </span>reverseE :: Effect -> Effect
|
||||
<span class="lineno"> 74 </span><span class="decl"><span class="istickedoff">reverseE fn d t = fn d (d-t)</span></span>
|
||||
<span class="lineno"> 75 </span>
|
||||
<span class="lineno"> 76 </span>-- | Delay the effect so that it only starts after specified duration and then runs till the end of animation.
|
||||
<span class="lineno"> 77 </span>delayE :: Duration -> Effect -> Effect
|
||||
<span class="lineno"> 78 </span><span class="decl"><span class="istickedoff">delayE delayT fn d = overEnding (d-delayT) fn d</span></span>
|
||||
<span class="lineno"> 79 </span>
|
||||
<span class="lineno"> 80 </span>-- | Modify the animation by applying the effect. If desired, you can apply multiple effects to single animation by calling this function multiple times.
|
||||
<span class="lineno"> 81 </span>applyE :: Effect -> Animation -> Animation
|
||||
<span class="lineno"> 82 </span><span class="decl"><span class="istickedoff">applyE fn ani = let d = duration ani</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">in mkAnimation d $ \t -> fn d (d*t) $ frameAt (d*t) ani</span></span>
|
||||
<span class="lineno"> 84 </span>
|
||||
<span class="lineno"> 85 </span>-- | Build an effect from an image-modifying function. This effect does not change as time passes.
|
||||
<span class="lineno"> 86 </span>constE :: (Tree -> Tree) -> Effect
|
||||
<span class="lineno"> 87 </span><span class="decl"><span class="istickedoff">constE fn _d _t = fn</span></span>
|
||||
<span class="lineno"> 88 </span>
|
||||
<span class="lineno"> 89 </span>-- | Change image opacity from 0 to 1.
|
||||
<span class="lineno"> 90 </span>fadeInE :: Effect
|
||||
<span class="lineno"> 91 </span><span class="decl"><span class="istickedoff">fadeInE d t = withGroupOpacity (t/d)</span></span>
|
||||
<span class="lineno"> 92 </span>
|
||||
<span class="lineno"> 93 </span>-- | Change image opacity from 1 to 0. Reverse of 'fadeInE'.
|
||||
<span class="lineno"> 94 </span>fadeOutE :: Effect
|
||||
<span class="lineno"> 95 </span><span class="decl"><span class="istickedoff">fadeOutE = reverseE fadeInE</span></span>
|
||||
<span class="lineno"> 96 </span>
|
||||
<span class="lineno"> 97 </span>-- | Change stroke width from 0 to given value.
|
||||
<span class="lineno"> 98 </span>fadeLineInE :: Double -> Effect
|
||||
<span class="lineno"> 99 </span><span class="decl"><span class="nottickedoff">fadeLineInE w d t = withStrokeWidth (w*(t/d))</span></span>
|
||||
<span class="lineno"> 100 </span>
|
||||
<span class="lineno"> 101 </span>-- | Change stroke width from given value to 0. Reverse of 'fadeLineInE'.
|
||||
<span class="lineno"> 102 </span>fadeLineOutE :: Double -> Effect
|
||||
<span class="lineno"> 103 </span><span class="decl"><span class="nottickedoff">fadeLineOutE = reverseE . fadeLineInE</span></span>
|
||||
<span class="lineno"> 104 </span>
|
||||
<span class="lineno"> 105 </span>-- | Effect of progressively drawing the image. Note that this will only affect primitive shapes (see 'pathify').
|
||||
<span class="lineno"> 106 </span>drawInE :: Effect
|
||||
<span class="lineno"> 107 </span><span class="decl"><span class="nottickedoff">drawInE d t = withFillOpacity 0 . partialSvg (t/d) . pathify</span></span>
|
||||
<span class="lineno"> 108 </span>
|
||||
<span class="lineno"> 109 </span>-- | Reverse of 'drawInE'.
|
||||
<span class="lineno"> 110 </span>drawOutE :: Effect
|
||||
<span class="lineno"> 111 </span><span class="decl"><span class="nottickedoff">drawOutE = reverseE drawInE</span></span>
|
||||
<span class="lineno"> 112 </span>
|
||||
<span class="lineno"> 113 </span>-- | Change fill opacity from 0 to 1.
|
||||
<span class="lineno"> 114 </span>fillInE :: Effect
|
||||
<span class="lineno"> 115 </span><span class="decl"><span class="nottickedoff">fillInE d t = withFillOpacity f</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">f = t/d</span></span>
|
||||
<span class="lineno"> 118 </span>
|
||||
<span class="lineno"> 119 </span>-- | Change scale from 1 to given value.
|
||||
<span class="lineno"> 120 </span>scaleE :: Double -> Effect
|
||||
<span class="lineno"> 121 </span><span class="decl"><span class="nottickedoff">scaleE target d t = scale (1 + (target-1) * t/d)</span></span>
|
||||
<span class="lineno"> 122 </span>
|
||||
<span class="lineno"> 123 </span>-- | Move the image from its current position to the target x y coordinates.
|
||||
<span class="lineno"> 124 </span>translateE :: Double -> Double -> Effect
|
||||
<span class="lineno"> 125 </span><span class="decl"><span class="istickedoff">translateE x y d t = translate (x * t/d) (y * t/d)</span></span>
|
||||
<span class="lineno"> 126 </span>
|
||||
<span class="lineno"> 127 </span>-- | Transform the effect so that the image passed to the effect's image-modifying
|
||||
<span class="lineno"> 128 </span>-- function has coordinates (0, 0) shifted to the center of its bounding box.
|
||||
<span class="lineno"> 129 </span>-- Also see 'aroundCenter'.
|
||||
<span class="lineno"> 130 </span>aroundCenterE :: Effect -> Effect
|
||||
<span class="lineno"> 131 </span><span class="decl"><span class="nottickedoff">aroundCenterE e d t = aroundCenter (e d t)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
205
reanimate-0.4.2.0-inplace/Reanimate.LaTeX.hs.html
Normal file
205
reanimate-0.4.2.0-inplace/Reanimate.LaTeX.hs.html
Normal file
|
|
@ -0,0 +1,205 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE OverloadedStrings #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE ScopedTypeVariables #-}
|
||||
<span class="lineno"> 3 </span>{-|
|
||||
<span class="lineno"> 4 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 5 </span>License : Unlicense
|
||||
<span class="lineno"> 6 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 7 </span>Stability : experimental
|
||||
<span class="lineno"> 8 </span>Portability : POSIX
|
||||
<span class="lineno"> 9 </span>-}
|
||||
<span class="lineno"> 10 </span>module Reanimate.LaTeX
|
||||
<span class="lineno"> 11 </span> ( latex
|
||||
<span class="lineno"> 12 </span> , latexWithHeaders
|
||||
<span class="lineno"> 13 </span> , latexChunks
|
||||
<span class="lineno"> 14 </span> , xelatex
|
||||
<span class="lineno"> 15 </span> , xelatexWithHeaders
|
||||
<span class="lineno"> 16 </span> , ctex
|
||||
<span class="lineno"> 17 </span> , ctexWithHeaders
|
||||
<span class="lineno"> 18 </span> , latexAlign
|
||||
<span class="lineno"> 19 </span> )
|
||||
<span class="lineno"> 20 </span>where
|
||||
<span class="lineno"> 21 </span>
|
||||
<span class="lineno"> 22 </span>import qualified Data.ByteString as B
|
||||
<span class="lineno"> 23 </span>import Data.Text ( Text )
|
||||
<span class="lineno"> 24 </span>import qualified Data.Text as T
|
||||
<span class="lineno"> 25 </span>import qualified Data.Text.Encoding as T
|
||||
<span class="lineno"> 26 </span>import Graphics.SvgTree ( Tree(..)
|
||||
<span class="lineno"> 27 </span> , parseSvgFile
|
||||
<span class="lineno"> 28 </span> )
|
||||
<span class="lineno"> 29 </span>import Reanimate.Cache
|
||||
<span class="lineno"> 30 </span>import Reanimate.Misc
|
||||
<span class="lineno"> 31 </span>import Reanimate.Svg
|
||||
<span class="lineno"> 32 </span>import Reanimate.Parameters
|
||||
<span class="lineno"> 33 </span>import System.FilePath ( replaceExtension
|
||||
<span class="lineno"> 34 </span> , takeFileName
|
||||
<span class="lineno"> 35 </span> , (</>)
|
||||
<span class="lineno"> 36 </span> )
|
||||
<span class="lineno"> 37 </span>import System.IO.Unsafe ( unsafePerformIO )
|
||||
<span class="lineno"> 38 </span>
|
||||
<span class="lineno"> 39 </span>-- | Invoke latex and import the result as an SVG object. SVG objects are
|
||||
<span class="lineno"> 40 </span>-- cached to improve performance.
|
||||
<span class="lineno"> 41 </span>--
|
||||
<span class="lineno"> 42 </span>-- Example:
|
||||
<span class="lineno"> 43 </span>--
|
||||
<span class="lineno"> 44 </span>-- > latex "$e^{i\\pi}+1=0$"
|
||||
<span class="lineno"> 45 </span>--
|
||||
<span class="lineno"> 46 </span>-- <<docs/gifs/doc_latex.gif>>
|
||||
<span class="lineno"> 47 </span>latex :: T.Text -> Tree
|
||||
<span class="lineno"> 48 </span><span class="decl"><span class="istickedoff">latex = latexWithHeaders <span class="nottickedoff">[]</span></span></span>
|
||||
<span class="lineno"> 49 </span>
|
||||
<span class="lineno"> 50 </span>-- | Invoke latex with extra script headers.
|
||||
<span class="lineno"> 51 </span>latexWithHeaders :: [T.Text] -> T.Text -> Tree
|
||||
<span class="lineno"> 52 </span><span class="decl"><span class="istickedoff">latexWithHeaders = someTexWithHeaders <span class="nottickedoff">"latex"</span> <span class="nottickedoff">"dvi"</span> <span class="nottickedoff">[]</span></span></span>
|
||||
<span class="lineno"> 53 </span>
|
||||
<span class="lineno"> 54 </span>someTexWithHeaders :: String -> String -> [String] -> [T.Text] -> T.Text -> Tree
|
||||
<span class="lineno"> 55 </span><span class="decl"><span class="istickedoff">someTexWithHeaders _exec _dvi _args _headers tex | <span class="tickonlytrue">pNoExternals</span> = mkText tex</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"></span><span class="istickedoff">someTexWithHeaders exec dvi args headers tex =</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(unsafePerformIO . (cacheMem . cacheDiskSvg) (latexToSVG dvi exec args))</span></span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">script</span></span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">script = mkTexScript exec args headers tex</span></span></span>
|
||||
<span class="lineno"> 61 </span>
|
||||
<span class="lineno"> 62 </span>-- | Invoke latex and separate results.
|
||||
<span class="lineno"> 63 </span>latexChunks :: [T.Text] -> [Tree]
|
||||
<span class="lineno"> 64 </span><span class="decl"><span class="nottickedoff">latexChunks chunks | pNoExternals = map mkText chunks</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"></span><span class="nottickedoff">latexChunks chunks = worker (svgGlyphs $ latex $ T.concat chunks) chunks</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">merge lst = mkGroup [ fmt svg | (fmt, _, svg) <- lst ]</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">worker [] [] = []</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">worker _ [] = error "latex chunk mismatch"</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">worker everything (x : xs) =</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">let width = length $ svgGlyphs (latex x)</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">in merge (take width everything) : worker (drop width everything) xs</span></span>
|
||||
<span class="lineno"> 73 </span>
|
||||
<span class="lineno"> 74 </span>-- | Invoke xelatex and import the result as an SVG object. SVG objects are
|
||||
<span class="lineno"> 75 </span>-- cached to improve performance. Xelatex has support for non-western scripts.
|
||||
<span class="lineno"> 76 </span>xelatex :: Text -> Tree
|
||||
<span class="lineno"> 77 </span><span class="decl"><span class="nottickedoff">xelatex = xelatexWithHeaders []</span></span>
|
||||
<span class="lineno"> 78 </span>
|
||||
<span class="lineno"> 79 </span>-- | Invoke xelatex with extra script headers.
|
||||
<span class="lineno"> 80 </span>xelatexWithHeaders :: [T.Text] -> T.Text -> Tree
|
||||
<span class="lineno"> 81 </span><span class="decl"><span class="nottickedoff">xelatexWithHeaders = someTexWithHeaders "xelatex" "xdv" ["-no-pdf"]</span></span>
|
||||
<span class="lineno"> 82 </span>
|
||||
<span class="lineno"> 83 </span>-- | Invoke xelatex with "\usepackage[UTF8]{ctex}" and import the result as an
|
||||
<span class="lineno"> 84 </span>-- SVG object. SVG objects are cached to improve performance. Xelatex has
|
||||
<span class="lineno"> 85 </span>-- support for non-western scripts.
|
||||
<span class="lineno"> 86 </span>--
|
||||
<span class="lineno"> 87 </span>-- Example:
|
||||
<span class="lineno"> 88 </span>--
|
||||
<span class="lineno"> 89 </span>-- > ctex "中文"
|
||||
<span class="lineno"> 90 </span>--
|
||||
<span class="lineno"> 91 </span>-- <<docs/gifs/doc_ctex.gif>>
|
||||
<span class="lineno"> 92 </span>ctex :: T.Text -> Tree
|
||||
<span class="lineno"> 93 </span><span class="decl"><span class="nottickedoff">ctex = ctexWithHeaders []</span></span>
|
||||
<span class="lineno"> 94 </span>
|
||||
<span class="lineno"> 95 </span>-- | Invoke xelatex with extra script headers + ctex headers.
|
||||
<span class="lineno"> 96 </span>ctexWithHeaders :: [T.Text] -> T.Text -> Tree
|
||||
<span class="lineno"> 97 </span><span class="decl"><span class="nottickedoff">ctexWithHeaders headers = xelatexWithHeaders ("\\usepackage[UTF8]{ctex}" : headers)</span></span>
|
||||
<span class="lineno"> 98 </span>
|
||||
<span class="lineno"> 99 </span>-- | Invoke latex and import the result as an SVG object. SVG objects are
|
||||
<span class="lineno"> 100 </span>-- cached to improve performance. This wraps the TeX code in an 'align*'
|
||||
<span class="lineno"> 101 </span>-- context.
|
||||
<span class="lineno"> 102 </span>--
|
||||
<span class="lineno"> 103 </span>-- Example:
|
||||
<span class="lineno"> 104 </span>--
|
||||
<span class="lineno"> 105 </span>-- > latexAlign "R = \\frac{{\\Delta x}}{{kA}}"
|
||||
<span class="lineno"> 106 </span>--
|
||||
<span class="lineno"> 107 </span>-- <<docs/gifs/doc_latexAlign.gif>>
|
||||
<span class="lineno"> 108 </span>latexAlign :: Text -> Tree
|
||||
<span class="lineno"> 109 </span><span class="decl"><span class="istickedoff">latexAlign tex = latex $ T.unlines ["\\begin{align*}", tex, "\\end{align*}"]</span></span>
|
||||
<span class="lineno"> 110 </span>
|
||||
<span class="lineno"> 111 </span>postprocess :: Tree -> Tree
|
||||
<span class="lineno"> 112 </span><span class="decl"><span class="nottickedoff">postprocess = simplify</span></span>
|
||||
<span class="lineno"> 113 </span>
|
||||
<span class="lineno"> 114 </span>-- executable, arguments, header, tex
|
||||
<span class="lineno"> 115 </span>latexToSVG :: String -> String -> [String] -> Text -> IO Tree
|
||||
<span class="lineno"> 116 </span><span class="decl"><span class="nottickedoff">latexToSVG dviExt latexExec latexArgs tex = do</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">latexBin <- requireExecutable latexExec</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">dvisvgm <- requireExecutable "dvisvgm"</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">withTempDir $ \tmp_dir -> withTempFile "tex" $ \tex_file -></span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">withTempFile "svg" $ \svg_file -> do</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">let dvi_file =</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">tmp_dir </> replaceExtension (takeFileName tex_file) dviExt</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">B.writeFile tex_file (T.encodeUtf8 tex)</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">runCmd</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">latexBin</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">( latexArgs</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">++ [ "-interaction=nonstopmode"</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">, "-halt-on-error"</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="nottickedoff">, "-output-directory=" ++ tmp_dir</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">, tex_file</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">)</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">runCmd</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff">dvisvgm</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">[ dvi_file</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">, "--precision=5"</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">, "--exact" -- better bboxes.</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">, "--no-fonts" -- use glyphs instead of fonts.</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">, "--scale=0.1,-0.1"</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="nottickedoff">, "--verbosity=0"</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="nottickedoff">, "-o"</span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="nottickedoff">, svg_file</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">svg_data <- B.readFile svg_file</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="nottickedoff">case parseSvgFile svg_file svg_data of</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> error "Malformed svg"</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="nottickedoff">Just svg -> return $ postprocess $ unbox $ replaceUses svg</span></span>
|
||||
<span class="lineno"> 148 </span>
|
||||
<span class="lineno"> 149 </span>mkTexScript :: String -> [String] -> [Text] -> Text -> Text
|
||||
<span class="lineno"> 150 </span><span class="decl"><span class="nottickedoff">mkTexScript latexExec latexArgs texHeaders tex =</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">T.unlines</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">$ [ "% " <> T.pack (unwords (latexExec : latexArgs))</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">, "\\documentclass[preview]{standalone}"</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">, "\\usepackage{amsmath}"</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">, "\\usepackage{gensymb}"</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="nottickedoff">++ texHeaders</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="nottickedoff">++ [ "\\usepackage[english]{babel}"</span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="nottickedoff">, "\\linespread{1}"</span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="nottickedoff">, "\\begin{document}"</span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="nottickedoff">, tex</span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="nottickedoff">, "\\end{document}"</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
||||
<span class="lineno"> 164 </span>
|
||||
<span class="lineno"> 165 </span>{- Packages used by manim.
|
||||
<span class="lineno"> 166 </span>
|
||||
<span class="lineno"> 167 </span>\\\usepackage{amsmath}\n\
|
||||
<span class="lineno"> 168 </span>\\\usepackage{amssymb}\n\
|
||||
<span class="lineno"> 169 </span>\\\usepackage{dsfont}\n\
|
||||
<span class="lineno"> 170 </span>\\\usepackage{setspace}\n\
|
||||
<span class="lineno"> 171 </span>\\\usepackage{relsize}\n\
|
||||
<span class="lineno"> 172 </span>\\\usepackage{textcomp}\n\
|
||||
<span class="lineno"> 173 </span>\\\usepackage{mathrsfs}\n\
|
||||
<span class="lineno"> 174 </span>\\\usepackage{calligra}\n\
|
||||
<span class="lineno"> 175 </span>\\\usepackage{wasysym}\n\
|
||||
<span class="lineno"> 176 </span>\\\usepackage{ragged2e}\n\
|
||||
<span class="lineno"> 177 </span>\\\usepackage{physics}\n\
|
||||
<span class="lineno"> 178 </span>\\\usepackage{xcolor}\n\
|
||||
<span class="lineno"> 179 </span>\\\usepackage{textcomp}\n\
|
||||
<span class="lineno"> 180 </span>\\\usepackage{xfrac}\n\
|
||||
<span class="lineno"> 181 </span>\\\usepackage{microtype}\n\
|
||||
<span class="lineno"> 182 </span>-}
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
243
reanimate-0.4.2.0-inplace/Reanimate.Math.Common.hs.html
Normal file
243
reanimate-0.4.2.0-inplace/Reanimate.Math.Common.hs.html
Normal file
|
|
@ -0,0 +1,243 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE FlexibleInstances #-}
|
||||
<span class="lineno"> 2 </span>{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
<span class="lineno"> 3 </span>{-|
|
||||
<span class="lineno"> 4 </span>Module : Reanimate.Math.Common
|
||||
<span class="lineno"> 5 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 6 </span>License : Unlicense
|
||||
<span class="lineno"> 7 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 8 </span>Stability : experimental
|
||||
<span class="lineno"> 9 </span>Portability : POSIX
|
||||
<span class="lineno"> 10 </span>
|
||||
<span class="lineno"> 11 </span>Low-level primitives related to computational geometry.
|
||||
<span class="lineno"> 12 </span>
|
||||
<span class="lineno"> 13 </span>-}
|
||||
<span class="lineno"> 14 </span>module Reanimate.Math.Common
|
||||
<span class="lineno"> 15 </span> ( -- * Ring
|
||||
<span class="lineno"> 16 </span> Ring(..)
|
||||
<span class="lineno"> 17 </span> , ringSize -- :: Ring a -> Int
|
||||
<span class="lineno"> 18 </span> , ringAccess -- :: Ring a -> Int -> V2 a
|
||||
<span class="lineno"> 19 </span> , ringClamp -- :: Ring a -> Int -> Int
|
||||
<span class="lineno"> 20 </span> , ringUnpack -- :: Ring a -> Vector (V2 a)
|
||||
<span class="lineno"> 21 </span> , ringPack -- :: Vector (V2 a) -> Ring a
|
||||
<span class="lineno"> 22 </span> , ringMap -- :: (V2 a -> V2 b) -> Ring a -> Ring b
|
||||
<span class="lineno"> 23 </span> , ringRayIntersect -- :: Ring Rational -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
|
||||
<span class="lineno"> 24 </span> -- * Math
|
||||
<span class="lineno"> 25 </span> , area -- :: Fractional a => V2 a -> V2 a -> V2 a -> a
|
||||
<span class="lineno"> 26 </span> , area2X -- :: Fractional a => V2 a -> V2 a -> V2 a -> a
|
||||
<span class="lineno"> 27 </span> , isLeftTurn -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 28 </span> , isLeftTurnOrLinear -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 29 </span> , isRightTurn -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 30 </span> , isRightTurnOrLinear -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 31 </span> , direction -- :: Num a => V2 a -> V2 a -> V2 a -> a
|
||||
<span class="lineno"> 32 </span> , isInside -- :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 33 </span> , isInsideStrict -- :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 34 </span> , barycentricCoords -- :: Fractional a => V2 a -> V2 a -> V2 a -> V2 a -> (a, a, a)
|
||||
<span class="lineno"> 35 </span> , rayIntersect -- :: (Fractional a, Ord a) => (V2 a,V2 a) -> (V2 a,V2 a) -> Maybe (V2 a)
|
||||
<span class="lineno"> 36 </span> , isBetween -- :: (Ord a, Fractional a) => V2 a -> (V2 a, V2 a) -> Bool
|
||||
<span class="lineno"> 37 </span> , lineIntersect -- :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
|
||||
<span class="lineno"> 38 </span> , distSquared -- :: (Fractional a) => V2 a -> V2 a -> a
|
||||
<span class="lineno"> 39 </span> , approxDist -- :: (Real a, Fractional a) => V2 a -> V2 a -> a
|
||||
<span class="lineno"> 40 </span> , distance' -- :: (Real a, Fractional a) => V2 a -> V2 a -> Double
|
||||
<span class="lineno"> 41 </span> , triangleAngles -- :: V2 Double -> V2 Double -> V2 Double -> (Double, Double, Double)
|
||||
<span class="lineno"> 42 </span> , Epsilon(..)
|
||||
<span class="lineno"> 43 </span> ) where
|
||||
<span class="lineno"> 44 </span>
|
||||
<span class="lineno"> 45 </span>import Data.Vector (Vector)
|
||||
<span class="lineno"> 46 </span>import qualified Data.Vector as V
|
||||
<span class="lineno"> 47 </span>import Linear.Matrix (det33)
|
||||
<span class="lineno"> 48 </span>import Linear.Metric
|
||||
<span class="lineno"> 49 </span>import Linear.V2
|
||||
<span class="lineno"> 50 </span>import Linear.V3
|
||||
<span class="lineno"> 51 </span>import Linear.Vector
|
||||
<span class="lineno"> 52 </span>import Linear.Epsilon
|
||||
<span class="lineno"> 53 </span>
|
||||
<span class="lineno"> 54 </span>instance Epsilon Rational where
|
||||
<span class="lineno"> 55 </span> <span class="decl"><span class="nottickedoff">nearZero r = r==0</span></span>
|
||||
<span class="lineno"> 56 </span>
|
||||
<span class="lineno"> 57 </span>-- | Circular collection of pairs.
|
||||
<span class="lineno"> 58 </span>newtype Ring a = Ring (Vector (V2 a))
|
||||
<span class="lineno"> 59 </span>
|
||||
<span class="lineno"> 60 </span>-- | Number of elements in the ring.
|
||||
<span class="lineno"> 61 </span>ringSize :: Ring a -> Int
|
||||
<span class="lineno"> 62 </span><span class="decl"><span class="nottickedoff">ringSize (Ring v) = length v</span></span>
|
||||
<span class="lineno"> 63 </span>
|
||||
<span class="lineno"> 64 </span>-- | Safe method for accessing elements in the ring.
|
||||
<span class="lineno"> 65 </span>ringAccess :: Ring a -> Int -> V2 a
|
||||
<span class="lineno"> 66 </span><span class="decl"><span class="nottickedoff">ringAccess (Ring v) i = v V.! mod i (length v)</span></span>
|
||||
<span class="lineno"> 67 </span>
|
||||
<span class="lineno"> 68 </span>-- | Clamp index to within the usable range for the ring.
|
||||
<span class="lineno"> 69 </span>ringClamp :: Ring a -> Int -> Int
|
||||
<span class="lineno"> 70 </span><span class="decl"><span class="nottickedoff">ringClamp (Ring v) i = mod i (length v)</span></span>
|
||||
<span class="lineno"> 71 </span>
|
||||
<span class="lineno"> 72 </span>-- | Convert ring to a vector.
|
||||
<span class="lineno"> 73 </span>ringUnpack :: Ring a -> Vector (V2 a)
|
||||
<span class="lineno"> 74 </span><span class="decl"><span class="nottickedoff">ringUnpack (Ring v) = v</span></span>
|
||||
<span class="lineno"> 75 </span>
|
||||
<span class="lineno"> 76 </span>-- | Convert vector to a ring.
|
||||
<span class="lineno"> 77 </span>ringPack :: Vector (V2 a) -> Ring a
|
||||
<span class="lineno"> 78 </span><span class="decl"><span class="nottickedoff">ringPack = Ring</span></span>
|
||||
<span class="lineno"> 79 </span>
|
||||
<span class="lineno"> 80 </span>-- | Map each element of a ring.
|
||||
<span class="lineno"> 81 </span>ringMap :: (V2 a -> V2 b) -> Ring a -> Ring b
|
||||
<span class="lineno"> 82 </span><span class="decl"><span class="nottickedoff">ringMap fn (Ring v) = Ring (V.map fn v)</span></span>
|
||||
<span class="lineno"> 83 </span>
|
||||
<span class="lineno"> 84 </span>-- | Compute the intersection of two pairs of nodes in the ring.
|
||||
<span class="lineno"> 85 </span>ringRayIntersect :: Ring Rational -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
|
||||
<span class="lineno"> 86 </span><span class="decl"><span class="nottickedoff">ringRayIntersect p (a,b) (c,d) =</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="nottickedoff">rayIntersect (ringAccess p a, ringAccess p b) (ringAccess p c, ringAccess p d)</span></span>
|
||||
<span class="lineno"> 88 </span>
|
||||
<span class="lineno"> 89 </span>-- | Compute area of triangle.
|
||||
<span class="lineno"> 90 </span>area :: Fractional a => V2 a -> V2 a -> V2 a -> a
|
||||
<span class="lineno"> 91 </span><span class="decl"><span class="nottickedoff">area a b c = 1/2 * area2X a b c</span></span>
|
||||
<span class="lineno"> 92 </span>
|
||||
<span class="lineno"> 93 </span>-- | Compute 2x area of triangle. This avoids a division.
|
||||
<span class="lineno"> 94 </span>area2X :: Fractional a => V2 a -> V2 a -> V2 a -> a
|
||||
<span class="lineno"> 95 </span><span class="decl"><span class="nottickedoff">area2X (V2 a1 a2) (V2 b1 b2) (V2 c1 c2) =</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="nottickedoff">det33 (V3 (V3 a1 a2 1)</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">(V3 b1 b2 1)</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">(V3 c1 c2 1))</span></span>
|
||||
<span class="lineno"> 99 </span>
|
||||
<span class="lineno"> 100 </span>compareEpsZero :: (Ord a, Fractional a, Epsilon a) => a -> Ordering
|
||||
<span class="lineno"> 101 </span><span class="decl"><span class="nottickedoff">compareEpsZero val</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="nottickedoff">| nearZero val = EQ</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = compare val 0</span></span>
|
||||
<span class="lineno"> 104 </span>
|
||||
<span class="lineno"> 105 </span>{-# INLINE isLeftTurn #-}
|
||||
<span class="lineno"> 106 </span>-- | Return @True@ iff the line from @p1@ to @p2@ makes a left-turn to @p3@.
|
||||
<span class="lineno"> 107 </span>isLeftTurn :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 108 </span><span class="decl"><span class="nottickedoff">isLeftTurn p1 p2 p3 =</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">case compareEpsZero (direction p1 p2 p3) of</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="nottickedoff">LT -> True</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="nottickedoff">EQ -> False -- colinear</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="nottickedoff">GT -> False</span></span>
|
||||
<span class="lineno"> 113 </span>
|
||||
<span class="lineno"> 114 </span>{-# INLINE isLeftTurnOrLinear #-}
|
||||
<span class="lineno"> 115 </span>-- | Return @True@ iff the line from @p1@ to @p2@ does not make a right-turn to @p3@.
|
||||
<span class="lineno"> 116 </span>isLeftTurnOrLinear :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 117 </span><span class="decl"><span class="nottickedoff">isLeftTurnOrLinear p1 p2 p3 =</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">case compareEpsZero (direction p1 p2 p3) of</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">LT -> True</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">EQ -> True -- colinear</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">GT -> False</span></span>
|
||||
<span class="lineno"> 122 </span>
|
||||
<span class="lineno"> 123 </span>{-# INLINE isRightTurn #-}
|
||||
<span class="lineno"> 124 </span>-- | Return @True@ iff the line from @p1@ to @p2@ makes a right-turn to @p3@.
|
||||
<span class="lineno"> 125 </span>isRightTurn :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 126 </span><span class="decl"><span class="nottickedoff">isRightTurn a b c = not (isLeftTurnOrLinear a b c)</span></span>
|
||||
<span class="lineno"> 127 </span>
|
||||
<span class="lineno"> 128 </span>{-# INLINE isRightTurnOrLinear #-}
|
||||
<span class="lineno"> 129 </span>-- | Return @True@ iff the line from @p1@ to @p2@ does not make a left-turn to @p3@.
|
||||
<span class="lineno"> 130 </span>isRightTurnOrLinear :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 131 </span><span class="decl"><span class="nottickedoff">isRightTurnOrLinear a b c = not (isLeftTurn a b c)</span></span>
|
||||
<span class="lineno"> 132 </span>
|
||||
<span class="lineno"> 133 </span>{-# INLINE direction #-}
|
||||
<span class="lineno"> 134 </span>-- | Compute the change in direction in a line between the three points.
|
||||
<span class="lineno"> 135 </span>direction :: Num a => V2 a -> V2 a -> V2 a -> a
|
||||
<span class="lineno"> 136 </span><span class="decl"><span class="nottickedoff">direction p1 p2 p3 = crossZ (p3-p1) (p2-p1)</span></span>
|
||||
<span class="lineno"> 137 </span>
|
||||
<span class="lineno"> 138 </span>{-# INLINE isInside #-}
|
||||
<span class="lineno"> 139 </span>-- | Returns @True@ if the fourth argument is inside the triangle or
|
||||
<span class="lineno"> 140 </span>-- on the border.
|
||||
<span class="lineno"> 141 </span>isInside :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 142 </span><span class="decl"><span class="nottickedoff">isInside a b c d =</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="nottickedoff">s >= 0 && s <= 1 && t >= 0 && t <= 1 && i >= 0 && i <= 1</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="nottickedoff">(s, t, i) = barycentricCoords a b c d</span></span>
|
||||
<span class="lineno"> 146 </span>
|
||||
<span class="lineno"> 147 </span>{-# INLINE isInsideStrict #-}
|
||||
<span class="lineno"> 148 </span>-- | Returns @True@ iff the fourth argument is inside the triangle.
|
||||
<span class="lineno"> 149 </span>isInsideStrict :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
|
||||
<span class="lineno"> 150 </span><span class="decl"><span class="nottickedoff">isInsideStrict a b c d =</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">s > 0 && s < 1 && t > 0 && t < 1 && i > 0 && i < 1</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">(s, t, i) = barycentricCoords a b c d</span></span>
|
||||
<span class="lineno"> 154 </span>
|
||||
<span class="lineno"> 155 </span>{-# INLINE barycentricCoords #-}
|
||||
<span class="lineno"> 156 </span>-- | Compute relative coordinates inside the triangle. Invariant: @a+b+c=1@
|
||||
<span class="lineno"> 157 </span>barycentricCoords :: Fractional a => V2 a -> V2 a -> V2 a -> V2 a -> (a, a, a)
|
||||
<span class="lineno"> 158 </span><span class="decl"><span class="nottickedoff">barycentricCoords (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x y) =</span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="nottickedoff">(lam1, lam2, lam3)</span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="nottickedoff">lam1 = ((y2-y3)*(x-x3) + (x3 - x2)*(y-y3)) /</span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="nottickedoff">((y2-y3)*(x1-x3) + (x3-x2)*(y1-y3))</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff">lam2 = ((y3-y1)*(x-x3) + (x1-x3)*(y-y3)) /</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">((y2-y3)*(x1-x3) + (x3-x2)*(y1-y3))</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="nottickedoff">lam3 = 1 - lam1 - lam2</span></span>
|
||||
<span class="lineno"> 166 </span>
|
||||
<span class="lineno"> 167 </span>
|
||||
<span class="lineno"> 168 </span>{-# INLINE rayIntersect #-}
|
||||
<span class="lineno"> 169 </span>-- | Compute intersection of two infinite lines.
|
||||
<span class="lineno"> 170 </span>rayIntersect :: (Fractional a, Ord a) => (V2 a,V2 a) -> (V2 a,V2 a) -> Maybe (V2 a)
|
||||
<span class="lineno"> 171 </span><span class="decl"><span class="nottickedoff">rayIntersect (V2 x1 y1,V2 x2 y2) (V2 x3 y3, V2 x4 y4)</span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="nottickedoff">| yBot == 0 = Nothing</span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = Just $</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="nottickedoff">V2 (xTop/xBot) (yTop/yBot)</span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="nottickedoff">xTop = (x1*y2 - y1*x2)*(x3-x4) - (x1 - x2)*(x3*y4-y3*x4)</span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="nottickedoff">xBot = (x1-x2)*(y3-y4)-(y1-y2)*(x3-x4)</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">yTop = (x1*y2 - y1*x2)*(y3-y4) - (y1-y2)*(x3*y4-y3*x4)</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">yBot = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)</span></span>
|
||||
<span class="lineno"> 180 </span>
|
||||
<span class="lineno"> 181 </span>{-# INLINE isBetween #-}
|
||||
<span class="lineno"> 182 </span>-- | Returns @True@ iff a point is on a line segment.
|
||||
<span class="lineno"> 183 </span>isBetween :: (Ord a, Fractional a) => V2 a -> (V2 a, V2 a) -> Bool
|
||||
<span class="lineno"> 184 </span><span class="decl"><span class="nottickedoff">isBetween (V2 x y) (V2 x1 y1, V2 x2 y2) =</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff">((y1 > y) /= (y2 > y) || y == y1 || y == y2) && -- y is between y1 and y2</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff">((x1 > x) /= (x2 > x) || x == x1 || x == x2)</span></span>
|
||||
<span class="lineno"> 187 </span>
|
||||
<span class="lineno"> 188 </span>{-# INLINE lineIntersect #-}
|
||||
<span class="lineno"> 189 </span>-- | Compute intersection of two line segments.
|
||||
<span class="lineno"> 190 </span>lineIntersect :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
|
||||
<span class="lineno"> 191 </span><span class="decl"><span class="nottickedoff">lineIntersect a b =</span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="nottickedoff">case rayIntersect a b of</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="nottickedoff">Just u</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="nottickedoff">| isBetween u a && isBetween u b -> Just u</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="nottickedoff">_ -> Nothing</span></span>
|
||||
<span class="lineno"> 196 </span>
|
||||
<span class="lineno"> 197 </span>-- circleIntersect :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> [V2 a]
|
||||
<span class="lineno"> 198 </span>
|
||||
<span class="lineno"> 199 </span>-- | Compute the square of the distance between two points.
|
||||
<span class="lineno"> 200 </span>distSquared :: (Num a) => V2 a -> V2 a -> a
|
||||
<span class="lineno"> 201 </span><span class="decl"><span class="nottickedoff">distSquared a b = quadrance (a ^-^ b)</span></span>
|
||||
<span class="lineno"> 202 </span>
|
||||
<span class="lineno"> 203 </span>-- | Approximate the distance between two points.
|
||||
<span class="lineno"> 204 </span>approxDist :: (Real a, Fractional a) => V2 a -> V2 a -> a
|
||||
<span class="lineno"> 205 </span><span class="decl"><span class="nottickedoff">approxDist a b = realToFrac (sqrt (realToFrac (distSquared a b) :: Double))</span></span>
|
||||
<span class="lineno"> 206 </span>
|
||||
<span class="lineno"> 207 </span>-- | Approximate the distance between two points.
|
||||
<span class="lineno"> 208 </span>distance' :: (Real a, Fractional a) => V2 a -> V2 a -> Double
|
||||
<span class="lineno"> 209 </span><span class="decl"><span class="nottickedoff">distance' a b = sqrt (realToFrac (distSquared a b))</span></span>
|
||||
<span class="lineno"> 210 </span>
|
||||
<span class="lineno"> 211 </span>-- sum of angles is always pi.
|
||||
<span class="lineno"> 212 </span>-- | Approximate the angles of a triangle.
|
||||
<span class="lineno"> 213 </span>triangleAngles :: V2 Double -> V2 Double -> V2 Double -> (Double, Double, Double)
|
||||
<span class="lineno"> 214 </span><span class="decl"><span class="nottickedoff">triangleAngles a b c =</span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="nottickedoff">(findAngle (b-a) (c-a)</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="nottickedoff">,findAngle (c-b) (a-b)</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">,findAngle (a-c) (b-c))</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="nottickedoff">findAngle v1 v2 = abs (atan2 (crossZ v1 v2) (dot v1 v2))</span></span>
|
||||
<span class="lineno"> 220 </span> -- findAngle v1 v2 = acos (dot v1 v2 / (norm v1 * norm v2))
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
824
reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon.hs.html
Normal file
824
reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon.hs.html
Normal file
|
|
@ -0,0 +1,824 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE BangPatterns #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE ConstraintKinds #-}
|
||||
<span class="lineno"> 3 </span>{-# OPTIONS_HADDOCK hide #-}
|
||||
<span class="lineno"> 4 </span>module Reanimate.Math.Polygon
|
||||
<span class="lineno"> 5 </span> ( APolygon(..)
|
||||
<span class="lineno"> 6 </span> , Polygon
|
||||
<span class="lineno"> 7 </span> , FPolygon
|
||||
<span class="lineno"> 8 </span> , P
|
||||
<span class="lineno"> 9 </span> , mkPolygon -- :: (Fractional a, Ord a) => V.Vector (V2 a) -> APolygon a
|
||||
<span class="lineno"> 10 </span> , mkPolygonFromRing -- :: (Fractional a, Ord a) => Ring a -> APolygon a
|
||||
<span class="lineno"> 11 </span> , castPolygon -- :: (Real a, Fractional b, Ord a) => APolygon a -> APolygon b
|
||||
<span class="lineno"> 12 </span> , pParent -- :: Polygon -> Int -> Int -> Int
|
||||
<span class="lineno"> 13 </span> , pSetOffset -- :: APolygon a -> Int -> APolygon a
|
||||
<span class="lineno"> 14 </span> , pAdjustOffset -- :: APolygon a -> Int -> APolygon a
|
||||
<span class="lineno"> 15 </span> , pSize -- :: APolygon a -> Int
|
||||
<span class="lineno"> 16 </span> , pNull -- :: APolygon a -> Bool
|
||||
<span class="lineno"> 17 </span> , pNext -- :: APolygon a -> Int -> Int
|
||||
<span class="lineno"> 18 </span> , pPrev -- :: APolygon a -> Int -> Int
|
||||
<span class="lineno"> 19 </span> , pIsSimple -- :: Polygon -> Bool
|
||||
<span class="lineno"> 20 </span> , pIsConvex -- :: Polygon -> Bool
|
||||
<span class="lineno"> 21 </span> , pIsCCW -- :: Polygon -> Bool
|
||||
<span class="lineno"> 22 </span> , pScale -- :: Rational -> Polygon -> Polygon
|
||||
<span class="lineno"> 23 </span> , pAtCentroid -- :: Polygon -> Polygon
|
||||
<span class="lineno"> 24 </span> , pAtCenter -- :: Polygon -> Polygon
|
||||
<span class="lineno"> 25 </span> , pTranslate -- :: V2 Rational -> Polygon -> Polygon
|
||||
<span class="lineno"> 26 </span> , pCenter -- :: Polygon -> V2 Rational
|
||||
<span class="lineno"> 27 </span> , pBoundingBox -- :: Polygon -> (Rational, Rational, Rational, Rational)
|
||||
<span class="lineno"> 28 </span> , pIsInside -- :: Polygon -> V2 Rational -> Bool
|
||||
<span class="lineno"> 29 </span> , pAccess -- :: APolygon a -> Int -> V2 a
|
||||
<span class="lineno"> 30 </span> , pMkWinding -- :: Int -> Polygon
|
||||
<span class="lineno"> 31 </span> , pDeoverlap -- :: Polygon -> Polygon
|
||||
<span class="lineno"> 32 </span> , pCycles -- :: Polygon -> [Polygon]
|
||||
<span class="lineno"> 33 </span> , pCycle -- :: (Real a, Fractional a, Ord a) => APolygon a -> Double -> APolygon a
|
||||
<span class="lineno"> 34 </span> , pCentroid -- :: Polygon -> V2 Rational
|
||||
<span class="lineno"> 35 </span> , pMapEdges -- :: (V2 Rational -> V2 Rational -> a) -> Polygon -> V.Vector a
|
||||
<span class="lineno"> 36 </span> , pArea -- :: Polygon -> Rational
|
||||
<span class="lineno"> 37 </span> , pCircumference -- :: (Real a, Fractional a) => APolygon a -> a
|
||||
<span class="lineno"> 38 </span> , pCircumference' -- :: (Real a, Fractional a) => APolygon a -> Double
|
||||
<span class="lineno"> 39 </span> , pAddPoints -- :: Int -> Polygon -> Polygon
|
||||
<span class="lineno"> 40 </span> , pAddPointsRestricted -- :: [Int] -> Int -> Polygon -> Polygon
|
||||
<span class="lineno"> 41 </span> , pAddPointsBetween -- :: (Fractional a, Ord a, Real a) => (Int, Int) -> Int -> APolygon a -> APolygon a
|
||||
<span class="lineno"> 42 </span> , pRayIntersect -- :: Polygon -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
|
||||
<span class="lineno"> 43 </span> , pOverlap -- :: Polygon -> Polygon -> Polygon
|
||||
<span class="lineno"> 44 </span> , pCuts -- :: Polygon -> [(Polygon,Polygon)]
|
||||
<span class="lineno"> 45 </span> , pCutEqual -- :: Polygon -> (Polygon, Polygon)
|
||||
<span class="lineno"> 46 </span> -- * Triangulation
|
||||
<span class="lineno"> 47 </span> , isValidTriangulation -- :: Polygon -> Triangulation -> Bool
|
||||
<span class="lineno"> 48 </span> , triangulationsToPolygons -- :: Polygon -> Triangulation -> [Polygon]
|
||||
<span class="lineno"> 49 </span> -- * Single-Source-Shortest-Path
|
||||
<span class="lineno"> 50 </span> , ssspVisibility -- :: Polygon -> Polygon
|
||||
<span class="lineno"> 51 </span> , ssspWindows -- :: Polygon -> [(V2 Rational, V2 Rational)]
|
||||
<span class="lineno"> 52 </span> -- * Duals
|
||||
<span class="lineno"> 53 </span> , pdualPolygons -- :: Polygon -> PDual -> [Polygon]
|
||||
<span class="lineno"> 54 </span> -- * Built-in shapes for testing
|
||||
<span class="lineno"> 55 </span> , triangle -- :: Polygon
|
||||
<span class="lineno"> 56 </span> , triangle' -- :: [P]
|
||||
<span class="lineno"> 57 </span> , shape1 -- :: Polygon
|
||||
<span class="lineno"> 58 </span> , shape2 -- :: Polygon
|
||||
<span class="lineno"> 59 </span> , shape3 -- :: Polygon
|
||||
<span class="lineno"> 60 </span> , shape4 -- :: Polygon
|
||||
<span class="lineno"> 61 </span> , shape5 -- :: Polygon
|
||||
<span class="lineno"> 62 </span> , shape6 -- :: Polygon
|
||||
<span class="lineno"> 63 </span> , shape7 -- :: Polygon
|
||||
<span class="lineno"> 64 </span> , shape8 -- :: Polygon
|
||||
<span class="lineno"> 65 </span> , shape9 -- :: Polygon
|
||||
<span class="lineno"> 66 </span> , shape10 -- :: Polygon
|
||||
<span class="lineno"> 67 </span> , shape11 -- :: Polygon
|
||||
<span class="lineno"> 68 </span> , shape12 -- :: Polygon
|
||||
<span class="lineno"> 69 </span> , shape13 -- :: Polygon
|
||||
<span class="lineno"> 70 </span> , shape14 -- :: Polygon
|
||||
<span class="lineno"> 71 </span> , shape15 -- :: Polygon
|
||||
<span class="lineno"> 72 </span> , shape16 -- :: Polygon
|
||||
<span class="lineno"> 73 </span> , shape17 -- :: Polygon
|
||||
<span class="lineno"> 74 </span> , shape18 -- :: Polygon
|
||||
<span class="lineno"> 75 </span> , shape19 -- :: Polygon
|
||||
<span class="lineno"> 76 </span> , shape20 -- :: Polygon
|
||||
<span class="lineno"> 77 </span> , shape21 -- :: Polygon
|
||||
<span class="lineno"> 78 </span> , shape22 -- :: Polygon
|
||||
<span class="lineno"> 79 </span> , shape23 -- :: Polygon
|
||||
<span class="lineno"> 80 </span> , concave -- :: Polygon
|
||||
<span class="lineno"> 81 </span> -- * Internals
|
||||
<span class="lineno"> 82 </span> , pRing -- :: APolygon a -> Ring a
|
||||
<span class="lineno"> 83 </span> , pUnsafeMap -- :: (Ring a -> Ring a) -> APolygon a -> APolygon a
|
||||
<span class="lineno"> 84 </span> , pCopy -- :: Polygon -> Polygon
|
||||
<span class="lineno"> 85 </span> , pGenerate -- :: [(Double, Double)] -> Polygon
|
||||
<span class="lineno"> 86 </span> , pUnGenerate -- :: Polygon -> [(Double, Double)]
|
||||
<span class="lineno"> 87 </span> , Epsilon
|
||||
<span class="lineno"> 88 </span> ) where
|
||||
<span class="lineno"> 89 </span>
|
||||
<span class="lineno"> 90 </span>-- import Control.Exception
|
||||
<span class="lineno"> 91 </span>import Data.Hashable
|
||||
<span class="lineno"> 92 </span>import Data.List (intersect, maximumBy, sort, sortOn,
|
||||
<span class="lineno"> 93 </span> tails)
|
||||
<span class="lineno"> 94 </span>import Data.Maybe
|
||||
<span class="lineno"> 95 </span>import Data.Ratio
|
||||
<span class="lineno"> 96 </span>import Data.Serialize
|
||||
<span class="lineno"> 97 </span>import Data.Vector (Vector)
|
||||
<span class="lineno"> 98 </span>import qualified Data.Vector as V
|
||||
<span class="lineno"> 99 </span>import Linear.V2
|
||||
<span class="lineno"> 100 </span>import Linear.Vector
|
||||
<span class="lineno"> 101 </span>import Reanimate.Math.Common
|
||||
<span class="lineno"> 102 </span>-- import Reanimate.Math.EarClip
|
||||
<span class="lineno"> 103 </span>import Reanimate.Math.SSSP
|
||||
<span class="lineno"> 104 </span>import Reanimate.Math.Triangulate
|
||||
<span class="lineno"> 105 </span>
|
||||
<span class="lineno"> 106 </span>-- import Debug.Trace
|
||||
<span class="lineno"> 107 </span>
|
||||
<span class="lineno"> 108 </span>-- Generate random polygons, options:
|
||||
<span class="lineno"> 109 </span>-- 1. put corners around a circle. Vary the radius.
|
||||
<span class="lineno"> 110 </span>-- 2. close a hilbert curve
|
||||
<span class="lineno"> 111 </span>type FPolygon = APolygon Double
|
||||
<span class="lineno"> 112 </span>-- Optimize representation?
|
||||
<span class="lineno"> 113 </span>-- Polygon = (Vector XNumerator, Vector XDenominator
|
||||
<span class="lineno"> 114 </span>-- ,Vector YNumerator, Vector YDenominator)
|
||||
<span class="lineno"> 115 </span>data APolygon a = Polygon
|
||||
<span class="lineno"> 116 </span> { <span class="istickedoff"><span class="decl"><span class="istickedoff">polygonPoints</span></span></span> :: Vector (V2 a)
|
||||
<span class="lineno"> 117 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">polygonOffset</span></span></span> :: Int
|
||||
<span class="lineno"> 118 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">polygonTriangulation</span></span></span> :: Triangulation
|
||||
<span class="lineno"> 119 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">polygonSSSP</span></span></span> :: Vector SSSP
|
||||
<span class="lineno"> 120 </span> }
|
||||
<span class="lineno"> 121 </span>type Polygon = APolygon Rational
|
||||
<span class="lineno"> 122 </span>type P = V2 Double
|
||||
<span class="lineno"> 123 </span>
|
||||
<span class="lineno"> 124 </span>instance Show a => Show (APolygon a) where
|
||||
<span class="lineno"> 125 </span> <span class="decl"><span class="nottickedoff">show = show . V.toList . polygonPoints</span></span>
|
||||
<span class="lineno"> 126 </span>
|
||||
<span class="lineno"> 127 </span>instance Hashable a => Hashable (APolygon a) where
|
||||
<span class="lineno"> 128 </span> <span class="decl"><span class="nottickedoff">hashWithSalt s p = V.foldl' hashWithSalt s (polygonPoints p)</span></span>
|
||||
<span class="lineno"> 129 </span>
|
||||
<span class="lineno"> 130 </span>instance (PolyCtx a, Serialize a) => Serialize (APolygon a) where
|
||||
<span class="lineno"> 131 </span> <span class="decl"><span class="nottickedoff">put = put . V.toList . polygonPoints</span></span>
|
||||
<span class="lineno"> 132 </span> <span class="decl"><span class="nottickedoff">get = mkPolygon . V.fromList <$> get</span></span>
|
||||
<span class="lineno"> 133 </span>
|
||||
<span class="lineno"> 134 </span>pRing :: APolygon a -> Ring a
|
||||
<span class="lineno"> 135 </span><span class="decl"><span class="nottickedoff">pRing = ringPack . polygonPoints</span></span>
|
||||
<span class="lineno"> 136 </span>
|
||||
<span class="lineno"> 137 </span>type PolyCtx a = (Real a, Fractional a, Epsilon a)
|
||||
<span class="lineno"> 138 </span>
|
||||
<span class="lineno"> 139 </span>mkPolygon :: PolyCtx a => V.Vector (V2 a) -> APolygon a
|
||||
<span class="lineno"> 140 </span><span class="decl"><span class="istickedoff">mkPolygon points = Polygon</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff">{ polygonPoints = points</span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff">, polygonOffset = <span class="nottickedoff">0</span></span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff">, polygonTriangulation = <span class="nottickedoff">trig</span></span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff">, polygonSSSP = <span class="nottickedoff">V.generate n $ \i -> sssp ring (dual i trig)</span></span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff">}</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">n = length points</span></span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">ring = ringPack points</span></span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">trig = triangulate ring</span></span></span>
|
||||
<span class="lineno"> 150 </span> -- earClip ring
|
||||
<span class="lineno"> 151 </span>
|
||||
<span class="lineno"> 152 </span>castPolygon :: (PolyCtx a, PolyCtx b) => APolygon a -> APolygon b
|
||||
<span class="lineno"> 153 </span><span class="decl"><span class="nottickedoff">castPolygon = mkPolygon . V.map (fmap realToFrac) . polygonPoints</span></span>
|
||||
<span class="lineno"> 154 </span>
|
||||
<span class="lineno"> 155 </span>mkPolygonFromRing :: PolyCtx a => Ring a -> APolygon a
|
||||
<span class="lineno"> 156 </span><span class="decl"><span class="nottickedoff">mkPolygonFromRing = mkPolygon . ringUnpack</span></span>
|
||||
<span class="lineno"> 157 </span>
|
||||
<span class="lineno"> 158 </span>pUnsafeMap :: (Ring a -> Ring a) -> APolygon a -> APolygon a
|
||||
<span class="lineno"> 159 </span><span class="decl"><span class="nottickedoff">pUnsafeMap fn p = p{ polygonPoints = ringUnpack (fn (pRing p)) }</span></span>
|
||||
<span class="lineno"> 160 </span>
|
||||
<span class="lineno"> 161 </span>-- pParent p i j = shortest-path parent from j to i
|
||||
<span class="lineno"> 162 </span>pParent :: APolygon a -> Int -> Int -> Int
|
||||
<span class="lineno"> 163 </span><span class="decl"><span class="nottickedoff">pParent p i j =</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">(sTree V.! mod (j + polygonOffset p) n - polygonOffset p) `mod` n</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="nottickedoff">sTree = polygonSSSP p V.! mod (i + polygonOffset p) n</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="nottickedoff">n = pSize p</span></span>
|
||||
<span class="lineno"> 168 </span>
|
||||
<span class="lineno"> 169 </span>pCopy :: Polygon -> Polygon
|
||||
<span class="lineno"> 170 </span><span class="decl"><span class="nottickedoff">pCopy p = mkPolygon $ V.generate (pSize p) $ pAccess p</span></span>
|
||||
<span class="lineno"> 171 </span>
|
||||
<span class="lineno"> 172 </span>pSetOffset :: APolygon a -> Int -> APolygon a
|
||||
<span class="lineno"> 173 </span><span class="decl"><span class="nottickedoff">pSetOffset p offset =</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="nottickedoff">p { polygonOffset = offset `mod` pSize p }</span></span>
|
||||
<span class="lineno"> 175 </span>
|
||||
<span class="lineno"> 176 </span>pAdjustOffset :: APolygon a -> Int -> APolygon a
|
||||
<span class="lineno"> 177 </span><span class="decl"><span class="nottickedoff">pAdjustOffset p offset =</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">p { polygonOffset = (polygonOffset p + offset) `mod` pSize p }</span></span>
|
||||
<span class="lineno"> 179 </span>
|
||||
<span class="lineno"> 180 </span>{-# INLINE pSize #-}
|
||||
<span class="lineno"> 181 </span>pSize :: APolygon a -> Int
|
||||
<span class="lineno"> 182 </span><span class="decl"><span class="istickedoff">pSize = length . polygonPoints</span></span>
|
||||
<span class="lineno"> 183 </span>
|
||||
<span class="lineno"> 184 </span>pNull :: APolygon a -> Bool
|
||||
<span class="lineno"> 185 </span><span class="decl"><span class="istickedoff">pNull = V.null . polygonPoints</span></span>
|
||||
<span class="lineno"> 186 </span>
|
||||
<span class="lineno"> 187 </span>pNext :: APolygon a -> Int -> Int
|
||||
<span class="lineno"> 188 </span><span class="decl"><span class="nottickedoff">pNext p i = (i+1) `mod` pSize p</span></span>
|
||||
<span class="lineno"> 189 </span>
|
||||
<span class="lineno"> 190 </span>pPrev :: APolygon a -> Int -> Int
|
||||
<span class="lineno"> 191 </span><span class="decl"><span class="nottickedoff">pPrev p i = (i-1) `mod` pSize p</span></span>
|
||||
<span class="lineno"> 192 </span>
|
||||
<span class="lineno"> 193 </span>-- When is a polygon valid/simple?
|
||||
<span class="lineno"> 194 </span>-- It is counter-clockwise.
|
||||
<span class="lineno"> 195 </span>-- No edges intersect.
|
||||
<span class="lineno"> 196 </span>-- O(n^2)
|
||||
<span class="lineno"> 197 </span>-- 'checkEdge' takes 90% of the time.
|
||||
<span class="lineno"> 198 </span>pIsSimple :: Polygon -> Bool
|
||||
<span class="lineno"> 199 </span><span class="decl"><span class="nottickedoff">pIsSimple p | pSize p < 3 = False</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"></span><span class="nottickedoff">pIsSimple p = pIsCCW p && noDups && checkEdge 0 2</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="nottickedoff">noDups = checkForDups (sort (V.toList (polygonPoints p)))</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="nottickedoff">checkForDups (x:y:xs)</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="nottickedoff">= x /= y && checkForDups (y:xs)</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="nottickedoff">checkForDups _ = True</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="nottickedoff">len = pSize p</span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="nottickedoff">-- check i,i+1 against j,j+1</span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="nottickedoff">-- j > i+1</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="nottickedoff">checkEdge i j</span>
|
||||
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="nottickedoff">| j >= len = (i > len-3) || checkEdge (i+1) (i+3)</span>
|
||||
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 212 </span><span class="spaces"> </span><span class="nottickedoff">case lineIntersect (pAccess p i, pAccess p $ i+1)</span>
|
||||
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="nottickedoff">(pAccess p j, pAccess p $ j+1) of</span>
|
||||
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="nottickedoff">Just u | u /= pAccess p i -> False</span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="nottickedoff">_nothing -> checkEdge i (j+1)</span></span>
|
||||
<span class="lineno"> 216 </span>
|
||||
<span class="lineno"> 217 </span>pScale :: Rational -> Polygon -> Polygon
|
||||
<span class="lineno"> 218 </span><span class="decl"><span class="nottickedoff">pScale s = pUnsafeMap (ringMap (^* s))</span></span>
|
||||
<span class="lineno"> 219 </span>
|
||||
<span class="lineno"> 220 </span>pAtCentroid :: Polygon -> Polygon
|
||||
<span class="lineno"> 221 </span><span class="decl"><span class="nottickedoff">pAtCentroid p = pTranslate (negate c) p</span>
|
||||
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="nottickedoff">where c = pCentroid p ^/ 2</span></span>
|
||||
<span class="lineno"> 223 </span>
|
||||
<span class="lineno"> 224 </span>pAtCenter :: Polygon -> Polygon
|
||||
<span class="lineno"> 225 </span><span class="decl"><span class="nottickedoff">pAtCenter p = pTranslate (negate $ pCenter p) p</span></span>
|
||||
<span class="lineno"> 226 </span>
|
||||
<span class="lineno"> 227 </span>pTranslate :: V2 Rational -> Polygon -> Polygon
|
||||
<span class="lineno"> 228 </span><span class="decl"><span class="nottickedoff">pTranslate v = pUnsafeMap (ringMap (+v))</span></span>
|
||||
<span class="lineno"> 229 </span>
|
||||
<span class="lineno"> 230 </span>pCenter :: Polygon -> V2 Rational
|
||||
<span class="lineno"> 231 </span><span class="decl"><span class="nottickedoff">pCenter p = V2 (x+w/2) (y+h/2)</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="nottickedoff">(x,y,w,h) = pBoundingBox p</span></span>
|
||||
<span class="lineno"> 234 </span>
|
||||
<span class="lineno"> 235 </span>-- Returns (min-x, min-y, width, height)
|
||||
<span class="lineno"> 236 </span>pBoundingBox :: Polygon -> (Rational, Rational, Rational, Rational)
|
||||
<span class="lineno"> 237 </span><span class="decl"><span class="nottickedoff">pBoundingBox = \p -></span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="nottickedoff">let V2 x y = pAccess p 0 in</span>
|
||||
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="nottickedoff">case V.foldl' worker (x, y, 0, 0) (polygonPoints p) of</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="nottickedoff">(xMin, yMin, xMax, yMax) -></span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="nottickedoff">(xMin, yMin, xMax-xMin, yMax-yMin)</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="nottickedoff">worker (xMin,yMin,xMax,yMax) (V2 thisX thisY) =</span>
|
||||
<span class="lineno"> 244 </span><span class="spaces"> </span><span class="nottickedoff">(min xMin thisX, min yMin thisY</span>
|
||||
<span class="lineno"> 245 </span><span class="spaces"> </span><span class="nottickedoff">,max xMax thisX, max yMax thisY)</span></span>
|
||||
<span class="lineno"> 246 </span>
|
||||
<span class="lineno"> 247 </span>-- Place n points on a circle, use one parameter to slide the points back and forth.
|
||||
<span class="lineno"> 248 </span>-- Use second parameter to move points closer to center circle.
|
||||
<span class="lineno"> 249 </span>pGenerate :: [(Double, Double)] -> Polygon
|
||||
<span class="lineno"> 250 </span><span class="decl"><span class="nottickedoff">pGenerate points</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="nottickedoff">| len < 4 = error "pGenerate: require at least four points"</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 (realToFrac $ cos ang * rMod)</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="nottickedoff">(realToFrac $ sin ang * rMod)</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="nottickedoff">| (i,(angMod,rMod)) <- zip [0..] points</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="nottickedoff">, let minAngle = tau / len * i - pi</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="nottickedoff">maxAngle = tau / len * (i+1) - pi</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="nottickedoff">ang = minAngle + (maxAngle-minAngle)*angMod</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="nottickedoff">tau = 2*pi</span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="nottickedoff">len = fromIntegral (length points)</span></span>
|
||||
<span class="lineno"> 263 </span>
|
||||
<span class="lineno"> 264 </span>pUnGenerate :: Polygon -> [(Double, Double)]
|
||||
<span class="lineno"> 265 </span><span class="decl"><span class="nottickedoff">pUnGenerate p =</span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="nottickedoff">[ worker i (fmap realToFrac e)</span>
|
||||
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="nottickedoff">| (i,e) <- zip [0..] (V.toList $ polygonPoints p) ]</span>
|
||||
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="nottickedoff">len = fromIntegral (pSize p)</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="nottickedoff">worker i (V2 x y) =</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="nottickedoff">let ang = atan2 y x</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="nottickedoff">minAngle = tau / len * i - pi</span>
|
||||
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="nottickedoff">maxAngle = tau / len * (i+1) - pi</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="nottickedoff">in ((ang-minAngle)/(maxAngle-minAngle), sqrt (x*x+y*y))</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="nottickedoff">tau = 2*pi</span></span>
|
||||
<span class="lineno"> 276 </span>
|
||||
<span class="lineno"> 277 </span>-- When is a triangulation valid?
|
||||
<span class="lineno"> 278 </span>-- Intersection: No internal edges intersect.
|
||||
<span class="lineno"> 279 </span>-- Completeness: All edge neighbours share a single internal edge.
|
||||
<span class="lineno"> 280 </span>isValidTriangulation :: Polygon -> Triangulation -> Bool
|
||||
<span class="lineno"> 281 </span><span class="decl"><span class="nottickedoff">isValidTriangulation p t = isComplete && intersectionFree</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="nottickedoff">o = polygonOffset p</span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="nottickedoff">isComplete = all isProper [0 .. pSize p-1]</span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="nottickedoff">isProper i =</span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="nottickedoff">let j = pNext p i in</span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="nottickedoff">length ((pPrev p i : (t V.! i)) `intersect` (pNext p j : t V.! j)) == 1</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="nottickedoff">intersectionFree = and</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="nottickedoff">[ case lineIntersect (pAccess p (a-o), pAccess p (b-o)) (pAccess p (c-o), pAccess p (d-o)) of</span>
|
||||
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> True</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="nottickedoff">Just u -> u == pAccess p (a-o) || u == pAccess p (b-o) ||</span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="nottickedoff">u == pAccess p (c-o) || u == pAccess p (d-o)</span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="nottickedoff">| ((a,b),(c,d)) <- edgePairs ]</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="nottickedoff">edgePairs = [ (e1, e2) | (e1, rest) <- zip edges (drop 1 $ tails edges), e2 <- rest]</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">edges =</span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="nottickedoff">[ (n, i)</span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="nottickedoff">| (n, lst) <- zip [0..] (V.toList t)</span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="nottickedoff">, i <- lst</span>
|
||||
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="nottickedoff">, n < i</span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
||||
<span class="lineno"> 301 </span>
|
||||
<span class="lineno"> 302 </span>triangulationsToPolygons :: Polygon -> Triangulation -> [Polygon]
|
||||
<span class="lineno"> 303 </span><span class="decl"><span class="nottickedoff">triangulationsToPolygons p t =</span>
|
||||
<span class="lineno"> 304 </span><span class="spaces"> </span><span class="nottickedoff">[ mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="nottickedoff">[ pAccess p g, pAccess p i, pAccess p j ]</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1]</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">, let js = filter (i<) $ t V.! i</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="nottickedoff">, (g, j) <- zip (i-1:js) js</span>
|
||||
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
||||
<span class="lineno"> 310 </span>
|
||||
<span class="lineno"> 311 </span>pIsInside :: Polygon -> V2 Rational -> Bool
|
||||
<span class="lineno"> 312 </span><span class="decl"><span class="nottickedoff">pIsInside p point = or</span>
|
||||
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="nottickedoff">[ isInside (rawAccess g) (rawAccess i) (rawAccess j) point</span>
|
||||
<span class="lineno"> 314 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1]</span>
|
||||
<span class="lineno"> 315 </span><span class="spaces"> </span><span class="nottickedoff">, let js = filter (i<) $ polygonTriangulation p V.! i</span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="nottickedoff">, (g, j) <- zip (i-1:js) js</span>
|
||||
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 318 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 319 </span><span class="spaces"> </span><span class="nottickedoff">rawAccess x = polygonPoints p V.! x</span></span>
|
||||
<span class="lineno"> 320 </span>
|
||||
<span class="lineno"> 321 </span>-- reducePolygons :: Int -> [Polygon] -> [Polygon]
|
||||
<span class="lineno"> 322 </span>-- reducePolygons n ps
|
||||
<span class="lineno"> 323 </span>-- | length ps <= n = ps
|
||||
<span class="lineno"> 324 </span>-- | otherwise =
|
||||
<span class="lineno"> 325 </span>-- let p = findSmallest ps
|
||||
<span class="lineno"> 326 </span>-- es = edges p
|
||||
<span class="lineno"> 327 </span>-- e = findSmallest es
|
||||
<span class="lineno"> 328 </span>-- in reducePolygons n (merge p e : delete p (delete e ps))
|
||||
<span class="lineno"> 329 </span>-- where
|
||||
<span class="lineno"> 330 </span>-- findSmallest = minimumBy (comparing area2X)
|
||||
<span class="lineno"> 331 </span>-- shareEdge p1 p2 =
|
||||
<span class="lineno"> 332 </span>
|
||||
<span class="lineno"> 333 </span>{-# INLINE pAccess #-}
|
||||
<span class="lineno"> 334 </span>pAccess :: APolygon a -> Int -> V2 a
|
||||
<span class="lineno"> 335 </span><span class="decl"><span class="nottickedoff">pAccess p i = -- polygonPoints p V.! ((polygonOffset p + i) `mod` pSize p)</span>
|
||||
<span class="lineno"> 336 </span><span class="spaces"> </span><span class="nottickedoff">polygonPoints p `V.unsafeIndex` ((polygonOffset p + i) `mod` pSize p)</span></span>
|
||||
<span class="lineno"> 337 </span>
|
||||
<span class="lineno"> 338 </span>triangle :: Polygon
|
||||
<span class="lineno"> 339 </span><span class="decl"><span class="nottickedoff">triangle = mkPolygon $ V.fromList [V2 1 1, V2 0 0, V2 2 0]</span></span>
|
||||
<span class="lineno"> 340 </span>
|
||||
<span class="lineno"> 341 </span>triangle' :: [P]
|
||||
<span class="lineno"> 342 </span><span class="decl"><span class="nottickedoff">triangle' = reverse [V2 1 1, V2 0 0, V2 2 0]</span></span>
|
||||
<span class="lineno"> 343 </span>
|
||||
<span class="lineno"> 344 </span>shape1 :: Polygon
|
||||
<span class="lineno"> 345 </span><span class="decl"><span class="nottickedoff">shape1 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 346 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 2 0</span>
|
||||
<span class="lineno"> 347 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 1, V2 2 2, V2 2 3, V2 2 4, V2 2 5, V2 2 6</span>
|
||||
<span class="lineno"> 348 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 0 1 ]</span></span>
|
||||
<span class="lineno"> 349 </span>
|
||||
<span class="lineno"> 350 </span>shape2 :: Polygon
|
||||
<span class="lineno"> 351 </span><span class="decl"><span class="nottickedoff">shape2 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 352 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 (-1), V2 0 (-1), V2 0 (-2)</span>
|
||||
<span class="lineno"> 353 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 (-2), V2 3 2, V2 0 2]</span></span>
|
||||
<span class="lineno"> 354 </span>
|
||||
<span class="lineno"> 355 </span>shape3 :: Polygon
|
||||
<span class="lineno"> 356 </span><span class="decl"><span class="nottickedoff">shape3 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 357 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 2, V2 0 2]</span></span>
|
||||
<span class="lineno"> 358 </span>
|
||||
<span class="lineno"> 359 </span>shape4 :: Polygon
|
||||
<span class="lineno"> 360 </span><span class="decl"><span class="nottickedoff">shape4 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 361 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 (-1), V2 3 (-1),V2 3 2, V2 0 2]</span></span>
|
||||
<span class="lineno"> 362 </span>
|
||||
<span class="lineno"> 363 </span>shape5 :: Polygon
|
||||
<span class="lineno"> 364 </span><span class="decl"><span class="nottickedoff">shape5 = pCycles shape4 !! 2</span></span>
|
||||
<span class="lineno"> 365 </span>
|
||||
<span class="lineno"> 366 </span>-- square
|
||||
<span class="lineno"> 367 </span>shape6 :: Polygon
|
||||
<span class="lineno"> 368 </span><span class="decl"><span class="nottickedoff">shape6 = mkPolygon $ V.fromList [ V2 0 0, V2 1 0, V2 1 1, V2 0 1 ]</span></span>
|
||||
<span class="lineno"> 369 </span>
|
||||
<span class="lineno"> 370 </span>shape7 :: Polygon
|
||||
<span class="lineno"> 371 </span><span class="decl"><span class="nottickedoff">shape7 = pScale 6 $ mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 372 </span><span class="spaces"> </span><span class="nottickedoff">[V2 ((-1567171105775771) % 144115188075855872) ((-7758063241391039) % 1152921504606846976)</span>
|
||||
<span class="lineno"> 373 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-2711114907999263) % 18014398509481984) ((-3561889280168807) % 18014398509481984)</span>
|
||||
<span class="lineno"> 374 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-6897139157863177) % 72057594037927936) ((-1632144794297397) % 4503599627370496)</span>
|
||||
<span class="lineno"> 375 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (5592137945106423 % 36028797018963968) ((-71351641856107) % 281474976710656)</span>
|
||||
<span class="lineno"> 376 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (2568147525079071 % 4503599627370496) ((-4312925637247687) % 18014398509481984)</span>
|
||||
<span class="lineno"> 377 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (1291079014395023 % 2251799813685248) (321513444515769 % 2251799813685248)</span>
|
||||
<span class="lineno"> 378 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (2071709221627247 % 4503599627370496) (4019115966736491 % 9007199254740992)</span>
|
||||
<span class="lineno"> 379 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-1589087869859839) % 144115188075855872) (4904023654354179 % 9007199254740992)</span>
|
||||
<span class="lineno"> 380 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-2328090886101149) % 36028797018963968) (2587887893460759 % 36028797018963968)</span>
|
||||
<span class="lineno"> 381 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-7990199074159871) % 18014398509481984) (1301850651537745 % 4503599627370496)]</span></span>
|
||||
<span class="lineno"> 382 </span>
|
||||
<span class="lineno"> 383 </span>shape8 :: Polygon
|
||||
<span class="lineno"> 384 </span><span class="decl"><span class="nottickedoff">shape8 = pScale 10 $ pGenerate</span>
|
||||
<span class="lineno"> 385 </span><span class="spaces"> </span><span class="nottickedoff">[(0.36,0.4),(0.7,1.8e-2),(0.7,0.2),(0.1,0.4),(0.2,0.2),(0.7,0.1),(0.4,8.0e-2)]</span></span>
|
||||
<span class="lineno"> 386 </span>
|
||||
<span class="lineno"> 387 </span>shape9 :: Polygon
|
||||
<span class="lineno"> 388 </span><span class="decl"><span class="nottickedoff">shape9 = pScale 5 $ pGenerate</span>
|
||||
<span class="lineno"> 389 </span><span class="spaces"> </span><span class="nottickedoff">[(0.5,0.2),(0.7,0.6),(0.4,0.3),(0.1,0.7),(0.3,1.0e-2),(0.5,0.3),(0.2,0.8),(0.1,0.8),(0.7,6.0e-2),(0.1,0.6)]</span></span>
|
||||
<span class="lineno"> 390 </span>
|
||||
<span class="lineno"> 391 </span>shape10 :: Polygon
|
||||
<span class="lineno"> 392 </span><span class="decl"><span class="nottickedoff">shape10 = pGenerate</span>
|
||||
<span class="lineno"> 393 </span><span class="spaces"> </span><span class="nottickedoff">[(0.4,0.7),(0.2,0.2),(0.3,0.9),(5.0e-2,0.1),(0.7,1.0e-2),(0.7,0.9),(0.2,0.1),(0.5,6.0e-2),(0.6,9.0e-2)]</span></span>
|
||||
<span class="lineno"> 394 </span>
|
||||
<span class="lineno"> 395 </span>shape11 :: Polygon
|
||||
<span class="lineno"> 396 </span><span class="decl"><span class="nottickedoff">shape11 = pGenerate</span>
|
||||
<span class="lineno"> 397 </span><span class="spaces"> </span><span class="nottickedoff">[(0.1,0.8),(0.7,0.6),(0.7,0.4),(0.3,0.5),(0.8,0.9),(0.8,6.0e-2),(1.0e-2,4.0e-2),(0.8,0.1)]</span></span>
|
||||
<span class="lineno"> 398 </span>
|
||||
<span class="lineno"> 399 </span>shape12 :: Polygon
|
||||
<span class="lineno"> 400 </span><span class="decl"><span class="nottickedoff">shape12 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 401 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 0.5 1.5, V2 2 2, V2 (-2) 2, V2 (-0.5) 1.5 ]</span></span>
|
||||
<span class="lineno"> 402 </span>
|
||||
<span class="lineno"> 403 </span>-- F shape
|
||||
<span class="lineno"> 404 </span>shape13 :: Polygon
|
||||
<span class="lineno"> 405 </span><span class="decl"><span class="nottickedoff">shape13 = pCycles (mkPolygon $ V.reverse (V.fromList</span>
|
||||
<span class="lineno"> 406 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 0 2</span>
|
||||
<span class="lineno"> 407 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 1 1.7, V2 0.3 1.7, V2 0.3 1</span>
|
||||
<span class="lineno"> 408 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 1 0.7</span>
|
||||
<span class="lineno"> 409 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0.3 0.7, V2 0.3 0 ])) !! 7</span></span>
|
||||
<span class="lineno"> 410 </span>
|
||||
<span class="lineno"> 411 </span>-- E shape
|
||||
<span class="lineno"> 412 </span>shape14 :: Polygon
|
||||
<span class="lineno"> 413 </span><span class="decl"><span class="nottickedoff">shape14 = pCycles (mkPolygon $ V.reverse $ V.fromList</span>
|
||||
<span class="lineno"> 414 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 0 2 -- up</span>
|
||||
<span class="lineno"> 415 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 1 1.7, V2 0.3 1.7, V2 0.3 1 -- first prong</span>
|
||||
<span class="lineno"> 416 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 1 0.7, V2 0.3 0.7, V2 0.3 0.3 -- second prong</span>
|
||||
<span class="lineno"> 417 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 0.3, V2 1 0 -- last prong</span>
|
||||
<span class="lineno"> 418 </span><span class="spaces"> </span><span class="nottickedoff">]) !! 9</span></span>
|
||||
<span class="lineno"> 419 </span>
|
||||
<span class="lineno"> 420 </span>--
|
||||
<span class="lineno"> 421 </span>shape15 :: Polygon
|
||||
<span class="lineno"> 422 </span><span class="decl"><span class="nottickedoff">shape15 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 423 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 2 0</span>
|
||||
<span class="lineno"> 424 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 2, V2 1 2</span>
|
||||
<span class="lineno"> 425 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 0 1]</span></span>
|
||||
<span class="lineno"> 426 </span>
|
||||
<span class="lineno"> 427 </span>shape16 :: Polygon
|
||||
<span class="lineno"> 428 </span><span class="decl"><span class="nottickedoff">shape16 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 429 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 2 0</span>
|
||||
<span class="lineno"> 430 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 1, V2 1 1</span>
|
||||
<span class="lineno"> 431 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 0 2]</span></span>
|
||||
<span class="lineno"> 432 </span>
|
||||
<span class="lineno"> 433 </span>shape17 :: Polygon
|
||||
<span class="lineno"> 434 </span><span class="decl"><span class="nottickedoff">shape17 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 435 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 2 0, V2 2 1</span>
|
||||
<span class="lineno"> 436 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 1 2</span>
|
||||
<span class="lineno"> 437 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0 2, V2 0 1, V2 0 0 ]</span></span>
|
||||
<span class="lineno"> 438 </span>
|
||||
<span class="lineno"> 439 </span>shape18 :: Polygon
|
||||
<span class="lineno"> 440 </span><span class="decl"><span class="nottickedoff">shape18 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 441 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 2 0, V2 2 1, V2 2 2</span>
|
||||
<span class="lineno"> 442 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 1 1</span>
|
||||
<span class="lineno"> 443 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0 1, V2 0 0 ]</span></span>
|
||||
<span class="lineno"> 444 </span>
|
||||
<span class="lineno"> 445 </span>shape19 :: Polygon
|
||||
<span class="lineno"> 446 </span><span class="decl"><span class="nottickedoff">shape19 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 447 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 (-3) (-3), V2 0 (-1)</span>
|
||||
<span class="lineno"> 448 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 (-3), V2 1 0</span>
|
||||
<span class="lineno"> 449 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 3, V2 0 1</span>
|
||||
<span class="lineno"> 450 </span><span class="spaces"> </span><span class="nottickedoff">, V2 (-3) 3, V2 (-1) 0 ]</span></span>
|
||||
<span class="lineno"> 451 </span>
|
||||
<span class="lineno"> 452 </span>shape20 :: Polygon
|
||||
<span class="lineno"> 453 </span><span class="decl"><span class="nottickedoff">shape20 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 454 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 (-3) (-3)</span>
|
||||
<span class="lineno"> 455 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0 (-1)</span>
|
||||
<span class="lineno"> 456 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 (-3)</span>
|
||||
<span class="lineno"> 457 </span><span class="spaces"> </span><span class="nottickedoff">, V2 5 0</span>
|
||||
<span class="lineno"> 458 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2.5 (-2)</span>
|
||||
<span class="lineno"> 459 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 0</span>
|
||||
<span class="lineno"> 460 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 3</span>
|
||||
<span class="lineno"> 461 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0 1</span>
|
||||
<span class="lineno"> 462 </span><span class="spaces"> </span><span class="nottickedoff">, V2 (-3) 3</span>
|
||||
<span class="lineno"> 463 </span><span class="spaces"> </span><span class="nottickedoff">, V2 (-1) 0 ]</span></span>
|
||||
<span class="lineno"> 464 </span>
|
||||
<span class="lineno"> 465 </span>shape21 :: Polygon
|
||||
<span class="lineno"> 466 </span><span class="decl"><span class="nottickedoff">shape21 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 467 </span><span class="spaces"> </span><span class="nottickedoff">[V2 0.0 0.0,V2 1.0 0.0,V2 1.0 1.0,V2 2.0 1.0,V2 2.0 (-1.0),V2 3.0 (-1.0)</span>
|
||||
<span class="lineno"> 468 </span><span class="spaces"> </span><span class="nottickedoff">,V2 3.0 2.0,V2 0.0 2.0]</span></span>
|
||||
<span class="lineno"> 469 </span>
|
||||
<span class="lineno"> 470 </span>shape22 :: Polygon
|
||||
<span class="lineno"> 471 </span><span class="decl"><span class="nottickedoff">shape22 = pScale 2 $ mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 472 </span><span class="spaces"> </span><span class="nottickedoff">[V2 (-0.17) (-0.08)</span>
|
||||
<span class="lineno"> 473 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (-0.34) (-0.21)</span>
|
||||
<span class="lineno"> 474 </span><span class="spaces"> </span><span class="nottickedoff">,V2 0.0 0.0</span>
|
||||
<span class="lineno"> 475 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (-0.10) 0.60</span>
|
||||
<span class="lineno"> 476 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (-0.14) 0.19</span>
|
||||
<span class="lineno"> 477 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (-0.05) 0.03</span>
|
||||
<span class="lineno"> 478 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
||||
<span class="lineno"> 479 </span>
|
||||
<span class="lineno"> 480 </span>shape23 :: Polygon
|
||||
<span class="lineno"> 481 </span><span class="decl"><span class="nottickedoff">shape23 = mkPolygon $ V.fromList</span>
|
||||
<span class="lineno"> 482 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 4 0</span>
|
||||
<span class="lineno"> 483 </span><span class="spaces"> </span><span class="nottickedoff">, V2 4 3, V2 2 3</span>
|
||||
<span class="lineno"> 484 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 2, V2 3 2</span>
|
||||
<span class="lineno"> 485 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 1, V2 1 1</span>
|
||||
<span class="lineno"> 486 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 2 2</span>
|
||||
<span class="lineno"> 487 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 3, V2 0 3 ]</span></span>
|
||||
<span class="lineno"> 488 </span>
|
||||
<span class="lineno"> 489 </span>concave :: Polygon
|
||||
<span class="lineno"> 490 </span><span class="decl"><span class="nottickedoff">concave = mkPolygon $</span>
|
||||
<span class="lineno"> 491 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList [V2 0 0, V2 2 0, V2 2 2, V2 1 1, V2 0 2]</span></span>
|
||||
<span class="lineno"> 492 </span>
|
||||
<span class="lineno"> 493 </span>pMkWinding :: Int -> Polygon
|
||||
<span class="lineno"> 494 </span><span class="decl"><span class="nottickedoff">pMkWinding n | n < 1 = error "Polygon must have at least one winding."</span>
|
||||
<span class="lineno"> 495 </span><span class="spaces"></span><span class="nottickedoff">pMkWinding n = mkPolygon $</span>
|
||||
<span class="lineno"> 496 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList $ p0 : p1 : walkTo p1 1 n (V2 1 0) ++ reverse (walkTo p0 1 (n+2) (V2 (-1) 0))</span>
|
||||
<span class="lineno"> 497 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 498 </span><span class="spaces"> </span><span class="nottickedoff">p0 = V2 0 0</span>
|
||||
<span class="lineno"> 499 </span><span class="spaces"> </span><span class="nottickedoff">p1 = V2 0 1</span>
|
||||
<span class="lineno"> 500 </span><span class="spaces"> </span><span class="nottickedoff">walkTo at a b dir</span>
|
||||
<span class="lineno"> 501 </span><span class="spaces"> </span><span class="nottickedoff">| a == b = []</span>
|
||||
<span class="lineno"> 502 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 503 </span><span class="spaces"> </span><span class="nottickedoff">let newAt = at + (dir ^* toRational a)</span>
|
||||
<span class="lineno"> 504 </span><span class="spaces"> </span><span class="nottickedoff">in newAt : walkTo newAt (a+1) b (rot dir)</span>
|
||||
<span class="lineno"> 505 </span><span class="spaces"> </span><span class="nottickedoff">rot (V2 x y) =</span>
|
||||
<span class="lineno"> 506 </span><span class="spaces"> </span><span class="nottickedoff">V2 y (-x)</span></span>
|
||||
<span class="lineno"> 507 </span>
|
||||
<span class="lineno"> 508 </span>pDeoverlap :: Polygon -> Polygon
|
||||
<span class="lineno"> 509 </span><span class="decl"><span class="nottickedoff">pDeoverlap p = mkPolygon arr</span>
|
||||
<span class="lineno"> 510 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 511 </span><span class="spaces"> </span><span class="nottickedoff">arr = V.generate (pSize p) worker</span>
|
||||
<span class="lineno"> 512 </span><span class="spaces"> </span><span class="nottickedoff">worker 0 = pAccess p 0</span>
|
||||
<span class="lineno"> 513 </span><span class="spaces"> </span><span class="nottickedoff">worker n =</span>
|
||||
<span class="lineno"> 514 </span><span class="spaces"> </span><span class="nottickedoff">if length (V.elemIndices (pAccess p n) (polygonPoints p)) /= 1</span>
|
||||
<span class="lineno"> 515 </span><span class="spaces"> </span><span class="nottickedoff">then</span>
|
||||
<span class="lineno"> 516 </span><span class="spaces"> </span><span class="nottickedoff">let prev = arr V.! (n-1)</span>
|
||||
<span class="lineno"> 517 </span><span class="spaces"> </span><span class="nottickedoff">this = pAccess p n</span>
|
||||
<span class="lineno"> 518 </span><span class="spaces"> </span><span class="nottickedoff">in lerp 0.99999 this prev</span>
|
||||
<span class="lineno"> 519 </span><span class="spaces"> </span><span class="nottickedoff">else pAccess p n</span></span>
|
||||
<span class="lineno"> 520 </span>
|
||||
<span class="lineno"> 521 </span>pCycles :: APolygon a -> [APolygon a]
|
||||
<span class="lineno"> 522 </span><span class="decl"><span class="nottickedoff">pCycles p = map (pAdjustOffset p) [0 .. pSize p-1]</span></span>
|
||||
<span class="lineno"> 523 </span>
|
||||
<span class="lineno"> 524 </span>pCycle :: PolyCtx a => APolygon a -> Double -> APolygon a
|
||||
<span class="lineno"> 525 </span><span class="decl"><span class="nottickedoff">pCycle p 0 = p</span>
|
||||
<span class="lineno"> 526 </span><span class="spaces"></span><span class="nottickedoff">pCycle p t = mkPolygon $ worker 0 0</span>
|
||||
<span class="lineno"> 527 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 528 </span><span class="spaces"> </span><span class="nottickedoff">worker acc i</span>
|
||||
<span class="lineno"> 529 </span><span class="spaces"> </span><span class="nottickedoff">| segment + acc > limit =</span>
|
||||
<span class="lineno"> 530 </span><span class="spaces"> </span><span class="nottickedoff">V.singleton (lerp (realToFrac $ (segment + acc - limit)/segment) x y) <></span>
|
||||
<span class="lineno"> 531 </span><span class="spaces"> </span><span class="nottickedoff">-- V.drop (i+1) (polygonPoints p) <></span>
|
||||
<span class="lineno"> 532 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList (map (pAccess p) [i+1..pSize p-1]) <></span>
|
||||
<span class="lineno"> 533 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList (map (pAccess p) [0 .. i])</span>
|
||||
<span class="lineno"> 534 </span><span class="spaces"> </span><span class="nottickedoff">-- V.take (i+1) (polygonPoints p)</span>
|
||||
<span class="lineno"> 535 </span><span class="spaces"> </span><span class="nottickedoff">| i == pSize p-1 = V.fromList (map (pAccess p) [0 .. pSize p-1])</span>
|
||||
<span class="lineno"> 536 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = worker (acc+segment) (i+1)</span>
|
||||
<span class="lineno"> 537 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 538 </span><span class="spaces"> </span><span class="nottickedoff">x = pAccess p i</span>
|
||||
<span class="lineno"> 539 </span><span class="spaces"> </span><span class="nottickedoff">y = pAccess p $ i+1</span>
|
||||
<span class="lineno"> 540 </span><span class="spaces"> </span><span class="nottickedoff">segment = distance' x y</span>
|
||||
<span class="lineno"> 541 </span><span class="spaces"> </span><span class="nottickedoff">len = pCircumference' p</span>
|
||||
<span class="lineno"> 542 </span><span class="spaces"> </span><span class="nottickedoff">limit = t * len</span></span>
|
||||
<span class="lineno"> 543 </span>
|
||||
<span class="lineno"> 544 </span>pCentroid :: Fractional a => APolygon a -> V2 a
|
||||
<span class="lineno"> 545 </span><span class="decl"><span class="nottickedoff">pCentroid p = V2 cx cy</span>
|
||||
<span class="lineno"> 546 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 547 </span><span class="spaces"> </span><span class="nottickedoff">a = pArea p</span>
|
||||
<span class="lineno"> 548 </span><span class="spaces"> </span><span class="nottickedoff">cx = recip (6*a) * V.sum (pMapEdges fnX p)</span>
|
||||
<span class="lineno"> 549 </span><span class="spaces"> </span><span class="nottickedoff">cy = recip (6*a) * V.sum (pMapEdges fnY p)</span>
|
||||
<span class="lineno"> 550 </span><span class="spaces"> </span><span class="nottickedoff">fnX (V2 x y) (V2 x' y') = (x+x')*(x*y' - x'*y)</span>
|
||||
<span class="lineno"> 551 </span><span class="spaces"> </span><span class="nottickedoff">fnY (V2 x y) (V2 x' y') = (y+y')*(x*y' - x'*y)</span></span>
|
||||
<span class="lineno"> 552 </span>
|
||||
<span class="lineno"> 553 </span>{-# INLINE pMapEdges #-}
|
||||
<span class="lineno"> 554 </span>pMapEdges :: (V2 a -> V2 a -> b) -> APolygon a -> V.Vector b
|
||||
<span class="lineno"> 555 </span><span class="decl"><span class="istickedoff">pMapEdges fn p = V.generate n $ \i -></span>
|
||||
<span class="lineno"> 556 </span><span class="spaces"> </span><span class="istickedoff">if i == n-1</span>
|
||||
<span class="lineno"> 557 </span><span class="spaces"> </span><span class="istickedoff">then fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` 0)</span>
|
||||
<span class="lineno"> 558 </span><span class="spaces"> </span><span class="istickedoff">else fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` (i+1))</span>
|
||||
<span class="lineno"> 559 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 560 </span><span class="spaces"> </span><span class="istickedoff">n = pSize p</span>
|
||||
<span class="lineno"> 561 </span><span class="spaces"> </span><span class="istickedoff">arr = polygonPoints p</span></span>
|
||||
<span class="lineno"> 562 </span>
|
||||
<span class="lineno"> 563 </span>{-# SPECIALIZE pArea :: APolygon Double -> Double #-}
|
||||
<span class="lineno"> 564 </span>{-# SPECIALIZE pArea :: APolygon Rational -> Rational #-}
|
||||
<span class="lineno"> 565 </span>pArea :: (Fractional a) => APolygon a -> a
|
||||
<span class="lineno"> 566 </span><span class="decl"><span class="nottickedoff">pArea p =</span>
|
||||
<span class="lineno"> 567 </span><span class="spaces"> </span><span class="nottickedoff">-- 0.5 * V.sum (pMapEdges (\(V2 x y) (V2 x' y') -> x*y' - x'*y) p)</span>
|
||||
<span class="lineno"> 568 </span><span class="spaces"> </span><span class="nottickedoff">0.5 * worker 0 0</span>
|
||||
<span class="lineno"> 569 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 570 </span><span class="spaces"> </span><span class="nottickedoff">fn (V2 x y) (V2 x' y') = x*y' - x'*y</span>
|
||||
<span class="lineno"> 571 </span><span class="spaces"> </span><span class="nottickedoff">arr = polygonPoints p</span>
|
||||
<span class="lineno"> 572 </span><span class="spaces"> </span><span class="nottickedoff">worker !acc i</span>
|
||||
<span class="lineno"> 573 </span><span class="spaces"> </span><span class="nottickedoff">| i == pSize p - 1 = acc + fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` 0)</span>
|
||||
<span class="lineno"> 574 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 575 </span><span class="spaces"> </span><span class="nottickedoff">worker (acc + fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` (i+1))) (i+1)</span></span>
|
||||
<span class="lineno"> 576 </span>
|
||||
<span class="lineno"> 577 </span>pCircumference :: (Real a, Fractional a) => APolygon a -> a
|
||||
<span class="lineno"> 578 </span><span class="decl"><span class="nottickedoff">pCircumference p = sum</span>
|
||||
<span class="lineno"> 579 </span><span class="spaces"> </span><span class="nottickedoff">[ approxDist (pAccess p i) (pAccess p $ i+1)</span>
|
||||
<span class="lineno"> 580 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1]]</span></span>
|
||||
<span class="lineno"> 581 </span>
|
||||
<span class="lineno"> 582 </span>pCircumference' :: (Real a, Fractional a) => APolygon a -> Double
|
||||
<span class="lineno"> 583 </span><span class="decl"><span class="nottickedoff">pCircumference' p = sum</span>
|
||||
<span class="lineno"> 584 </span><span class="spaces"> </span><span class="nottickedoff">[ distance' (pAccess p i) (pAccess p $ i+1)</span>
|
||||
<span class="lineno"> 585 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1]]</span></span>
|
||||
<span class="lineno"> 586 </span>
|
||||
<span class="lineno"> 587 </span>
|
||||
<span class="lineno"> 588 </span>-- Add points by splitting the longest lines in half repeatedly.
|
||||
<span class="lineno"> 589 </span>pAddPoints :: PolyCtx a => Int -> APolygon a -> APolygon a
|
||||
<span class="lineno"> 590 </span><span class="decl"><span class="istickedoff">pAddPoints n p | <span class="tickonlytrue">n <= 0</span> = p</span>
|
||||
<span class="lineno"> 591 </span><span class="spaces"></span><span class="istickedoff">pAddPoints n p = <span class="nottickedoff">pAddPoints (n-1) $</span></span>
|
||||
<span class="lineno"> 592 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]</span></span>
|
||||
<span class="lineno"> 593 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 594 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">worker idx</span></span>
|
||||
<span class="lineno"> 595 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">| idx == longestEdge =</span></span>
|
||||
<span class="lineno"> 596 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let start = pAccess p idx</span></span>
|
||||
<span class="lineno"> 597 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">end = pAccess p $ idx+1</span></span>
|
||||
<span class="lineno"> 598 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">middle = lerp 0.5 end start</span></span>
|
||||
<span class="lineno"> 599 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in [start, middle]</span></span>
|
||||
<span class="lineno"> 600 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">| otherwise = [pAccess p idx]</span></span>
|
||||
<span class="lineno"> 601 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">longestEdge = maximumBy cmpLength [0 .. pSize p-1]</span></span>
|
||||
<span class="lineno"> 602 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">cmpLength a b =</span></span>
|
||||
<span class="lineno"> 603 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">distSquared (pAccess p a) (pAccess p $ a+1) `compare`</span></span>
|
||||
<span class="lineno"> 604 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">distSquared (pAccess p b) (pAccess p $ b+1)</span></span></span>
|
||||
<span class="lineno"> 605 </span>
|
||||
<span class="lineno"> 606 </span>pAddPointsRestricted :: PolyCtx a => [(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
|
||||
<span class="lineno"> 607 </span><span class="decl"><span class="nottickedoff">pAddPointsRestricted _immutableEdges n p | n <= 0 = p</span>
|
||||
<span class="lineno"> 608 </span><span class="spaces"></span><span class="nottickedoff">pAddPointsRestricted immutableEdges n p = pAddPointsRestricted immutableEdges (n-1) $</span>
|
||||
<span class="lineno"> 609 </span><span class="spaces"> </span><span class="nottickedoff">mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]</span>
|
||||
<span class="lineno"> 610 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 611 </span><span class="spaces"> </span><span class="nottickedoff">isImmutable idx =</span>
|
||||
<span class="lineno"> 612 </span><span class="spaces"> </span><span class="nottickedoff">(pAccess p idx, pAccess p $ idx+1) `elem` immutableEdges ||</span>
|
||||
<span class="lineno"> 613 </span><span class="spaces"> </span><span class="nottickedoff">(pAccess p $ idx+1, pAccess p idx) `elem` immutableEdges</span>
|
||||
<span class="lineno"> 614 </span><span class="spaces"> </span><span class="nottickedoff">worker idx</span>
|
||||
<span class="lineno"> 615 </span><span class="spaces"> </span><span class="nottickedoff">| idx == longestEdge && not (isImmutable idx) =</span>
|
||||
<span class="lineno"> 616 </span><span class="spaces"> </span><span class="nottickedoff">let start = pAccess p idx</span>
|
||||
<span class="lineno"> 617 </span><span class="spaces"> </span><span class="nottickedoff">end = pAccess p $ idx+1</span>
|
||||
<span class="lineno"> 618 </span><span class="spaces"> </span><span class="nottickedoff">middle = lerp 0.5 end start</span>
|
||||
<span class="lineno"> 619 </span><span class="spaces"> </span><span class="nottickedoff">in [start, middle]</span>
|
||||
<span class="lineno"> 620 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = [pAccess p idx]</span>
|
||||
<span class="lineno"> 621 </span><span class="spaces"> </span><span class="nottickedoff">longestEdge = maximumBy cmpLength [0 .. pSize p-1]</span>
|
||||
<span class="lineno"> 622 </span><span class="spaces"> </span><span class="nottickedoff">cmpLength a _ | isImmutable a = LT</span>
|
||||
<span class="lineno"> 623 </span><span class="spaces"> </span><span class="nottickedoff">cmpLength _ b | isImmutable b = GT</span>
|
||||
<span class="lineno"> 624 </span><span class="spaces"> </span><span class="nottickedoff">cmpLength a b =</span>
|
||||
<span class="lineno"> 625 </span><span class="spaces"> </span><span class="nottickedoff">distSquared (pAccess p a) (pAccess p $ a+1) `compare`</span>
|
||||
<span class="lineno"> 626 </span><span class="spaces"> </span><span class="nottickedoff">distSquared (pAccess p b) (pAccess p $ b+1)</span></span>
|
||||
<span class="lineno"> 627 </span>
|
||||
<span class="lineno"> 628 </span>pAddPointsBetween :: PolyCtx a => (Int, Int) -> Int -> APolygon a -> APolygon a
|
||||
<span class="lineno"> 629 </span><span class="decl"><span class="nottickedoff">pAddPointsBetween _ n p | n <= 0 = p</span>
|
||||
<span class="lineno"> 630 </span><span class="spaces"></span><span class="nottickedoff">pAddPointsBetween (i,l) n p = pAddPointsBetween (i,l+1) (n-1) $</span>
|
||||
<span class="lineno"> 631 </span><span class="spaces"> </span><span class="nottickedoff">mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]</span>
|
||||
<span class="lineno"> 632 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 633 </span><span class="spaces"> </span><span class="nottickedoff">worker idx</span>
|
||||
<span class="lineno"> 634 </span><span class="spaces"> </span><span class="nottickedoff">| idx == longestEdge =</span>
|
||||
<span class="lineno"> 635 </span><span class="spaces"> </span><span class="nottickedoff">let start = pAccess p idx</span>
|
||||
<span class="lineno"> 636 </span><span class="spaces"> </span><span class="nottickedoff">end = pAccess p $ idx+1</span>
|
||||
<span class="lineno"> 637 </span><span class="spaces"> </span><span class="nottickedoff">middle = lerp 0.5 end start</span>
|
||||
<span class="lineno"> 638 </span><span class="spaces"> </span><span class="nottickedoff">in [start, middle]</span>
|
||||
<span class="lineno"> 639 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = [pAccess p idx]</span>
|
||||
<span class="lineno"> 640 </span><span class="spaces"> </span><span class="nottickedoff">longestEdge = maximumBy cmpLength [i .. i+l-1]</span>
|
||||
<span class="lineno"> 641 </span><span class="spaces"> </span><span class="nottickedoff">cmpLength a b =</span>
|
||||
<span class="lineno"> 642 </span><span class="spaces"> </span><span class="nottickedoff">distSquared (pAccess p a) (pAccess p $ a+1) `compare`</span>
|
||||
<span class="lineno"> 643 </span><span class="spaces"> </span><span class="nottickedoff">distSquared (pAccess p b) (pAccess p $ b+1)</span></span>
|
||||
<span class="lineno"> 644 </span>
|
||||
<span class="lineno"> 645 </span>-- addPoints :: Int -> Polygon -> Polygon
|
||||
<span class="lineno"> 646 </span>-- addPoints n p = mkPolygon $ V.fromList $ worker n 0 (map (pAccess p) [0..s])
|
||||
<span class="lineno"> 647 </span>-- where
|
||||
<span class="lineno"> 648 </span>-- worker 0 _ rest = init rest
|
||||
<span class="lineno"> 649 </span>-- worker i acc (x:y:xs) =
|
||||
<span class="lineno"> 650 </span>-- let xy = approxDist x y in
|
||||
<span class="lineno"> 651 </span>-- if acc + xy > limit
|
||||
<span class="lineno"> 652 </span>-- then x : worker (i-1) 0 (lerp ((limit-acc)/xy) y x : y:xs)
|
||||
<span class="lineno"> 653 </span>-- else x : worker i (acc+xy) (y:xs)
|
||||
<span class="lineno"> 654 </span>-- worker _ _ [_] = []
|
||||
<span class="lineno"> 655 </span>-- worker _ _ _ = error "addPoints: invalid polygon"
|
||||
<span class="lineno"> 656 </span>-- s = pSize p
|
||||
<span class="lineno"> 657 </span>-- len = polygonLength p
|
||||
<span class="lineno"> 658 </span>-- limit = len / fromIntegral (n+1)
|
||||
<span class="lineno"> 659 </span>
|
||||
<span class="lineno"> 660 </span>pIsConvex :: Polygon -> Bool
|
||||
<span class="lineno"> 661 </span><span class="decl"><span class="nottickedoff">pIsConvex p = and</span>
|
||||
<span class="lineno"> 662 </span><span class="spaces"> </span><span class="nottickedoff">[ area2X (pAccess p i) (pAccess p j) (pAccess p k) > 0</span>
|
||||
<span class="lineno"> 663 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0..n-1]</span>
|
||||
<span class="lineno"> 664 </span><span class="spaces"> </span><span class="nottickedoff">, j <- [i+1..n-1]</span>
|
||||
<span class="lineno"> 665 </span><span class="spaces"> </span><span class="nottickedoff">, k <- [j+1..n-1]</span>
|
||||
<span class="lineno"> 666 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 667 </span><span class="spaces"> </span><span class="nottickedoff">where n = pSize p</span></span>
|
||||
<span class="lineno"> 668 </span>
|
||||
<span class="lineno"> 669 </span>pIsCCW :: Polygon -> Bool
|
||||
<span class="lineno"> 670 </span><span class="decl"><span class="istickedoff">pIsCCW p | <span class="tickonlyfalse">pNull p</span> = <span class="nottickedoff">False</span></span>
|
||||
<span class="lineno"> 671 </span><span class="spaces"></span><span class="istickedoff">pIsCCW p = V.sum (pMapEdges fn p) < 0</span>
|
||||
<span class="lineno"> 672 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 673 </span><span class="spaces"> </span><span class="istickedoff">fn (V2 x1 y1) (V2 x2 y2) = (x2-x1)*(y2+y1)</span></span>
|
||||
<span class="lineno"> 674 </span>
|
||||
<span class="lineno"> 675 </span>{-# INLINE pRayIntersect #-}
|
||||
<span class="lineno"> 676 </span>pRayIntersect :: PolyCtx a => APolygon a -> (Int, Int) -> (Int,Int) -> Maybe (V2 a)
|
||||
<span class="lineno"> 677 </span><span class="decl"><span class="nottickedoff">pRayIntersect p (a,b) (c,d) =</span>
|
||||
<span class="lineno"> 678 </span><span class="spaces"> </span><span class="nottickedoff">rayIntersect (pAccess p a, pAccess p b) (pAccess p c, pAccess p d)</span></span>
|
||||
<span class="lineno"> 679 </span>
|
||||
<span class="lineno"> 680 </span>pCuts :: (Real a, Fractional a, Epsilon a) => APolygon a -> [(APolygon a,APolygon a)]
|
||||
<span class="lineno"> 681 </span><span class="decl"><span class="nottickedoff">pCuts p =</span>
|
||||
<span class="lineno"> 682 </span><span class="spaces"> </span><span class="nottickedoff">[ pCutAt (pAdjustOffset p i) (j-i)</span>
|
||||
<span class="lineno"> 683 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1 ]</span>
|
||||
<span class="lineno"> 684 </span><span class="spaces"> </span><span class="nottickedoff">, j <- [i+2 .. pSize p-1 ]</span>
|
||||
<span class="lineno"> 685 </span><span class="spaces"> </span><span class="nottickedoff">, (j+1) `mod` pSize p /= i</span>
|
||||
<span class="lineno"> 686 </span><span class="spaces"> </span><span class="nottickedoff">, pParent p i j == i ]</span></span>
|
||||
<span class="lineno"> 687 </span>
|
||||
<span class="lineno"> 688 </span>pCutEqual :: PolyCtx a => APolygon a -> (APolygon a, APolygon a)
|
||||
<span class="lineno"> 689 </span><span class="decl"><span class="nottickedoff">pCutEqual p =</span>
|
||||
<span class="lineno"> 690 </span><span class="spaces"> </span><span class="nottickedoff">fromMaybe (p,p) $ listToMaybe $ sortOn f $ pCuts p</span>
|
||||
<span class="lineno"> 691 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 692 </span><span class="spaces"> </span><span class="nottickedoff">f (a,b) = abs (pArea a - pArea b)</span></span>
|
||||
<span class="lineno"> 693 </span>
|
||||
<span class="lineno"> 694 </span>-- FIXME: This should be more efficient
|
||||
<span class="lineno"> 695 </span>pCutAt :: PolyCtx a => APolygon a -> Int -> (APolygon a, APolygon a)
|
||||
<span class="lineno"> 696 </span><span class="decl"><span class="nottickedoff">pCutAt p i = (mkPolygon $ V.fromList left, mkPolygon $ V.fromList right)</span>
|
||||
<span class="lineno"> 697 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 698 </span><span class="spaces"> </span><span class="nottickedoff">n = pSize p</span>
|
||||
<span class="lineno"> 699 </span><span class="spaces"> </span><span class="nottickedoff">left = map (pAccess p) [0 .. i]</span>
|
||||
<span class="lineno"> 700 </span><span class="spaces"> </span><span class="nottickedoff">right = map (pAccess p) (0:[i..n-1])</span></span>
|
||||
<span class="lineno"> 701 </span>
|
||||
<span class="lineno"> 702 </span>pOverlap :: PolyCtx a => APolygon a -> APolygon a -> APolygon a
|
||||
<span class="lineno"> 703 </span><span class="decl"><span class="nottickedoff">pOverlap a b = mkPolygon $ V.fromList $ clearDups $ concatMap edgeIntersect [0 .. pSize a-1]</span>
|
||||
<span class="lineno"> 704 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 705 </span><span class="spaces"> </span><span class="nottickedoff">clearDups (x:y:xs)</span>
|
||||
<span class="lineno"> 706 </span><span class="spaces"> </span><span class="nottickedoff">| x == y = clearDups (y:xs)</span>
|
||||
<span class="lineno"> 707 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x : clearDups (y:xs)</span>
|
||||
<span class="lineno"> 708 </span><span class="spaces"> </span><span class="nottickedoff">clearDups xs = xs</span>
|
||||
<span class="lineno"> 709 </span><span class="spaces"> </span><span class="nottickedoff">edgeIntersect edge =</span>
|
||||
<span class="lineno"> 710 </span><span class="spaces"> </span><span class="nottickedoff">sortOn (distSquared (pAccess a edge)) $ catMaybes</span>
|
||||
<span class="lineno"> 711 </span><span class="spaces"> </span><span class="nottickedoff">[ lineIntersect (aP, aP') (bP, bP')</span>
|
||||
<span class="lineno"> 712 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize b-1]</span>
|
||||
<span class="lineno"> 713 </span><span class="spaces"> </span><span class="nottickedoff">, let aP = pAccess a edge</span>
|
||||
<span class="lineno"> 714 </span><span class="spaces"> </span><span class="nottickedoff">aP' = pAccess a (edge+1)</span>
|
||||
<span class="lineno"> 715 </span><span class="spaces"> </span><span class="nottickedoff">bP = pAccess b i</span>
|
||||
<span class="lineno"> 716 </span><span class="spaces"> </span><span class="nottickedoff">bP' = pAccess b (i+1)</span>
|
||||
<span class="lineno"> 717 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
||||
<span class="lineno"> 718 </span>
|
||||
<span class="lineno"> 719 </span>---------------------------------------------------------
|
||||
<span class="lineno"> 720 </span>-- SSSP visibility and SSSP windows
|
||||
<span class="lineno"> 721 </span>
|
||||
<span class="lineno"> 722 </span>ssspVisibility :: PolyCtx a => APolygon a -> APolygon a
|
||||
<span class="lineno"> 723 </span><span class="decl"><span class="nottickedoff">ssspVisibility p = mkPolygon $</span>
|
||||
<span class="lineno"> 724 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList $ clearDups $ go [0 .. pSize p-1] -- ([root..pSize p-1] ++ [0 .. root-1])</span>
|
||||
<span class="lineno"> 725 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 726 </span><span class="spaces"> </span><span class="nottickedoff">clearDups (x:y:xs)</span>
|
||||
<span class="lineno"> 727 </span><span class="spaces"> </span><span class="nottickedoff">| x == y = clearDups (y:xs)</span>
|
||||
<span class="lineno"> 728 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x : clearDups (y:xs)</span>
|
||||
<span class="lineno"> 729 </span><span class="spaces"> </span><span class="nottickedoff">clearDups xs = xs</span>
|
||||
<span class="lineno"> 730 </span><span class="spaces"> </span><span class="nottickedoff">obstructedBy n =</span>
|
||||
<span class="lineno"> 731 </span><span class="spaces"> </span><span class="nottickedoff">case pParent p 0 n of</span>
|
||||
<span class="lineno"> 732 </span><span class="spaces"> </span><span class="nottickedoff">0 -> n</span>
|
||||
<span class="lineno"> 733 </span><span class="spaces"> </span><span class="nottickedoff">i -> obstructedBy i</span>
|
||||
<span class="lineno"> 734 </span><span class="spaces"> </span><span class="nottickedoff">go [] = []</span>
|
||||
<span class="lineno"> 735 </span><span class="spaces"> </span><span class="nottickedoff">go [x] = [pAccess p x]</span>
|
||||
<span class="lineno"> 736 </span><span class="spaces"> </span><span class="nottickedoff">go (x:y:xs) =</span>
|
||||
<span class="lineno"> 737 </span><span class="spaces"> </span><span class="nottickedoff">let xO = obstructedBy x</span>
|
||||
<span class="lineno"> 738 </span><span class="spaces"> </span><span class="nottickedoff">yO = obstructedBy y</span>
|
||||
<span class="lineno"> 739 </span><span class="spaces"> </span><span class="nottickedoff">in case () of</span>
|
||||
<span class="lineno"> 740 </span><span class="spaces"> </span><span class="nottickedoff">()</span>
|
||||
<span class="lineno"> 741 </span><span class="spaces"> </span><span class="nottickedoff">-- Both ends are visible.</span>
|
||||
<span class="lineno"> 742 </span><span class="spaces"> </span><span class="nottickedoff">| xO == x && yO == y -> pAccess p x : go (y:xs)</span>
|
||||
<span class="lineno"> 743 </span><span class="spaces"> </span><span class="nottickedoff">-- X is visible, x to intersect (0,yO) (x,y)</span>
|
||||
<span class="lineno"> 744 </span><span class="spaces"> </span><span class="nottickedoff">| xO == x -></span>
|
||||
<span class="lineno"> 745 </span><span class="spaces"> </span><span class="nottickedoff">pAccess p x : fromMaybe (pAccess p y) (pRayIntersect p (0,yO) (x,y)) : go (y:xs)</span>
|
||||
<span class="lineno"> 746 </span><span class="spaces"> </span><span class="nottickedoff">-- Y is visible</span>
|
||||
<span class="lineno"> 747 </span><span class="spaces"> </span><span class="nottickedoff">| yO == y -> fromMaybe (pAccess p x) (pRayIntersect p (0,xO) (x,y)) : pAccess p y : go (y:xs)</span>
|
||||
<span class="lineno"> 748 </span><span class="spaces"> </span><span class="nottickedoff">-- Neither is visible and they've obstructed by the same point</span>
|
||||
<span class="lineno"> 749 </span><span class="spaces"> </span><span class="nottickedoff">-- so the entire edge is hidden.</span>
|
||||
<span class="lineno"> 750 </span><span class="spaces"> </span><span class="nottickedoff">| xO == yO -> go (y:xs)</span>
|
||||
<span class="lineno"> 751 </span><span class="spaces"> </span><span class="nottickedoff">-- Neither is visible. Cast shadow from obstruction points to</span>
|
||||
<span class="lineno"> 752 </span><span class="spaces"> </span><span class="nottickedoff">-- find if a subsection of the edge is visible.</span>
|
||||
<span class="lineno"> 753 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise -></span>
|
||||
<span class="lineno"> 754 </span><span class="spaces"> </span><span class="nottickedoff">let a = fromMaybe (error "a") (pRayIntersect p (0,xO) (x,y))</span>
|
||||
<span class="lineno"> 755 </span><span class="spaces"> </span><span class="nottickedoff">b = fromMaybe (error "b") (pRayIntersect p (0,yO) (x,y))</span>
|
||||
<span class="lineno"> 756 </span><span class="spaces"> </span><span class="nottickedoff">in if a /= b</span>
|
||||
<span class="lineno"> 757 </span><span class="spaces"> </span><span class="nottickedoff">then a : b : go (y:xs)</span>
|
||||
<span class="lineno"> 758 </span><span class="spaces"> </span><span class="nottickedoff">else go (y:xs)</span></span>
|
||||
<span class="lineno"> 759 </span>
|
||||
<span class="lineno"> 760 </span>ssspWindows :: Polygon -> [(V2 Rational, V2 Rational)]
|
||||
<span class="lineno"> 761 </span><span class="decl"><span class="nottickedoff">ssspWindows p = clearDups $ go (pAccess p 0) [0..pSize p-1]</span>
|
||||
<span class="lineno"> 762 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 763 </span><span class="spaces"> </span><span class="nottickedoff">clearDups (x:y:xs)</span>
|
||||
<span class="lineno"> 764 </span><span class="spaces"> </span><span class="nottickedoff">| x == y = clearDups (y:xs)</span>
|
||||
<span class="lineno"> 765 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x : clearDups (y:xs)</span>
|
||||
<span class="lineno"> 766 </span><span class="spaces"> </span><span class="nottickedoff">clearDups xs = xs</span>
|
||||
<span class="lineno"> 767 </span><span class="spaces"> </span><span class="nottickedoff">obstructedBy n =</span>
|
||||
<span class="lineno"> 768 </span><span class="spaces"> </span><span class="nottickedoff">case pParent p 0 n of</span>
|
||||
<span class="lineno"> 769 </span><span class="spaces"> </span><span class="nottickedoff">0 -> n</span>
|
||||
<span class="lineno"> 770 </span><span class="spaces"> </span><span class="nottickedoff">i -> obstructedBy i</span>
|
||||
<span class="lineno"> 771 </span><span class="spaces"> </span><span class="nottickedoff">go _ [] = []</span>
|
||||
<span class="lineno"> 772 </span><span class="spaces"> </span><span class="nottickedoff">go _ [_] = []</span>
|
||||
<span class="lineno"> 773 </span><span class="spaces"> </span><span class="nottickedoff">go l (x:y:xs) =</span>
|
||||
<span class="lineno"> 774 </span><span class="spaces"> </span><span class="nottickedoff">let xO = obstructedBy x</span>
|
||||
<span class="lineno"> 775 </span><span class="spaces"> </span><span class="nottickedoff">yO = obstructedBy y</span>
|
||||
<span class="lineno"> 776 </span><span class="spaces"> </span><span class="nottickedoff">in case () of</span>
|
||||
<span class="lineno"> 777 </span><span class="spaces"> </span><span class="nottickedoff">()</span>
|
||||
<span class="lineno"> 778 </span><span class="spaces"> </span><span class="nottickedoff">-- Both ends are visible.</span>
|
||||
<span class="lineno"> 779 </span><span class="spaces"> </span><span class="nottickedoff">| xO == x && yO == y -> go (pAccess p x) (y:xs)</span>
|
||||
<span class="lineno"> 780 </span><span class="spaces"> </span><span class="nottickedoff">-- X is visible, x to intersect (0,yO) (x,y)</span>
|
||||
<span class="lineno"> 781 </span><span class="spaces"> </span><span class="nottickedoff">| xO == x -></span>
|
||||
<span class="lineno"> 782 </span><span class="spaces"> </span><span class="nottickedoff">go (fromMaybe (pAccess p y) (pRayIntersect p (0,yO) (x,y))) (y:xs)</span>
|
||||
<span class="lineno"> 783 </span><span class="spaces"> </span><span class="nottickedoff">-- Y is visible</span>
|
||||
<span class="lineno"> 784 </span><span class="spaces"> </span><span class="nottickedoff">| yO == y -></span>
|
||||
<span class="lineno"> 785 </span><span class="spaces"> </span><span class="nottickedoff">let newL = fromMaybe (pAccess p x) (pRayIntersect p (0,xO) (x,y)) in</span>
|
||||
<span class="lineno"> 786 </span><span class="spaces"> </span><span class="nottickedoff">(l, newL) :</span>
|
||||
<span class="lineno"> 787 </span><span class="spaces"> </span><span class="nottickedoff">go newL (y:xs)</span>
|
||||
<span class="lineno"> 788 </span><span class="spaces"> </span><span class="nottickedoff">-- Neither is visible and they've obstructed by the same point</span>
|
||||
<span class="lineno"> 789 </span><span class="spaces"> </span><span class="nottickedoff">-- so the entire edge is hidden.</span>
|
||||
<span class="lineno"> 790 </span><span class="spaces"> </span><span class="nottickedoff">| xO == yO -> go l (y:xs)</span>
|
||||
<span class="lineno"> 791 </span><span class="spaces"> </span><span class="nottickedoff">-- Neither is visible. Cast shadow from obstruction points to</span>
|
||||
<span class="lineno"> 792 </span><span class="spaces"> </span><span class="nottickedoff">-- find if a subsection of the edge is visible.</span>
|
||||
<span class="lineno"> 793 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise -></span>
|
||||
<span class="lineno"> 794 </span><span class="spaces"> </span><span class="nottickedoff">let a = fromMaybe (error "a") (pRayIntersect p (0,xO) (x,y))</span>
|
||||
<span class="lineno"> 795 </span><span class="spaces"> </span><span class="nottickedoff">b = fromMaybe (error "b") (pRayIntersect p (0,yO) (x,y))</span>
|
||||
<span class="lineno"> 796 </span><span class="spaces"> </span><span class="nottickedoff">in if a /= b</span>
|
||||
<span class="lineno"> 797 </span><span class="spaces"> </span><span class="nottickedoff">then (l, a) : (b, pAccess p yO) : go (pAccess p yO) (y:xs)</span>
|
||||
<span class="lineno"> 798 </span><span class="spaces"> </span><span class="nottickedoff">else go l (y:xs)</span></span>
|
||||
<span class="lineno"> 799 </span>
|
||||
<span class="lineno"> 800 </span>pdualPolygons :: Polygon -> PDual -> [Polygon]
|
||||
<span class="lineno"> 801 </span><span class="decl"><span class="nottickedoff">pdualPolygons p pdual = map mkPolygonFromRing (pdualRings (pRing p) pdual)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
366
reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP.hs.html
Normal file
366
reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP.hs.html
Normal file
|
|
@ -0,0 +1,366 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE FlexibleInstances #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
<span class="lineno"> 3 </span>{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
<span class="lineno"> 4 </span>{-# OPTIONS_HADDOCK hide #-}
|
||||
<span class="lineno"> 5 </span>module Reanimate.Math.SSSP
|
||||
<span class="lineno"> 6 </span> ( -- * Single-Source-Shortest-Path
|
||||
<span class="lineno"> 7 </span> SSSP
|
||||
<span class="lineno"> 8 </span> , sssp -- :: (Fractional a, Ord a) => Ring a -> Dual -> SSSP
|
||||
<span class="lineno"> 9 </span> , dual -- :: Int -> Triangulation -> Dual
|
||||
<span class="lineno"> 10 </span> , Dual(..)
|
||||
<span class="lineno"> 11 </span> , DualTree(..)
|
||||
<span class="lineno"> 12 </span> , PDual
|
||||
<span class="lineno"> 13 </span> , toPDual -- :: Ring Rational -> Dual -> PDual
|
||||
<span class="lineno"> 14 </span> , pdualRings -- :: Ring Rational -> PDual -> [Ring Rational]
|
||||
<span class="lineno"> 15 </span> -- * Misc
|
||||
<span class="lineno"> 16 </span> , dualToTriangulation -- :: Ring Rational -> Dual -> Triangulation
|
||||
<span class="lineno"> 17 </span> , pdualReduce -- :: Ring Rational -> PDual -> Int -> PDual
|
||||
<span class="lineno"> 18 </span> , visibilityArray -- :: Ring Rational -> V.Vector [Int]
|
||||
<span class="lineno"> 19 </span> , naive -- :: Ring Rational -> SSSP
|
||||
<span class="lineno"> 20 </span> , naive2 -- :: Ring Rational -> SSSP
|
||||
<span class="lineno"> 21 </span> , drawDual -- :: Dual -> String
|
||||
<span class="lineno"> 22 </span> ) where
|
||||
<span class="lineno"> 23 </span>
|
||||
<span class="lineno"> 24 </span>import Control.Monad
|
||||
<span class="lineno"> 25 </span>-- import Control.Exception
|
||||
<span class="lineno"> 26 </span>import Control.Monad.ST
|
||||
<span class="lineno"> 27 </span>-- import Data.FingerTree (SearchResult (..), (|>))
|
||||
<span class="lineno"> 28 </span>-- import qualified Data.FingerTree as F
|
||||
<span class="lineno"> 29 </span>import Data.Foldable
|
||||
<span class="lineno"> 30 </span>import Data.List
|
||||
<span class="lineno"> 31 </span>import qualified Data.Map as Map
|
||||
<span class="lineno"> 32 </span>import Data.Maybe
|
||||
<span class="lineno"> 33 </span>import Data.Ord
|
||||
<span class="lineno"> 34 </span>import Data.STRef
|
||||
<span class="lineno"> 35 </span>import Data.Tree
|
||||
<span class="lineno"> 36 </span>import qualified Data.Vector as V
|
||||
<span class="lineno"> 37 </span>import qualified Data.Vector.Mutable as MV
|
||||
<span class="lineno"> 38 </span>import Reanimate.Math.Common
|
||||
<span class="lineno"> 39 </span>import Reanimate.Math.Triangulate
|
||||
<span class="lineno"> 40 </span>
|
||||
<span class="lineno"> 41 </span>-- import Debug.Trace
|
||||
<span class="lineno"> 42 </span>
|
||||
<span class="lineno"> 43 </span>type SSSP = V.Vector Int
|
||||
<span class="lineno"> 44 </span>
|
||||
<span class="lineno"> 45 </span>
|
||||
<span class="lineno"> 46 </span>-- ssspParent :: Polygon -> SSSP -> Int -> Int
|
||||
<span class="lineno"> 47 </span>-- ssspParent p sTree x =
|
||||
<span class="lineno"> 48 </span>-- (sTree V.! ((x - polygonOffset p) `mod` n) + polygonOffset p) `mod` n
|
||||
<span class="lineno"> 49 </span>-- where
|
||||
<span class="lineno"> 50 </span>-- n = polygonSize p
|
||||
<span class="lineno"> 51 </span>
|
||||
<span class="lineno"> 52 </span>visibilityArray :: Ring Rational -> V.Vector [Int]
|
||||
<span class="lineno"> 53 </span><span class="decl"><span class="nottickedoff">visibilityArray p = arr</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">n = ringSize p</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">arr = V.fromList</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">[ visibility y</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">| y <- [0..n-1]</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">visibility y =</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">[ i</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0..y-1]</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="nottickedoff">, y `elem` arr V.! i ] ++</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="nottickedoff">[ i</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [y+1 .. n-1]</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="nottickedoff">, let pI = ringAccess p i</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">isOpen = isRightTurn pYp pY pYn</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">, ringClamp p (y+1) == i || ringClamp p (y-1) == i || if isOpen</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">then isLeftTurnOrLinear pY pYn pI ||</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">isLeftTurnOrLinear pYp pY pI</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">else not $ isRightTurn pY pYn pI ||</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">isRightTurn pYp pY pI</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">, let myEdges = [(e1,e2) | (e1,e2) <- edges, e1/=y, e1/=i, e2/=y,e2/=i]</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">, all (isNothing . lineIntersect (pY,pI))</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">[ (ringAccess p e1, ringAccess p e2) | (e1,e2) <- myEdges ]]</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="nottickedoff">pY = ringAccess p y</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="nottickedoff">pYn = ringAccess p $ y+1</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="nottickedoff">pYp = ringAccess p $ y-1</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="nottickedoff">edges = zip [0..n-1] (tail [0..n-1] ++ [0])</span></span>
|
||||
<span class="lineno"> 81 </span>
|
||||
<span class="lineno"> 82 </span>
|
||||
<span class="lineno"> 83 </span>
|
||||
<span class="lineno"> 84 </span>-- Iterative Single Source Shortest Path solver. Quite slow.
|
||||
<span class="lineno"> 85 </span>naive :: Ring Rational -> SSSP
|
||||
<span class="lineno"> 86 </span><span class="decl"><span class="nottickedoff">naive p =</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList $ Map.elems $</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="nottickedoff">Map.map snd $</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="nottickedoff">worker initial</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="nottickedoff">initial = Map.singleton 0 (0,0)</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="nottickedoff">visibility = visibilityArray p</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="nottickedoff">worker :: Map.Map Int (Rational, Int) -> Map.Map Int (Rational, Int)</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="nottickedoff">worker m</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="nottickedoff">| m==newM = newM</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = worker newM</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">ms' = [ Map.fromList</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="nottickedoff">[ case Map.lookup v m of</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> (v, (distThroughI, i))</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="nottickedoff">Just (otherDist,parent)</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="nottickedoff">| otherDist > distThroughI -> (v, (distThroughI, i))</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise -> (v, (otherDist, parent))</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="nottickedoff">| v <- visibility V.! i</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="nottickedoff">, let distThroughI = dist + approxDist (ringAccess p i) (ringAccess p v) ]</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="nottickedoff">| (i,(dist,_)) <- Map.toList m</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">newM = Map.unionsWith g (m:ms') :: Map.Map Int (Rational,Int)</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">g a b = if fst a < fst b then a else b</span></span>
|
||||
<span class="lineno"> 110 </span>
|
||||
<span class="lineno"> 111 </span>naive2 :: Ring Rational -> SSSP
|
||||
<span class="lineno"> 112 </span><span class="decl"><span class="nottickedoff">naive2 p = runST $ do</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="nottickedoff">parents <- MV.replicate (ringSize p) (-1)</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="nottickedoff">costs <- MV.replicate (ringSize p) (-1)</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="nottickedoff">MV.write parents 0 0</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">MV.write costs 0 0</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">changedRef <- newSTRef False</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">let loop i</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">| i == ringSize p = do</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">changed <- readSTRef changedRef</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">when changed $ do</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">writeSTRef changedRef False</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">loop 0</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = do</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">myCost <- MV.read costs i</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">unless (myCost < 0) $</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">forM_ (visibility V.! i) $ \n -> do</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">-- n is visible from i.</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="nottickedoff">theirCost <- MV.read costs n</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">let throughCost = myCost + approxDist (ringAccess p i) (ringAccess p n)</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">when (throughCost < theirCost || theirCost < 0) $ do</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">MV.write parents n i</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">MV.write costs n throughCost</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff">writeSTRef changedRef True</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">loop (i+1)</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">loop 0</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">V.unsafeFreeze parents</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">visibility = visibilityArray p</span></span>
|
||||
<span class="lineno"> 140 </span>
|
||||
<span class="lineno"> 141 </span>data PDual = PDual (V.Vector Int) Rational [PDual]
|
||||
<span class="lineno"> 142 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 143 </span>
|
||||
<span class="lineno"> 144 </span>toPDual :: Ring Rational -> Dual -> PDual
|
||||
<span class="lineno"> 145 </span><span class="decl"><span class="nottickedoff">toPDual p d =</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="nottickedoff">case d of</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="nottickedoff">Dual (a,b,c) l r -></span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="nottickedoff">PDual (V.fromList [a,b,c])</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">(area2X (ringAccess p a) (ringAccess p b) (ringAccess p c))</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">(catMaybes [ worker c a l, worker b c r])</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">worker _ _ EmptyDual = Nothing</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">worker a b (NodeDual x l r) = Just $</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">PDual (V.fromList [a,x,b])</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">(area2X (ringAccess p a) (ringAccess p x) (ringAccess p b))</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">(catMaybes [ worker x b l, worker a x r])</span></span>
|
||||
<span class="lineno"> 157 </span>
|
||||
<span class="lineno"> 158 </span>pdualSize :: PDual -> Int
|
||||
<span class="lineno"> 159 </span><span class="decl"><span class="nottickedoff">pdualSize (PDual _ _ children) = 1 + sum (map pdualSize children)</span></span>
|
||||
<span class="lineno"> 160 </span>
|
||||
<span class="lineno"> 161 </span>pdualArea :: PDual -> Rational
|
||||
<span class="lineno"> 162 </span><span class="decl"><span class="nottickedoff">pdualArea (PDual _ faceArea _) = faceArea</span></span>
|
||||
<span class="lineno"> 163 </span>
|
||||
<span class="lineno"> 164 </span>-- FIXME: 'origin' isn't used. Remove.
|
||||
<span class="lineno"> 165 </span>pdualReduce :: Ring Rational -> PDual -> Int -> PDual
|
||||
<span class="lineno"> 166 </span><span class="decl"><span class="nottickedoff">pdualReduce origin pdual n</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="nottickedoff">| pdualSize pdual <= n = pdual</span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="nottickedoff">let smallest = minimum $ pAreas pdual</span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="nottickedoff">in pdualReduce origin (merge smallest pdual) n</span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="nottickedoff">merge _s (PDual p faceArea []) = PDual p faceArea []</span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="nottickedoff">merge s (PDual p faceArea children)</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="nottickedoff">| faceArea == s =</span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="nottickedoff">let (PDual p2 area2 children2:xs) = sortBy (comparing pdualArea) children</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="nottickedoff">in PDual (joinP p p2) (faceArea+area2) (children2++xs)</span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">let (PDual p2 area2 children2:xs) = sortBy (comparing pdualArea) children</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">in if area2 == s</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">then PDual (joinP p p2) (faceArea+area2) (children2++xs)</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">else PDual p faceArea (map (merge s) children)</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="nottickedoff">pAreas (PDual _ faceArea children) = faceArea : concatMap pAreas children</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="nottickedoff">joinP a b = V.fromList (sort (V.toList a ++ V.toList b))</span></span>
|
||||
<span class="lineno"> 184 </span>
|
||||
<span class="lineno"> 185 </span>pdualRings :: Ring Rational -> PDual -> [Ring Rational]
|
||||
<span class="lineno"> 186 </span><span class="decl"><span class="nottickedoff">pdualRings p (PDual pts _area children) =</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff">ringPack (V.map (ringAccess p) pts) : concatMap (pdualRings p) children</span></span>
|
||||
<span class="lineno"> 188 </span>
|
||||
<span class="lineno"> 189 </span>-- Dual of triangulated polygon
|
||||
<span class="lineno"> 190 </span>data Dual = Dual (Int,Int,Int) -- (a,b,c)
|
||||
<span class="lineno"> 191 </span> DualTree -- borders ca
|
||||
<span class="lineno"> 192 </span> DualTree -- borders bc
|
||||
<span class="lineno"> 193 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 194 </span>
|
||||
<span class="lineno"> 195 </span>data DualTree
|
||||
<span class="lineno"> 196 </span> = EmptyDual
|
||||
<span class="lineno"> 197 </span> | NodeDual Int -- axb triangle, a and b are from parent.
|
||||
<span class="lineno"> 198 </span> DualTree -- borders xb
|
||||
<span class="lineno"> 199 </span> DualTree -- borders ax
|
||||
<span class="lineno"> 200 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 201 </span>
|
||||
<span class="lineno"> 202 </span>drawDual :: Dual -> String
|
||||
<span class="lineno"> 203 </span><span class="decl"><span class="nottickedoff">drawDual d = drawTree $</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="nottickedoff">case d of</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="nottickedoff">Dual (a,b,c) l r -> Node (show (a,b,c)) [worker c a l, worker b c r]</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="nottickedoff">worker _a _b EmptyDual = Node "Leaf" []</span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="nottickedoff">worker a b (NodeDual x l r) =</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="nottickedoff">Node (show (b,a,x)) [worker x b l, worker a x r]</span></span>
|
||||
<span class="lineno"> 210 </span>
|
||||
<span class="lineno"> 211 </span>dualToTriangulation :: Ring Rational -> Dual -> Triangulation
|
||||
<span class="lineno"> 212 </span><span class="decl"><span class="nottickedoff">dualToTriangulation p d = edgesToTriangulation (ringSize p) $ filter goodEdge $</span>
|
||||
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="nottickedoff">case d of</span>
|
||||
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="nottickedoff">Dual (a,b,c) l r -></span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="nottickedoff">(a,b):(a,c):(b,c):worker c a l ++ worker b c r</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">goodEdge (a,b)</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="nottickedoff">= a /= ringClamp p (b+1) && a /= ringClamp p (b-1)</span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="nottickedoff">worker _a _b EmptyDual = []</span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="nottickedoff">worker a b (NodeDual x l r) =</span>
|
||||
<span class="lineno"> 221 </span><span class="spaces"> </span><span class="nottickedoff">(a,x) : (x, b) : worker x b l ++ worker a x r</span></span>
|
||||
<span class="lineno"> 222 </span>
|
||||
<span class="lineno"> 223 </span>-- Dual path:
|
||||
<span class="lineno"> 224 </span>-- (Int,Int,Int) + V.Vector Int + V.Vector LeftOrRight
|
||||
<span class="lineno"> 225 </span>
|
||||
<span class="lineno"> 226 </span>-- simplifyDual :: DualTree -> DualTree
|
||||
<span class="lineno"> 227 </span>-- -- simplifyDual (NodeDual x EmptyDual EmptyDual) = NodeLeaf x
|
||||
<span class="lineno"> 228 </span>-- -- simplifyDual (NodeDual x l EmptyDual) = NodeDualL x l
|
||||
<span class="lineno"> 229 </span>-- -- simplifyDual (NodeDual x EmptyDual r) = NodeDualR x r
|
||||
<span class="lineno"> 230 </span>-- simplifyDual d = d
|
||||
<span class="lineno"> 231 </span>
|
||||
<span class="lineno"> 232 </span>dual :: Int -> Triangulation -> Dual
|
||||
<span class="lineno"> 233 </span><span class="decl"><span class="nottickedoff">dual root t =</span>
|
||||
<span class="lineno"> 234 </span><span class="spaces"> </span><span class="nottickedoff">case hasTriangle of</span>
|
||||
<span class="lineno"> 235 </span><span class="spaces"> </span><span class="nottickedoff">[] -> error "weird triangulation"</span>
|
||||
<span class="lineno"> 236 </span><span class="spaces"> </span><span class="nottickedoff">-- [] -> Dual (0,1,V.length t-1) EmptyDual (dualTree t (1, (V.length t-1)) 0)</span>
|
||||
<span class="lineno"> 237 </span><span class="spaces"> </span><span class="nottickedoff">(x:_) -> Dual (root,rootNext,x) (dualTree t (x,root) rootNext) (dualTree t (rootNext,x) root)</span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="nottickedoff">rootNext = idx (root+1)</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="nottickedoff">rootPrev = idx (root-1)</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="nottickedoff">rootNNext = idx (root+2)</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="nottickedoff">idx i = i `mod` n</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="nottickedoff">hasTriangle = (rootPrev : t V.! root) `intersect` (rootNNext : t V.! rootNext)</span>
|
||||
<span class="lineno"> 244 </span><span class="spaces"> </span><span class="nottickedoff">n = V.length t</span></span>
|
||||
<span class="lineno"> 245 </span>
|
||||
<span class="lineno"> 246 </span>-- a=6, b=0, e=1
|
||||
<span class="lineno"> 247 </span>dualTree :: Triangulation -> (Int,Int) -> Int -> DualTree
|
||||
<span class="lineno"> 248 </span><span class="decl"><span class="nottickedoff">dualTree t (a,b) e = -- simplifyDual $</span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="nottickedoff">case hasTriangle of</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="nottickedoff">[] -> EmptyDual</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="nottickedoff">[(ab)] -></span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="nottickedoff">NodeDual ab</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="nottickedoff">(dualTree t (ab,b) a)</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="nottickedoff">(dualTree t (a,ab) b)</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="nottickedoff">_ -> error $ "Invalid triangulation: " ++ show (a,b,e,hasTriangle)</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="nottickedoff">hasTriangle = (prev a : next a : t V.! a) `intersect` (prev b : next b : t V.! b)</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="nottickedoff">\\ [e]</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="nottickedoff">n = V.length t</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="nottickedoff">next x = (x+1) `mod` n</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="nottickedoff">prev x = (x-1) `mod` n</span></span>
|
||||
<span class="lineno"> 262 </span>
|
||||
<span class="lineno"> 263 </span>-- data MinMax = MinMax Int Int | MinMaxEmpty deriving (Show)
|
||||
<span class="lineno"> 264 </span>-- instance Semigroup MinMax where
|
||||
<span class="lineno"> 265 </span>-- MinMaxEmpty <> b = b
|
||||
<span class="lineno"> 266 </span>-- a <> MinMaxEmpty = a
|
||||
<span class="lineno"> 267 </span>-- MinMax a b <> MinMax c d
|
||||
<span class="lineno"> 268 </span>-- = MinMax (min a c) (max b d)
|
||||
<span class="lineno"> 269 </span>-- -- = MinMax c b
|
||||
<span class="lineno"> 270 </span>-- instance Monoid MinMax where
|
||||
<span class="lineno"> 271 </span>-- mempty = MinMaxEmpty
|
||||
<span class="lineno"> 272 </span>--
|
||||
<span class="lineno"> 273 </span>-- instance F.Measured MinMax Int where
|
||||
<span class="lineno"> 274 </span>-- measure i = MinMax i i
|
||||
<span class="lineno"> 275 </span>
|
||||
<span class="lineno"> 276 </span>-- dualRoot :: Dual -> Int
|
||||
<span class="lineno"> 277 </span>-- dualRoot (Dual (a,_,_) _ _) = a
|
||||
<span class="lineno"> 278 </span>
|
||||
<span class="lineno"> 279 </span>-- O(n*ln n), could be O(n) if I could figure out how to use fingertrees...
|
||||
<span class="lineno"> 280 </span>sssp :: (Fractional a, Ord a, Epsilon a) => Ring a -> Dual -> SSSP
|
||||
<span class="lineno"> 281 </span><span class="decl"><span class="nottickedoff">sssp p d = toSSSP $</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="nottickedoff">case d of</span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="nottickedoff">Dual (a,b,c) l r -></span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="nottickedoff">(a, a) :</span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="nottickedoff">(b, a) :</span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="nottickedoff">(c, a) :</span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="nottickedoff">worker [c] [b] a r ++</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="nottickedoff">loopLeft a c l</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="nottickedoff">toSSSP edges =</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="nottickedoff">(V.fromList . map snd . sortOn fst) edges</span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="nottickedoff">loopLeft a outer l =</span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="nottickedoff">case l of</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="nottickedoff">EmptyDual -> []</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">NodeDual x l' r' -></span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="nottickedoff">(x,a) :</span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="nottickedoff">worker [x] [outer] a r' ++</span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="nottickedoff">loopLeft a x l'</span>
|
||||
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="nottickedoff">searchFn _checkStep _cusp _x [] = Nothing</span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="nottickedoff">searchFn checkStep cusp x (y:ys)</span>
|
||||
<span class="lineno"> 301 </span><span class="spaces"> </span><span class="nottickedoff">| not (checkStep (ringAccess p cusp) (ringAccess p y) (ringAccess p x))</span>
|
||||
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="nottickedoff">= Just $ helper [] y ys</span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = Nothing</span>
|
||||
<span class="lineno"> 304 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="nottickedoff">helper acc v [] = (v, [], reverse acc)</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="nottickedoff">helper acc v1 (v2:vs)</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">| checkStep (ringAccess p v1) (ringAccess p v2) (ringAccess p x) =</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="nottickedoff">(v1, v2:vs, reverse acc)</span>
|
||||
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = helper (v1:acc) v2 vs</span>
|
||||
<span class="lineno"> 310 </span><span class="spaces"> </span><span class="nottickedoff">searchRight = searchFn isLeftTurn</span>
|
||||
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="nottickedoff">searchLeft = searchFn isRightTurn</span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="nottickedoff">-- adj x = x -- ringClamp p (x-dualRoot d)</span>
|
||||
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="nottickedoff">-- optTrace msg =</span>
|
||||
<span class="lineno"> 314 </span><span class="spaces"> </span><span class="nottickedoff">-- if False -- dualRoot d == 1 || dualRoot d == 0</span>
|
||||
<span class="lineno"> 315 </span><span class="spaces"> </span><span class="nottickedoff">-- then trace msg</span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="nottickedoff">-- else id</span>
|
||||
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="nottickedoff">worker _ _ _ EmptyDual = []</span>
|
||||
<span class="lineno"> 318 </span><span class="spaces"> </span><span class="nottickedoff">worker f1 f2 cusp (NodeDual x l r) =</span>
|
||||
<span class="lineno"> 319 </span><span class="spaces"> </span><span class="nottickedoff">-- (optTrace ("Funnel: " ++ show</span>
|
||||
<span class="lineno"> 320 </span><span class="spaces"> </span><span class="nottickedoff">-- (map adj $ toList f1</span>
|
||||
<span class="lineno"> 321 </span><span class="spaces"> </span><span class="nottickedoff">-- ,adj cusp</span>
|
||||
<span class="lineno"> 322 </span><span class="spaces"> </span><span class="nottickedoff">-- ,map adj $ toList f2</span>
|
||||
<span class="lineno"> 323 </span><span class="spaces"> </span><span class="nottickedoff">-- ,adj x</span>
|
||||
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="nottickedoff">-- , dualRoot d))</span>
|
||||
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="nottickedoff">-- ) $</span>
|
||||
<span class="lineno"> 326 </span><span class="spaces"> </span><span class="nottickedoff">case searchLeft cusp x (toList f1) of</span>
|
||||
<span class="lineno"> 327 </span><span class="spaces"> </span><span class="nottickedoff">Just (v, f1Hi, f1Lo) -></span>
|
||||
<span class="lineno"> 328 </span><span class="spaces"> </span><span class="nottickedoff">-- optTrace (" Visble from left: " ++ show (adj x,adj v)) $</span>
|
||||
<span class="lineno"> 329 </span><span class="spaces"> </span><span class="nottickedoff">(x, v::Int) :</span>
|
||||
<span class="lineno"> 330 </span><span class="spaces"> </span><span class="nottickedoff">worker f1Hi [x] v l ++</span>
|
||||
<span class="lineno"> 331 </span><span class="spaces"> </span><span class="nottickedoff">worker (f1Lo ++ [v, x]) f2 cusp r</span>
|
||||
<span class="lineno"> 332 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -></span>
|
||||
<span class="lineno"> 333 </span><span class="spaces"> </span><span class="nottickedoff">case searchRight cusp x (toList f2) of</span>
|
||||
<span class="lineno"> 334 </span><span class="spaces"> </span><span class="nottickedoff">Just (v, f2Hi, f2Lo) -></span>
|
||||
<span class="lineno"> 335 </span><span class="spaces"> </span><span class="nottickedoff">-- optTrace (" Visble from right: " ++ show (adj x,adj v)) $</span>
|
||||
<span class="lineno"> 336 </span><span class="spaces"> </span><span class="nottickedoff">(x, v::Int) :</span>
|
||||
<span class="lineno"> 337 </span><span class="spaces"> </span><span class="nottickedoff">worker f1 (f2Lo ++ [v, x]) cusp l ++</span>
|
||||
<span class="lineno"> 338 </span><span class="spaces"> </span><span class="nottickedoff">worker [x] f2Hi v r</span>
|
||||
<span class="lineno"> 339 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -></span>
|
||||
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="nottickedoff">-- optTrace (" Visble from cusp: " ++ show (adj x,adj cusp)) $</span>
|
||||
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="nottickedoff">(x, cusp::Int) :</span>
|
||||
<span class="lineno"> 342 </span><span class="spaces"> </span><span class="nottickedoff">worker f1 [x] cusp l ++</span>
|
||||
<span class="lineno"> 343 </span><span class="spaces"> </span><span class="nottickedoff">worker [x] f2 cusp r</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
108
reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate.hs.html
Normal file
108
reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate.hs.html
Normal file
|
|
@ -0,0 +1,108 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE DataKinds #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE ScopedTypeVariables #-}
|
||||
<span class="lineno"> 3 </span>{-# OPTIONS_HADDOCK hide #-}
|
||||
<span class="lineno"> 4 </span>module Reanimate.Math.Triangulate
|
||||
<span class="lineno"> 5 </span> ( Triangulation
|
||||
<span class="lineno"> 6 </span> , edgesToTriangulation
|
||||
<span class="lineno"> 7 </span> , edgesToTriangulationM
|
||||
<span class="lineno"> 8 </span> , trianglesToTriangulation
|
||||
<span class="lineno"> 9 </span> , trianglesToTriangulationM
|
||||
<span class="lineno"> 10 </span> , triangulate
|
||||
<span class="lineno"> 11 </span> )
|
||||
<span class="lineno"> 12 </span>where
|
||||
<span class="lineno"> 13 </span>
|
||||
<span class="lineno"> 14 </span>import Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')
|
||||
<span class="lineno"> 15 </span>import Algorithms.Geometry.PolygonTriangulation.Types
|
||||
<span class="lineno"> 16 </span>import Control.Lens
|
||||
<span class="lineno"> 17 </span>import Control.Monad
|
||||
<span class="lineno"> 18 </span>import Control.Monad.ST
|
||||
<span class="lineno"> 19 </span>import Data.Ext
|
||||
<span class="lineno"> 20 </span>import Data.Geometry.PlanarSubdivision (PolygonFaceData)
|
||||
<span class="lineno"> 21 </span>import Data.Geometry.Point
|
||||
<span class="lineno"> 22 </span>import Data.Geometry.Polygon
|
||||
<span class="lineno"> 23 </span>import qualified Data.IntSet as ISet
|
||||
<span class="lineno"> 24 </span>import qualified Data.PlaneGraph as Geo
|
||||
<span class="lineno"> 25 </span>import Data.Proxy
|
||||
<span class="lineno"> 26 </span>import qualified Data.Vector as V
|
||||
<span class="lineno"> 27 </span>import qualified Data.Vector.Mutable as MV
|
||||
<span class="lineno"> 28 </span>import Linear.V2
|
||||
<span class="lineno"> 29 </span>import Reanimate.Math.Common
|
||||
<span class="lineno"> 30 </span>-- Max edges: n-2
|
||||
<span class="lineno"> 31 </span>-- Each edge is represented twice: 2n-4
|
||||
<span class="lineno"> 32 </span>-- Flat structure:
|
||||
<span class="lineno"> 33 </span>-- edges :: V.Vector Int -- max length (2n-4)
|
||||
<span class="lineno"> 34 </span>-- offsets :: V.Vector Int -- length n
|
||||
<span class="lineno"> 35 </span>-- Combine the two vectors? < n => offsets, >= n => edges?
|
||||
<span class="lineno"> 36 </span>type Triangulation = V.Vector [Int]
|
||||
<span class="lineno"> 37 </span>
|
||||
<span class="lineno"> 38 </span>-- FIXME: Move to Common or a Triangulation module
|
||||
<span class="lineno"> 39 </span>-- O(n)
|
||||
<span class="lineno"> 40 </span>edgesToTriangulation :: Int -> [(Int, Int)] -> Triangulation
|
||||
<span class="lineno"> 41 </span><span class="decl"><span class="nottickedoff">edgesToTriangulation size edges = runST $ do</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="nottickedoff">v <- edgesToTriangulationM size edges</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="nottickedoff">V.unsafeFreeze v</span></span>
|
||||
<span class="lineno"> 44 </span>
|
||||
<span class="lineno"> 45 </span>edgesToTriangulationM :: Int -> [(Int, Int)] -> ST s (V.MVector s [Int])
|
||||
<span class="lineno"> 46 </span><span class="decl"><span class="nottickedoff">edgesToTriangulationM size edges = do</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="nottickedoff">v <- MV.replicate size []</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">forM_ edges $ \(e1, e2) -> do</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">MV.modify v (e1 :) e2</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="nottickedoff">MV.modify v (e2 :) e1</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">forM_ [0 .. size - 1] $ \i -> MV.modify v (ISet.toList . ISet.fromList) i</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="nottickedoff">return v</span></span>
|
||||
<span class="lineno"> 53 </span>
|
||||
<span class="lineno"> 54 </span>trianglesToTriangulation :: Int -> V.Vector (Int, Int, Int) -> Triangulation
|
||||
<span class="lineno"> 55 </span><span class="decl"><span class="nottickedoff">trianglesToTriangulation size edges = runST $ do</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">v <- trianglesToTriangulationM size edges</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">V.unsafeFreeze v</span></span>
|
||||
<span class="lineno"> 58 </span>
|
||||
<span class="lineno"> 59 </span>trianglesToTriangulationM
|
||||
<span class="lineno"> 60 </span> :: Int -> V.Vector (Int, Int, Int) -> ST s (V.MVector s [Int])
|
||||
<span class="lineno"> 61 </span><span class="decl"><span class="nottickedoff">trianglesToTriangulationM size trigs = do</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">v <- MV.replicate size []</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="nottickedoff">forM_ (V.toList trigs) $ \(a, b, c) -> do</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="nottickedoff">MV.modify v (\x -> b : c : x) a</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="nottickedoff">MV.modify v (\x -> a : c : x) b</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="nottickedoff">MV.modify v (\x -> a : b : x) c</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">forM_ [0 .. size - 1] $ \i -> MV.modify v (ISet.toList . ISet.fromList) i</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">return v</span></span>
|
||||
<span class="lineno"> 69 </span>
|
||||
<span class="lineno"> 70 </span>
|
||||
<span class="lineno"> 71 </span>triangulate :: forall a. (Fractional a, Ord a) => Ring a -> Triangulation
|
||||
<span class="lineno"> 72 </span><span class="decl"><span class="nottickedoff">triangulate r = edgesToTriangulation (ringSize r) ds</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">ds :: [(Int,Int)]</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">ds =</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">[ (a^.Geo.vData, b^.Geo.vData)</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="nottickedoff">| (d, Diagonal) <- V.toList (Geo.edges pg)</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="nottickedoff">, let (a,b) = Geo.endPointData d pg ]</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="nottickedoff">pg :: Geo.PlaneGraph () Int PolygonEdgeType PolygonFaceData a</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="nottickedoff">pg = triangulate' Proxy p</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="nottickedoff">p :: SimplePolygon Int a</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="nottickedoff">p = fromPoints $</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="nottickedoff">[ Point2 x y :+ n</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="nottickedoff">| (n,V2 x y) <- zip [0..] (V.toList (ringUnpack r)) ]</span></span>
|
||||
<span class="lineno"> 85 </span> -- ringUnpack
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
131
reanimate-0.4.2.0-inplace/Reanimate.Misc.hs.html
Normal file
131
reanimate-0.4.2.0-inplace/Reanimate.Misc.hs.html
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>module Reanimate.Misc
|
||||
<span class="lineno"> 2 </span> ( requireExecutable
|
||||
<span class="lineno"> 3 </span> , runCmd
|
||||
<span class="lineno"> 4 </span> , runCmd_
|
||||
<span class="lineno"> 5 </span> , runCmdLazy
|
||||
<span class="lineno"> 6 </span> , withTempDir
|
||||
<span class="lineno"> 7 </span> , withTempFile
|
||||
<span class="lineno"> 8 </span> , renameOrCopyFile
|
||||
<span class="lineno"> 9 </span> ) where
|
||||
<span class="lineno"> 10 </span>
|
||||
<span class="lineno"> 11 </span>import Control.Concurrent
|
||||
<span class="lineno"> 12 </span>import Control.Exception (catch, evaluate, finally, throw)
|
||||
<span class="lineno"> 13 </span>import qualified Data.Text as T
|
||||
<span class="lineno"> 14 </span>import qualified Data.Text.IO as T
|
||||
<span class="lineno"> 15 </span>import Foreign.C.Error
|
||||
<span class="lineno"> 16 </span>import GHC.IO.Exception
|
||||
<span class="lineno"> 17 </span>import System.Directory (copyFile, findExecutable, removeFile,
|
||||
<span class="lineno"> 18 </span> renameFile)
|
||||
<span class="lineno"> 19 </span>import System.FilePath ((<.>))
|
||||
<span class="lineno"> 20 </span>import System.IO (hClose, hGetContents, hIsEOF, hPutStr,
|
||||
<span class="lineno"> 21 </span> stderr)
|
||||
<span class="lineno"> 22 </span>import System.IO.Temp (withSystemTempDirectory,
|
||||
<span class="lineno"> 23 </span> withSystemTempFile)
|
||||
<span class="lineno"> 24 </span>import System.Process (readProcessWithExitCode,
|
||||
<span class="lineno"> 25 </span> runInteractiveProcess, showCommandForUser,
|
||||
<span class="lineno"> 26 </span> terminateProcess, waitForProcess)
|
||||
<span class="lineno"> 27 </span>
|
||||
<span class="lineno"> 28 </span>
|
||||
<span class="lineno"> 29 </span>requireExecutable :: String -> IO FilePath
|
||||
<span class="lineno"> 30 </span><span class="decl"><span class="nottickedoff">requireExecutable exec = do</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">mbPath <- findExecutable exec</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="nottickedoff">case mbPath of</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> error $ "Couldn't find executable: " ++ exec</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="nottickedoff">Just path -> return path</span></span>
|
||||
<span class="lineno"> 35 </span>
|
||||
<span class="lineno"> 36 </span>runCmd :: FilePath -> [String] -> IO ()
|
||||
<span class="lineno"> 37 </span><span class="decl"><span class="nottickedoff">runCmd exec args = do</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">ret <- runCmd_ exec args</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">case ret of</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">Left err -> error $ showCommandForUser exec args ++ ":\n" ++ err</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">Right{} -> return ()</span></span>
|
||||
<span class="lineno"> 42 </span>
|
||||
<span class="lineno"> 43 </span>runCmd_ :: FilePath -> [String] -> IO (Either String String)
|
||||
<span class="lineno"> 44 </span><span class="decl"><span class="nottickedoff">runCmd_ exec args = do</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="nottickedoff">(ret, stdout, errMsg) <- readProcessWithExitCode exec args ""</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="nottickedoff">_ <- evaluate (length stdout + length errMsg)</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="nottickedoff">case ret of</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">ExitSuccess -> return (Right stdout)</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">ExitFailure err | False -></span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="nottickedoff">return</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">$ Left</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="nottickedoff">$ "Failed to run: "</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="nottickedoff">++ showCommandForUser exec args</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="nottickedoff">++ "\n"</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">++ "Error code: "</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">++ show err</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">++ "\n"</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">++ "stderr: "</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">++ errMsg</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">ExitFailure{} | null errMsg -> -- LaTeX prints errors to stdout. :(</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">return $ Left stdout</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">ExitFailure{} -> return $ Left errMsg</span></span>
|
||||
<span class="lineno"> 63 </span>
|
||||
<span class="lineno"> 64 </span>runCmdLazy
|
||||
<span class="lineno"> 65 </span> :: FilePath -> [String] -> (IO (Either String T.Text) -> IO a) -> IO a
|
||||
<span class="lineno"> 66 </span><span class="decl"><span class="nottickedoff">runCmdLazy exec args handler = do</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">(inp, out, err, pid) <- runInteractiveProcess exec args Nothing Nothing</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">hClose inp</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">errOutput <- hGetContents err</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">_ <- forkIO $ hPutStr stderr errOutput</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">let fetch = do</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">eof <- hIsEOF out</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">if eof</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">then do</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">_ <- evaluate (length errOutput)</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">ret <- waitForProcess pid</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="nottickedoff">case ret of</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="nottickedoff">ExitSuccess -> return (Left "")</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="nottickedoff">ExitFailure{} -> return (Left errOutput)</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="nottickedoff">{-ExitFailure errMsg -> do</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="nottickedoff">return $ Left $</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="nottickedoff">"Failed to run: " ++ showCommandForUser exec args ++ "\n" ++</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="nottickedoff">"Error code: " ++ show errMsg ++ "\n" ++</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="nottickedoff">"stderr: " ++ stderr-}</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="nottickedoff">else do</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="nottickedoff">line <- T.hGetLine out</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="nottickedoff">return (Right line)</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="nottickedoff">handler fetch `finally` do</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="nottickedoff">terminateProcess pid</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="nottickedoff">_ <- waitForProcess pid</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="nottickedoff">return ()</span></span>
|
||||
<span class="lineno"> 92 </span>
|
||||
<span class="lineno"> 93 </span>-- renameFile fails if we're crossing filesystem boundaries. If this happens,
|
||||
<span class="lineno"> 94 </span>-- revert back to copyFile + removeFile.
|
||||
<span class="lineno"> 95 </span>renameOrCopyFile :: FilePath -> FilePath -> IO ()
|
||||
<span class="lineno"> 96 </span><span class="decl"><span class="nottickedoff">renameOrCopyFile src dst = renameFile src dst `catch` exdev</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">exdev e = if fmap Errno (ioe_errno e) == Just eXDEV</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="nottickedoff">then copyFile src dst >> removeFile src</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="nottickedoff">else throw e</span></span>
|
||||
<span class="lineno"> 101 </span>
|
||||
<span class="lineno"> 102 </span>withTempDir :: (FilePath -> IO a) -> IO a
|
||||
<span class="lineno"> 103 </span><span class="decl"><span class="nottickedoff">withTempDir = withSystemTempDirectory "reanimate"</span></span>
|
||||
<span class="lineno"> 104 </span>
|
||||
<span class="lineno"> 105 </span>withTempFile :: String -> (FilePath -> IO a) -> IO a
|
||||
<span class="lineno"> 106 </span><span class="decl"><span class="nottickedoff">withTempFile ext action =</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="nottickedoff">withSystemTempFile ("reanimate" <.> ext) $ \path hd -></span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">hClose hd >> action path</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
66
reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache.hs.html
Normal file
66
reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache.hs.html
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>module Reanimate.Morph.Cache
|
||||
<span class="lineno"> 2 </span> ( cachePointCorrespondence -- :: Int -> PointCorrespondence -> PointCorrespondence
|
||||
<span class="lineno"> 3 </span> ) where
|
||||
<span class="lineno"> 4 </span>
|
||||
<span class="lineno"> 5 </span>import Control.Exception
|
||||
<span class="lineno"> 6 </span>import qualified Data.ByteString as B
|
||||
<span class="lineno"> 7 </span>import Data.Hashable
|
||||
<span class="lineno"> 8 </span>import Data.Serialize
|
||||
<span class="lineno"> 9 </span>import Reanimate.Cache (encodeInt)
|
||||
<span class="lineno"> 10 </span>import Reanimate.Misc (renameOrCopyFile)
|
||||
<span class="lineno"> 11 </span>import Reanimate.Morph.Common
|
||||
<span class="lineno"> 12 </span>import System.Directory
|
||||
<span class="lineno"> 13 </span>import System.FilePath
|
||||
<span class="lineno"> 14 </span>import System.IO
|
||||
<span class="lineno"> 15 </span>import System.IO.Temp
|
||||
<span class="lineno"> 16 </span>import System.IO.Unsafe
|
||||
<span class="lineno"> 17 </span>
|
||||
<span class="lineno"> 18 </span>-- type PointCorrespondence = Polygon → Polygon → (Polygon, Polygon)
|
||||
<span class="lineno"> 19 </span>cachePointCorrespondence :: Int -> PointCorrespondence -> PointCorrespondence
|
||||
<span class="lineno"> 20 </span><span class="decl"><span class="nottickedoff">cachePointCorrespondence ident fn src dst = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 21 </span><span class="spaces"> </span><span class="nottickedoff">root <- getXdgDirectory XdgCache "reanimate"</span>
|
||||
<span class="lineno"> 22 </span><span class="spaces"> </span><span class="nottickedoff">createDirectoryIfMissing True root</span>
|
||||
<span class="lineno"> 23 </span><span class="spaces"> </span><span class="nottickedoff">let path = root </> template</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="nottickedoff">hit <- doesFileExist path</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="nottickedoff">if hit</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="nottickedoff">then do</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="nottickedoff">inp <- B.readFile path</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="nottickedoff">case decode inp of</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="nottickedoff">Left{} -> do</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="nottickedoff">removeFile path</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">gen path</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="nottickedoff">Right out -> return out</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="nottickedoff">else gen path</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="nottickedoff">gen path = do</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">correspondence <- evaluate (fn src dst)</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="nottickedoff">withSystemTempFile template $ \tmp h -> do</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">hClose h</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">B.writeFile tmp (encode correspondence)</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">renameOrCopyFile tmp path</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">return correspondence</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="nottickedoff">template = encodeInt key <.> "morph"</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="nottickedoff">key = hashWithSalt ident (src,dst)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
241
reanimate-0.4.2.0-inplace/Reanimate.Morph.Common.hs.html
Normal file
241
reanimate-0.4.2.0-inplace/Reanimate.Morph.Common.hs.html
Normal file
|
|
@ -0,0 +1,241 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE RecordWildCards #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE TupleSections #-}
|
||||
<span class="lineno"> 3 </span>{-# LANGUAGE UnicodeSyntax #-}
|
||||
<span class="lineno"> 4 </span>{-|
|
||||
<span class="lineno"> 5 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 6 </span>License : Unlicense
|
||||
<span class="lineno"> 7 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 8 </span>Stability : experimental
|
||||
<span class="lineno"> 9 </span>Portability : POSIX
|
||||
<span class="lineno"> 10 </span>-}
|
||||
<span class="lineno"> 11 </span>module Reanimate.Morph.Common
|
||||
<span class="lineno"> 12 </span> ( PointCorrespondence
|
||||
<span class="lineno"> 13 </span> , Trajectory
|
||||
<span class="lineno"> 14 </span> , ObjectCorrespondence
|
||||
<span class="lineno"> 15 </span> , Morph(..)
|
||||
<span class="lineno"> 16 </span> , morph
|
||||
<span class="lineno"> 17 </span> , splitObjectCorrespondence
|
||||
<span class="lineno"> 18 </span> , dupObjectCorrespondence
|
||||
<span class="lineno"> 19 </span> , genesisObjectCorrespondence
|
||||
<span class="lineno"> 20 </span> , toShapes
|
||||
<span class="lineno"> 21 </span> , normalizePolygons
|
||||
<span class="lineno"> 22 </span> , annotatePolygons
|
||||
<span class="lineno"> 23 </span> , unsafeSVGToPolygon
|
||||
<span class="lineno"> 24 </span> ) where
|
||||
<span class="lineno"> 25 </span>
|
||||
<span class="lineno"> 26 </span>import Control.Lens
|
||||
<span class="lineno"> 27 </span>import qualified Data.Vector as V
|
||||
<span class="lineno"> 28 </span>import Graphics.SvgTree (DrawAttributes, Texture (..),
|
||||
<span class="lineno"> 29 </span> drawAttributes, fillColor,
|
||||
<span class="lineno"> 30 </span> fillOpacity, groupOpacity,
|
||||
<span class="lineno"> 31 </span> strokeColor, strokeOpacity)
|
||||
<span class="lineno"> 32 </span>import Linear.V2
|
||||
<span class="lineno"> 33 </span>import Reanimate.Animation
|
||||
<span class="lineno"> 34 </span>import Reanimate.ColorComponents
|
||||
<span class="lineno"> 35 </span>import Reanimate.Ease
|
||||
<span class="lineno"> 36 </span>import Reanimate.Math.Polygon (APolygon, Epsilon, Polygon,
|
||||
<span class="lineno"> 37 </span> mkPolygon, pAddPoints, pCentroid,
|
||||
<span class="lineno"> 38 </span> pCutEqual, pSize, polygonPoints)
|
||||
<span class="lineno"> 39 </span>import Reanimate.PolyShape
|
||||
<span class="lineno"> 40 </span>import Reanimate.Svg
|
||||
<span class="lineno"> 41 </span>
|
||||
<span class="lineno"> 42 </span>-- import Debug.Trace
|
||||
<span class="lineno"> 43 </span>
|
||||
<span class="lineno"> 44 </span>-- Correspondence
|
||||
<span class="lineno"> 45 </span>-- Trajectory
|
||||
<span class="lineno"> 46 </span>-- Color interpolation
|
||||
<span class="lineno"> 47 </span>-- Polygon holes
|
||||
<span class="lineno"> 48 </span>-- Polygon splitting
|
||||
<span class="lineno"> 49 </span>
|
||||
<span class="lineno"> 50 </span>-- Graphical polygon? FIXME: Come up with a better name.
|
||||
<span class="lineno"> 51 </span>type GPolygon = (DrawAttributes, Polygon)
|
||||
<span class="lineno"> 52 </span>
|
||||
<span class="lineno"> 53 </span>-- | Method determining how points in the source polygon align with
|
||||
<span class="lineno"> 54 </span>-- points in the target polygon.
|
||||
<span class="lineno"> 55 </span>type PointCorrespondence = Polygon → Polygon → (Polygon, Polygon)
|
||||
<span class="lineno"> 56 </span>
|
||||
<span class="lineno"> 57 </span>-- | Method for interpolating between two aligned polygons.
|
||||
<span class="lineno"> 58 </span>type Trajectory = (Polygon, Polygon) → (Double → Polygon)
|
||||
<span class="lineno"> 59 </span>
|
||||
<span class="lineno"> 60 </span>-- | Method for pairing sets of polygons.
|
||||
<span class="lineno"> 61 </span>type ObjectCorrespondence = [GPolygon] → [GPolygon] → [(GPolygon, GPolygon)]
|
||||
<span class="lineno"> 62 </span>
|
||||
<span class="lineno"> 63 </span>-- | Morphing strategy
|
||||
<span class="lineno"> 64 </span>data Morph = Morph
|
||||
<span class="lineno"> 65 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">morphTolerance</span></span></span> :: Double
|
||||
<span class="lineno"> 66 </span> -- ^ Morphing curves is not always possible and
|
||||
<span class="lineno"> 67 </span> -- sometimes shapes are reduced to polygons or meta-curves.
|
||||
<span class="lineno"> 68 </span> -- This parameter determined the accuracy of this transformation.
|
||||
<span class="lineno"> 69 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">morphColorComponents</span></span></span> :: ColorComponents
|
||||
<span class="lineno"> 70 </span> -- ^ Color components used for color interpolation. LAB is usually
|
||||
<span class="lineno"> 71 </span> -- the best option here.
|
||||
<span class="lineno"> 72 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">morphPointCorrespondence</span></span></span> :: PointCorrespondence
|
||||
<span class="lineno"> 73 </span> -- ^ Desired point-correspondence algorithm.
|
||||
<span class="lineno"> 74 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">morphTrajectory</span></span></span> :: Trajectory
|
||||
<span class="lineno"> 75 </span> -- ^ Desired interpolation algorithm.
|
||||
<span class="lineno"> 76 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">morphObjectCorrespondence</span></span></span> :: ObjectCorrespondence
|
||||
<span class="lineno"> 77 </span> -- ^ Desired object-correspondence algorithm.
|
||||
<span class="lineno"> 78 </span> }
|
||||
<span class="lineno"> 79 </span>
|
||||
<span class="lineno"> 80 </span>{-# INLINE morph #-}
|
||||
<span class="lineno"> 81 </span>-- | Apply morphing strategy to interpolate between two SVG images.
|
||||
<span class="lineno"> 82 </span>morph :: Morph -> SVG -> SVG -> Double -> SVG
|
||||
<span class="lineno"> 83 </span><span class="decl"><span class="istickedoff">morph Morph{..} src dst = \t -></span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">case <span class="nottickedoff">t</span> of</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">-- 0 -> lowerTransformations src</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">-- 1 -> lowerTransformations dst</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">_ -> mkGroup</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">[ render (genPoints t)</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ genAttrs <span class="nottickedoff">t</span></span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff">| (genAttrs, genPoints) <- gens</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff">]</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">render p = mkLinePathClosed</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">[ (x,y) | V2 x y <- map (fmap realToFrac) $ V.toList $ polygonPoints p ]</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">srcShapes = toShapes morphTolerance src</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">dstShapes = toShapes morphTolerance dst</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">pairs = morphObjectCorrespondence srcShapes dstShapes</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">gens =</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff">[ (interpolateAttrs <span class="nottickedoff">morphColorComponents</span> srcAttr <span class="nottickedoff">dstAttr</span>, morphTrajectory arranged)</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="istickedoff">| ((srcAttr, srcPoly'), (dstAttr, dstPoly')) <- pairs</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="istickedoff">, let arranged = morphPointCorrespondence srcPoly' dstPoly'</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="istickedoff">]</span></span>
|
||||
<span class="lineno"> 103 </span>
|
||||
<span class="lineno"> 104 </span>-- | Add points to each polygon such that they end up with same size.
|
||||
<span class="lineno"> 105 </span>normalizePolygons :: (Real a, Fractional a, Epsilon a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
|
||||
<span class="lineno"> 106 </span><span class="decl"><span class="istickedoff">normalizePolygons src dst =</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="istickedoff">(pAddPoints (max 0 $ dstN-srcN) src</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="istickedoff">,pAddPoints (max 0 $ srcN-dstN) dst)</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff">srcN = pSize src</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">dstN = pSize dst</span></span>
|
||||
<span class="lineno"> 112 </span>
|
||||
<span class="lineno"> 113 </span>interpolateAttrs :: ColorComponents -> DrawAttributes -> DrawAttributes -> Double -> DrawAttributes
|
||||
<span class="lineno"> 114 </span><span class="decl"><span class="istickedoff">interpolateAttrs colorComps src dst t =</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">src & fillColor .~ (<span class="nottickedoff">interpColor</span> <$> src^.fillColor <*> <span class="nottickedoff">dst^.fillColor</span>)</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">& strokeColor .~ (<span class="nottickedoff">interpColor</span> <$> src^.strokeColor <*> <span class="nottickedoff">dst^.strokeColor</span>)</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">& fillOpacity .~ (<span class="nottickedoff">interpOpacity</span> <$> src^.fillOpacity <*> <span class="nottickedoff">dst^.fillOpacity</span>)</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">& groupOpacity .~ (<span class="nottickedoff">interpOpacity</span> <$> src^.groupOpacity <*> <span class="nottickedoff">dst^.groupOpacity</span>)</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">& strokeOpacity .~ (<span class="nottickedoff">interpOpacity</span> <$> src^.strokeOpacity <*> <span class="nottickedoff">dst^.strokeOpacity</span>)</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">interpColor (ColorRef a) (ColorRef b) =</span></span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">ColorRef $ interpolateRGBA8 colorComps a b t</span></span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- interpolateColor (ColorRef a) FillNone = ColorRef a</span></span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">interpColor a _ = a</span></span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">interpOpacity a b = realToFrac (fromToS (realToFrac a) (realToFrac b) t)</span></span></span>
|
||||
<span class="lineno"> 126 </span>
|
||||
<span class="lineno"> 127 </span>-- | Object-correspondence algorithm that spawn objects as necessary.
|
||||
<span class="lineno"> 128 </span>genesisObjectCorrespondence :: ObjectCorrespondence
|
||||
<span class="lineno"> 129 </span><span class="decl"><span class="nottickedoff">genesisObjectCorrespondence left right =</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">case (left, right) of</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">([] , []) -> []</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">([], (y1,y2):ys) -></span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">((y1,y2), (y1, emptyFrom y2 y2)) : genesisObjectCorrespondence [] ys</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff">((x1,x2):xs, []) -></span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">((x1,x2), (x1, emptyFrom x2 x2)) : genesisObjectCorrespondence xs []</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">(x:xs, y:ys) -></span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">(x,y) : genesisObjectCorrespondence xs ys</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">emptyFrom a b = mkPolygon $ V.map (const $ pCentroid a) (polygonPoints b)</span></span>
|
||||
<span class="lineno"> 140 </span>
|
||||
<span class="lineno"> 141 </span>-- | Object-correspondence algorithm that duplicate objects as necessary.
|
||||
<span class="lineno"> 142 </span>dupObjectCorrespondence :: ObjectCorrespondence
|
||||
<span class="lineno"> 143 </span><span class="decl"><span class="nottickedoff">dupObjectCorrespondence left right =</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">case (left, right) of</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="nottickedoff">(_, []) -> []</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="nottickedoff">([], _) -> []</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="nottickedoff">([x], [y]) -></span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="nottickedoff">[(x,y)]</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">([(x1,x2)], yShapes) -></span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">let x2s = replicate (length yShapes) x2</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">in dupObjectCorrespondence (map (x1,) x2s) yShapes</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">(xShapes, [(y1,y2)]) -></span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">let y2s = replicate (length xShapes) y2</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">in dupObjectCorrespondence xShapes (map (y1,) y2s)</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">(x:xs, y:ys) -></span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">(x, y) : dupObjectCorrespondence xs ys</span></span>
|
||||
<span class="lineno"> 157 </span>
|
||||
<span class="lineno"> 158 </span>-- | Object-correspondence algorithm that splits objects in smaller pieces
|
||||
<span class="lineno"> 159 </span>-- as necessary.
|
||||
<span class="lineno"> 160 </span>splitObjectCorrespondence :: ObjectCorrespondence
|
||||
<span class="lineno"> 161 </span>-- splitObjectCorrespondence = dupObjectCorrespondence
|
||||
<span class="lineno"> 162 </span><span class="decl"><span class="istickedoff">splitObjectCorrespondence left right =</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="istickedoff">case (left, right) of</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="istickedoff">(_, []) -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="istickedoff">([], _) -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="istickedoff">([x], [y]) -></span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff">[(x,y)]</span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="istickedoff">([(x1,x2)], yShapes) -></span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let x2s = splitPolygon (length yShapes) x2</span></span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in splitObjectCorrespondence (map (x1,) x2s) yShapes</span></span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="istickedoff">(xShapes, [(y1,y2)]) -></span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let y2s = splitPolygon (length xShapes) y2</span></span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in splitObjectCorrespondence xShapes (map (y1,) y2s)</span></span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="istickedoff">(x:xs, y:ys) -></span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(x,y) : splitObjectCorrespondence xs ys</span></span></span>
|
||||
<span class="lineno"> 176 </span>
|
||||
<span class="lineno"> 177 </span>splitPolygon :: Int -> Polygon -> [Polygon]
|
||||
<span class="lineno"> 178 </span><span class="decl"><span class="nottickedoff">splitPolygon 1 p = [p]</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"></span><span class="nottickedoff">splitPolygon n p =</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">let (a,b) = pCutEqual p</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">in splitPolygon (n`div`2) a ++ splitPolygon ((n+1)`div`2) b</span></span>
|
||||
<span class="lineno"> 182 </span>
|
||||
<span class="lineno"> 183 </span>-- joinPairs :: Correspondence -> [(DrawAttributes, PolyShape)] -> [(DrawAttributes, PolyShape)]
|
||||
<span class="lineno"> 184 </span>-- -> [(DrawAttributes, DrawAttributes, [(RPoint, RPoint)])]
|
||||
<span class="lineno"> 185 </span>-- joinPairs _ _ [] = []
|
||||
<span class="lineno"> 186 </span>-- joinPairs _ [] _ = []
|
||||
<span class="lineno"> 187 </span>-- joinPairs corr [(x1,x2)] [(y1,y2)] =
|
||||
<span class="lineno"> 188 </span>-- [(x1,y1, corr x2 y2)]
|
||||
<span class="lineno"> 189 </span>-- joinPairs corr [(x1,x2)] yShapes =
|
||||
<span class="lineno"> 190 </span>-- let x2s = splitPolyShape 0.001 (length yShapes) x2
|
||||
<span class="lineno"> 191 </span>-- in joinPairs corr (map (x1,) x2s) yShapes
|
||||
<span class="lineno"> 192 </span>-- joinPairs corr xShapes [(y1,y2)] =
|
||||
<span class="lineno"> 193 </span>-- let y2s = reverse $ splitPolyShape 0.001 (length xShapes) y2
|
||||
<span class="lineno"> 194 </span>-- in joinPairs corr xShapes (map (y1,) y2s)
|
||||
<span class="lineno"> 195 </span>-- joinPairs corr ((x1,x2):xs) ((y1,y2):ys) =
|
||||
<span class="lineno"> 196 </span>-- (x1,y1, corr x2 y2) : joinPairs corr xs ys
|
||||
<span class="lineno"> 197 </span>-- joinPairs _ _ _ = []
|
||||
<span class="lineno"> 198 </span>
|
||||
<span class="lineno"> 199 </span>-- FIXME: sort by size, smallest to largest
|
||||
<span class="lineno"> 200 </span>-- | Extract shapes and their graphical attributes from an SVG node.
|
||||
<span class="lineno"> 201 </span>toShapes :: Double -> SVG -> [(DrawAttributes, Polygon)]
|
||||
<span class="lineno"> 202 </span><span class="decl"><span class="istickedoff">toShapes tol src =</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">[ (attrs, plToPolygon tol shape)</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="istickedoff">| (_, attrs, glyph) <- svgGlyphs $ lowerTransformations $ pathify src</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff">, shape <- map mergePolyShapeHoles $ plGroupShapes $ svgToPolyShapes glyph</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="istickedoff">]</span></span>
|
||||
<span class="lineno"> 207 </span>
|
||||
<span class="lineno"> 208 </span>-- | Extract the first polygon in an SVG node. Will fail if there
|
||||
<span class="lineno"> 209 </span>-- are no acceptable shapes.
|
||||
<span class="lineno"> 210 </span>unsafeSVGToPolygon :: Double -> SVG -> Polygon
|
||||
<span class="lineno"> 211 </span><span class="decl"><span class="nottickedoff">unsafeSVGToPolygon tol src = snd $ head $ toShapes tol src</span></span>
|
||||
<span class="lineno"> 212 </span>
|
||||
<span class="lineno"> 213 </span>-- | Map over each polygon in an SVG node.
|
||||
<span class="lineno"> 214 </span>annotatePolygons :: (Polygon -> SVG) -> SVG -> SVG
|
||||
<span class="lineno"> 215 </span><span class="decl"><span class="nottickedoff">annotatePolygons fn svg = mkGroup</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="nottickedoff">[ fn poly & drawAttributes .~ attr</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">| (attr, poly) <- toShapes 0.001 svg</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
114
reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear.hs.html
Normal file
114
reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear.hs.html
Normal file
|
|
@ -0,0 +1,114 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 3 </span>License : Unlicense
|
||||
<span class="lineno"> 4 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 5 </span>Stability : experimental
|
||||
<span class="lineno"> 6 </span>Portability : POSIX
|
||||
<span class="lineno"> 7 </span>-}
|
||||
<span class="lineno"> 8 </span>module Reanimate.Morph.Linear
|
||||
<span class="lineno"> 9 </span> ( linear, rawLinear
|
||||
<span class="lineno"> 10 </span> , closestLinearCorrespondence
|
||||
<span class="lineno"> 11 </span> , closestLinearCorrespondenceA
|
||||
<span class="lineno"> 12 </span> , linearTrajectory
|
||||
<span class="lineno"> 13 </span> ) where
|
||||
<span class="lineno"> 14 </span>
|
||||
<span class="lineno"> 15 </span>import Data.Hashable
|
||||
<span class="lineno"> 16 </span>import qualified Data.Vector as V
|
||||
<span class="lineno"> 17 </span>import Linear.Vector
|
||||
<span class="lineno"> 18 </span>import Reanimate.ColorComponents
|
||||
<span class="lineno"> 19 </span>import Reanimate.Math.Common
|
||||
<span class="lineno"> 20 </span>import Reanimate.Math.Polygon
|
||||
<span class="lineno"> 21 </span>import Reanimate.Morph.Cache
|
||||
<span class="lineno"> 22 </span>import Reanimate.Morph.Common
|
||||
<span class="lineno"> 23 </span>
|
||||
<span class="lineno"> 24 </span>-- | Linear interpolation strategy.
|
||||
<span class="lineno"> 25 </span>--
|
||||
<span class="lineno"> 26 </span>-- Example:
|
||||
<span class="lineno"> 27 </span>--
|
||||
<span class="lineno"> 28 </span>-- > playThenReverseA $ pauseAround 0.5 0.5 $ mkAnimation 3 $ \t ->
|
||||
<span class="lineno"> 29 </span>-- > withStrokeLineJoin JoinRound $
|
||||
<span class="lineno"> 30 </span>-- > let src = scale 8 $ center $ latex "X"
|
||||
<span class="lineno"> 31 </span>-- > dst = scale 8 $ center $ latex "H"
|
||||
<span class="lineno"> 32 </span>-- > in morph linear src dst t
|
||||
<span class="lineno"> 33 </span>--
|
||||
<span class="lineno"> 34 </span>-- <<docs/gifs/doc_linear.gif>>
|
||||
<span class="lineno"> 35 </span>linear :: Morph
|
||||
<span class="lineno"> 36 </span><span class="decl"><span class="nottickedoff">linear = rawLinear</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="nottickedoff">{ morphPointCorrespondence =</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">cachePointCorrespondence (hash ("closest"::String))</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">closestLinearCorrespondence }</span></span>
|
||||
<span class="lineno"> 40 </span>
|
||||
<span class="lineno"> 41 </span>-- | Linear interpolation strategy without realigning corners.
|
||||
<span class="lineno"> 42 </span>-- May give better results if the polygons are already aligned.
|
||||
<span class="lineno"> 43 </span>-- Usually gives worse results.
|
||||
<span class="lineno"> 44 </span>--
|
||||
<span class="lineno"> 45 </span>-- Example:
|
||||
<span class="lineno"> 46 </span>--
|
||||
<span class="lineno"> 47 </span>-- > playThenReverseA $ pauseAround 0.5 0.5 $ mkAnimation 3 $ \t ->
|
||||
<span class="lineno"> 48 </span>-- > withStrokeLineJoin JoinRound $
|
||||
<span class="lineno"> 49 </span>-- > let src = scale 8 $ center $ latex "X"
|
||||
<span class="lineno"> 50 </span>-- > dst = scale 8 $ center $ latex "H"
|
||||
<span class="lineno"> 51 </span>-- > in morph rawLinear src dst t
|
||||
<span class="lineno"> 52 </span>--
|
||||
<span class="lineno"> 53 </span>-- <<docs/gifs/doc_rawLinear.gif>>
|
||||
<span class="lineno"> 54 </span>rawLinear :: Morph
|
||||
<span class="lineno"> 55 </span><span class="decl"><span class="istickedoff">rawLinear = Morph</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">{ morphTolerance = 0.001</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">, morphColorComponents = <span class="nottickedoff">labComponents</span></span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">, morphPointCorrespondence = normalizePolygons</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">, morphTrajectory = linearTrajectory</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">, morphObjectCorrespondence = splitObjectCorrespondence }</span></span>
|
||||
<span class="lineno"> 61 </span>
|
||||
<span class="lineno"> 62 </span>-- | Cycle polygons until the sum of the point trajectory path lengths
|
||||
<span class="lineno"> 63 </span>-- is smallest.
|
||||
<span class="lineno"> 64 </span>closestLinearCorrespondence :: PointCorrespondence
|
||||
<span class="lineno"> 65 </span><span class="decl"><span class="nottickedoff">closestLinearCorrespondence = closestLinearCorrespondenceA</span></span>
|
||||
<span class="lineno"> 66 </span>
|
||||
<span class="lineno"> 67 </span>-- | Cycle polygons until the sum of the point trajectory path lengths
|
||||
<span class="lineno"> 68 </span>-- is smallest.
|
||||
<span class="lineno"> 69 </span>closestLinearCorrespondenceA :: (Real a, Fractional a, Epsilon a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
|
||||
<span class="lineno"> 70 </span><span class="decl"><span class="nottickedoff">closestLinearCorrespondenceA src' dst' =</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">(src, worker dst (score dst) options)</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">(src, dst) = normalizePolygons src' dst'</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">worker bestP _bestPScore [] = bestP</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">worker bestP bestPScore (x:xs) =</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">let newScore = score x in</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="nottickedoff">if newScore < bestPScore</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="nottickedoff">then worker x newScore xs</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="nottickedoff">else worker bestP bestPScore xs</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="nottickedoff">options = pCycles dst</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="nottickedoff">score p = sum</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="nottickedoff">[ -- approxDist (pAccess src n) (pAccess p n)</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="nottickedoff">distSquared (pAccess src n) (pAccess p n)</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="nottickedoff">| n <- [0 .. pSize src-1] ]</span></span>
|
||||
<span class="lineno"> 85 </span>
|
||||
<span class="lineno"> 86 </span>-- | Strategy for moving points in a linear (straight-line) trajectory.
|
||||
<span class="lineno"> 87 </span>linearTrajectory :: Trajectory
|
||||
<span class="lineno"> 88 </span><span class="decl"><span class="istickedoff">linearTrajectory (src,dst)</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">pSize src == pSize dst</span> = \t -> mkPolygon $</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff">V.zipWith (lerp $ realToFrac t) (polygonPoints dst) (polygonPoints src)</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">error $ "Invalid lengths: " ++ show (pSize src, pSize dst)</span></span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
145
reanimate-0.4.2.0-inplace/Reanimate.Parameters.hs.html
Normal file
145
reanimate-0.4.2.0-inplace/Reanimate.Parameters.hs.html
Normal file
|
|
@ -0,0 +1,145 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{- |
|
||||
<span class="lineno"> 2 </span> Parameters define the global context of an animation. They are set once
|
||||
<span class="lineno"> 3 </span> before an animation is rendered and may not change during rendering.
|
||||
<span class="lineno"> 4 </span>-}
|
||||
<span class="lineno"> 5 </span>module Reanimate.Parameters
|
||||
<span class="lineno"> 6 </span> ( Raster(..)
|
||||
<span class="lineno"> 7 </span> , Width
|
||||
<span class="lineno"> 8 </span> , Height
|
||||
<span class="lineno"> 9 </span> , FPS
|
||||
<span class="lineno"> 10 </span> , pRaster
|
||||
<span class="lineno"> 11 </span> , pFPS
|
||||
<span class="lineno"> 12 </span> , pWidth
|
||||
<span class="lineno"> 13 </span> , pHeight
|
||||
<span class="lineno"> 14 </span> , pNoExternals
|
||||
<span class="lineno"> 15 </span> , pRootDirectory
|
||||
<span class="lineno"> 16 </span> , setRaster
|
||||
<span class="lineno"> 17 </span> , setFPS
|
||||
<span class="lineno"> 18 </span> , setWidth
|
||||
<span class="lineno"> 19 </span> , setHeight
|
||||
<span class="lineno"> 20 </span> , setNoExternals
|
||||
<span class="lineno"> 21 </span> , setRootDirectory
|
||||
<span class="lineno"> 22 </span> ) where
|
||||
<span class="lineno"> 23 </span>
|
||||
<span class="lineno"> 24 </span>import System.IO.Unsafe
|
||||
<span class="lineno"> 25 </span>import Data.IORef
|
||||
<span class="lineno"> 26 </span>
|
||||
<span class="lineno"> 27 </span>-- | Width of animation in pixels.
|
||||
<span class="lineno"> 28 </span>type Width = Int
|
||||
<span class="lineno"> 29 </span>-- | Height of animation in pixels.
|
||||
<span class="lineno"> 30 </span>type Height = Int
|
||||
<span class="lineno"> 31 </span>-- | Framerate of animation in frames per second.
|
||||
<span class="lineno"> 32 </span>type FPS = Int
|
||||
<span class="lineno"> 33 </span>
|
||||
<span class="lineno"> 34 </span>-- | Raster engines turn SVG images into pixels.
|
||||
<span class="lineno"> 35 </span>data Raster
|
||||
<span class="lineno"> 36 </span> = RasterNone -- ^ Do not use any external raster engine. Rely on the browser or ffmpeg.
|
||||
<span class="lineno"> 37 </span> | RasterAuto -- ^ Scan for installed raster engines and pick the fastest one.
|
||||
<span class="lineno"> 38 </span> | RasterInkscape -- ^ Use Inkscape to raster SVG images.
|
||||
<span class="lineno"> 39 </span> | RasterRSvg -- ^ Use rsvg-convert to raster SVG images.
|
||||
<span class="lineno"> 40 </span> | RasterMagick -- ^ Use imagemagick to raster SVG images.
|
||||
<span class="lineno"> 41 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
|
||||
<span class="lineno"> 42 </span>
|
||||
<span class="lineno"> 43 </span>{-# NOINLINE pRasterRef #-}
|
||||
<span class="lineno"> 44 </span>pRasterRef :: IORef Raster
|
||||
<span class="lineno"> 45 </span><span class="decl"><span class="nottickedoff">pRasterRef = unsafePerformIO (newIORef RasterNone)</span></span>
|
||||
<span class="lineno"> 46 </span>
|
||||
<span class="lineno"> 47 </span>{-# NOINLINE pRaster #-}
|
||||
<span class="lineno"> 48 </span>-- | Selected raster engine.
|
||||
<span class="lineno"> 49 </span>pRaster :: Raster
|
||||
<span class="lineno"> 50 </span><span class="decl"><span class="nottickedoff">pRaster = unsafePerformIO (readIORef pRasterRef)</span></span>
|
||||
<span class="lineno"> 51 </span>
|
||||
<span class="lineno"> 52 </span>-- | Set raster engine.
|
||||
<span class="lineno"> 53 </span>setRaster :: Raster -> IO ()
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">setRaster = writeIORef pRasterRef</span></span>
|
||||
<span class="lineno"> 55 </span>
|
||||
<span class="lineno"> 56 </span>{-# NOINLINE pFPSRef #-}
|
||||
<span class="lineno"> 57 </span>pFPSRef :: IORef FPS
|
||||
<span class="lineno"> 58 </span><span class="decl"><span class="nottickedoff">pFPSRef = unsafePerformIO (newIORef 0)</span></span>
|
||||
<span class="lineno"> 59 </span>
|
||||
<span class="lineno"> 60 </span>{-# NOINLINE pFPS #-}
|
||||
<span class="lineno"> 61 </span>-- | Selected framerate.
|
||||
<span class="lineno"> 62 </span>pFPS :: FPS
|
||||
<span class="lineno"> 63 </span><span class="decl"><span class="nottickedoff">pFPS = unsafePerformIO (readIORef pFPSRef)</span></span>
|
||||
<span class="lineno"> 64 </span>
|
||||
<span class="lineno"> 65 </span>-- | Set desired framerate.
|
||||
<span class="lineno"> 66 </span>setFPS :: FPS -> IO ()
|
||||
<span class="lineno"> 67 </span><span class="decl"><span class="nottickedoff">setFPS = writeIORef pFPSRef</span></span>
|
||||
<span class="lineno"> 68 </span>
|
||||
<span class="lineno"> 69 </span>{-# NOINLINE pWidthRef #-}
|
||||
<span class="lineno"> 70 </span>pWidthRef :: IORef FPS
|
||||
<span class="lineno"> 71 </span><span class="decl"><span class="nottickedoff">pWidthRef = unsafePerformIO (newIORef 0)</span></span>
|
||||
<span class="lineno"> 72 </span>
|
||||
<span class="lineno"> 73 </span>{-# NOINLINE pWidth #-}
|
||||
<span class="lineno"> 74 </span>-- | Width of animation in pixel.
|
||||
<span class="lineno"> 75 </span>pWidth :: Width
|
||||
<span class="lineno"> 76 </span><span class="decl"><span class="nottickedoff">pWidth = unsafePerformIO (readIORef pWidthRef)</span></span>
|
||||
<span class="lineno"> 77 </span>
|
||||
<span class="lineno"> 78 </span>-- | Set desired width of animation in pixel.
|
||||
<span class="lineno"> 79 </span>setWidth :: Width -> IO ()
|
||||
<span class="lineno"> 80 </span><span class="decl"><span class="nottickedoff">setWidth = writeIORef pWidthRef</span></span>
|
||||
<span class="lineno"> 81 </span>
|
||||
<span class="lineno"> 82 </span>{-# NOINLINE pHeightRef #-}
|
||||
<span class="lineno"> 83 </span>pHeightRef :: IORef FPS
|
||||
<span class="lineno"> 84 </span><span class="decl"><span class="nottickedoff">pHeightRef = unsafePerformIO (newIORef 0)</span></span>
|
||||
<span class="lineno"> 85 </span>
|
||||
<span class="lineno"> 86 </span>{-# NOINLINE pHeight #-}
|
||||
<span class="lineno"> 87 </span>-- | Height of animation in pixel.
|
||||
<span class="lineno"> 88 </span>pHeight :: Height
|
||||
<span class="lineno"> 89 </span><span class="decl"><span class="nottickedoff">pHeight = unsafePerformIO (readIORef pHeightRef)</span></span>
|
||||
<span class="lineno"> 90 </span>
|
||||
<span class="lineno"> 91 </span>-- | Set desired height of animation in pixel.
|
||||
<span class="lineno"> 92 </span>setHeight :: Height -> IO ()
|
||||
<span class="lineno"> 93 </span><span class="decl"><span class="nottickedoff">setHeight = writeIORef pHeightRef</span></span>
|
||||
<span class="lineno"> 94 </span>
|
||||
<span class="lineno"> 95 </span>{-# NOINLINE pNoExternalsRef #-}
|
||||
<span class="lineno"> 96 </span>pNoExternalsRef :: IORef Bool
|
||||
<span class="lineno"> 97 </span><span class="decl"><span class="istickedoff">pNoExternalsRef = unsafePerformIO (newIORef <span class="nottickedoff">False</span>)</span></span>
|
||||
<span class="lineno"> 98 </span>
|
||||
<span class="lineno"> 99 </span>{-# NOINLINE pNoExternals #-}
|
||||
<span class="lineno"> 100 </span>-- | This parameter determined whether or not external tools are allowed.
|
||||
<span class="lineno"> 101 </span>-- If this flag is True then tools such as 'Reanimate.LaTeX.latex' and
|
||||
<span class="lineno"> 102 </span>-- 'Reanimate.Blender.blender' will not be invoked.
|
||||
<span class="lineno"> 103 </span>pNoExternals :: Bool
|
||||
<span class="lineno"> 104 </span><span class="decl"><span class="istickedoff">pNoExternals = unsafePerformIO (readIORef pNoExternalsRef)</span></span>
|
||||
<span class="lineno"> 105 </span>
|
||||
<span class="lineno"> 106 </span>-- | Set whether external tools are allowed.
|
||||
<span class="lineno"> 107 </span>setNoExternals :: Bool -> IO ()
|
||||
<span class="lineno"> 108 </span><span class="decl"><span class="istickedoff">setNoExternals = writeIORef pNoExternalsRef</span></span>
|
||||
<span class="lineno"> 109 </span>
|
||||
<span class="lineno"> 110 </span>{-# NOINLINE pRootDirectoryRef #-}
|
||||
<span class="lineno"> 111 </span>pRootDirectoryRef :: IORef FilePath
|
||||
<span class="lineno"> 112 </span><span class="decl"><span class="nottickedoff">pRootDirectoryRef = unsafePerformIO (newIORef (error "root directory not set"))</span></span>
|
||||
<span class="lineno"> 113 </span>
|
||||
<span class="lineno"> 114 </span>{-# NOINLINE pRootDirectory #-}
|
||||
<span class="lineno"> 115 </span>-- | Root directory of animation. Images and other data has to be placed
|
||||
<span class="lineno"> 116 </span>-- here if they are referenced in an SVG image.
|
||||
<span class="lineno"> 117 </span>pRootDirectory :: FilePath
|
||||
<span class="lineno"> 118 </span><span class="decl"><span class="nottickedoff">pRootDirectory = unsafePerformIO (readIORef pRootDirectoryRef)</span></span>
|
||||
<span class="lineno"> 119 </span>
|
||||
<span class="lineno"> 120 </span>-- | Set the root animation directory.
|
||||
<span class="lineno"> 121 </span>setRootDirectory :: FilePath -> IO ()
|
||||
<span class="lineno"> 122 </span><span class="decl"><span class="nottickedoff">setRootDirectory = writeIORef pRootDirectoryRef</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
483
reanimate-0.4.2.0-inplace/Reanimate.PolyShape.hs.html
Normal file
483
reanimate-0.4.2.0-inplace/Reanimate.PolyShape.hs.html
Normal file
|
|
@ -0,0 +1,483 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Module : Reanimate.PolyShape
|
||||
<span class="lineno"> 3 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 4 </span>License : Unlicense
|
||||
<span class="lineno"> 5 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 6 </span>Stability : experimental
|
||||
<span class="lineno"> 7 </span>Portability : POSIX
|
||||
<span class="lineno"> 8 </span>
|
||||
<span class="lineno"> 9 </span>A PolyShape is a closed set of curves.
|
||||
<span class="lineno"> 10 </span>
|
||||
<span class="lineno"> 11 </span>-}
|
||||
<span class="lineno"> 12 </span>module Reanimate.PolyShape
|
||||
<span class="lineno"> 13 </span> ( PolyShape(..)
|
||||
<span class="lineno"> 14 </span> , PolyShapeWithHoles
|
||||
<span class="lineno"> 15 </span> , svgToPolyShapes -- :: Tree -> [PolyShape]
|
||||
<span class="lineno"> 16 </span> , svgToPolygons -- :: Double -> Svg -> [Polygon]
|
||||
<span class="lineno"> 17 </span>
|
||||
<span class="lineno"> 18 </span> , renderPolyShape -- :: PolyShape -> Tree
|
||||
<span class="lineno"> 19 </span> , renderPolyShapes -- :: [PolyShape] -> Tree
|
||||
<span class="lineno"> 20 </span> , renderPolyShapePoints -- :: PolyShape -> Tree
|
||||
<span class="lineno"> 21 </span>
|
||||
<span class="lineno"> 22 </span> , plPathCommands -- :: PolyShape -> [PathCommand]
|
||||
<span class="lineno"> 23 </span> , plLineCommands -- :: PolyShape -> [LineCommand]
|
||||
<span class="lineno"> 24 </span>
|
||||
<span class="lineno"> 25 </span> , plLength -- :: PolyShape -> Double
|
||||
<span class="lineno"> 26 </span> , plArea
|
||||
<span class="lineno"> 27 </span> , plCurves -- :: PolyShape -> [CubicBezier Double]
|
||||
<span class="lineno"> 28 </span> , isInsideOf -- :: PolyShape -> PolyShape -> Bool
|
||||
<span class="lineno"> 29 </span>
|
||||
<span class="lineno"> 30 </span> , plFromPolygon -- :: [RPoint] -> PolyShape
|
||||
<span class="lineno"> 31 </span> , plToPolygon -- :: Double -> PolyShape -> Polygon
|
||||
<span class="lineno"> 32 </span> , plDecompose -- :: [PolyShape] -> [[RPoint]]
|
||||
<span class="lineno"> 33 </span> , unionPolyShapes -- :: [PolyShape] -> [PolyShape]
|
||||
<span class="lineno"> 34 </span> , unionPolyShapes' -- :: Double -> [PolyShape] -> [PolyShape]
|
||||
<span class="lineno"> 35 </span> , plDecompose' -- :: Double -> [PolyShape] -> [[RPoint]]
|
||||
<span class="lineno"> 36 </span> , decomposePolygon -- :: [Point Double] -> [[RPoint]]
|
||||
<span class="lineno"> 37 </span> , plGroupShapes -- :: [PolyShape] -> [PolyShapeWithHoles]
|
||||
<span class="lineno"> 38 </span> , mergePolyShapeHoles -- :: PolyShapeWithHoles -> PolyShape
|
||||
<span class="lineno"> 39 </span> , plPartial
|
||||
<span class="lineno"> 40 </span> , plGroupTouching
|
||||
<span class="lineno"> 41 </span> ) where
|
||||
<span class="lineno"> 42 </span>
|
||||
<span class="lineno"> 43 </span>import Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')
|
||||
<span class="lineno"> 44 </span>import Control.Lens ((&), (.~), (^.))
|
||||
<span class="lineno"> 45 </span>import Data.Ext
|
||||
<span class="lineno"> 46 </span>import Data.Geometry.PlanarSubdivision (PolygonFaceData (..))
|
||||
<span class="lineno"> 47 </span>import qualified Data.Geometry.Point as Geo
|
||||
<span class="lineno"> 48 </span>import qualified Data.Geometry.Polygon as Geo
|
||||
<span class="lineno"> 49 </span>import Data.List (nub, partition, sortOn)
|
||||
<span class="lineno"> 50 </span>import qualified Data.PlaneGraph as Geo
|
||||
<span class="lineno"> 51 </span>import Data.Proxy
|
||||
<span class="lineno"> 52 </span>import qualified Data.Vector as V
|
||||
<span class="lineno"> 53 </span>import Geom2D.CubicBezier.Linear (ClosedPath (..), CubicBezier (..), FillRule (..),
|
||||
<span class="lineno"> 54 </span> PathJoin (..), QuadBezier (..), arcLength,
|
||||
<span class="lineno"> 55 </span> arcLengthParam, bezierIntersection, bezierSubsegment,
|
||||
<span class="lineno"> 56 </span> closedPathCurves, closest, colinear, curvesToClosed,
|
||||
<span class="lineno"> 57 </span> evalBezier, quadToCubic, reorient, splitBezier, union,
|
||||
<span class="lineno"> 58 </span> vectorDistance)
|
||||
<span class="lineno"> 59 </span>import Graphics.SvgTree (PathCommand (..), RPoint, Tree (..), defaultSvg, pathDefinition)
|
||||
<span class="lineno"> 60 </span>import Linear.V2
|
||||
<span class="lineno"> 61 </span>import Reanimate.Animation
|
||||
<span class="lineno"> 62 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 63 </span>import Reanimate.Math.Polygon (Polygon, mkPolygon, pArea, pIsCCW)
|
||||
<span class="lineno"> 64 </span>import Reanimate.Svg
|
||||
<span class="lineno"> 65 </span>
|
||||
<span class="lineno"> 66 </span>-- | Shape drawn by continuous line. May have overlap, may be convex.
|
||||
<span class="lineno"> 67 </span>newtype PolyShape = PolyShape { <span class="istickedoff"><span class="decl"><span class="istickedoff">unPolyShape</span></span></span> :: ClosedPath Double }
|
||||
<span class="lineno"> 68 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 69 </span>
|
||||
<span class="lineno"> 70 </span>-- | Polyshape with smaller, fully-enclosed holes.
|
||||
<span class="lineno"> 71 </span>data PolyShapeWithHoles = PolyShapeWithHoles
|
||||
<span class="lineno"> 72 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">polyShapeParent</span></span></span> :: PolyShape
|
||||
<span class="lineno"> 73 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">polyShapeHoles</span></span></span> :: [PolyShape]
|
||||
<span class="lineno"> 74 </span> }
|
||||
<span class="lineno"> 75 </span>
|
||||
<span class="lineno"> 76 </span>
|
||||
<span class="lineno"> 77 </span>-- | Render a set of polyshapes as a single SVG path.
|
||||
<span class="lineno"> 78 </span>renderPolyShapes :: [PolyShape] -> Tree
|
||||
<span class="lineno"> 79 </span><span class="decl"><span class="nottickedoff">renderPolyShapes pls =</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="nottickedoff">PathTree $ defaultSvg & pathDefinition .~ concatMap plPathCommands pls</span></span>
|
||||
<span class="lineno"> 81 </span>
|
||||
<span class="lineno"> 82 </span>-- | Render a polyshape as a single SVG path.
|
||||
<span class="lineno"> 83 </span>renderPolyShape :: PolyShape -> Tree
|
||||
<span class="lineno"> 84 </span><span class="decl"><span class="nottickedoff">renderPolyShape pl =</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="nottickedoff">PathTree $ defaultSvg & pathDefinition .~ plPathCommands pl</span></span>
|
||||
<span class="lineno"> 86 </span>
|
||||
<span class="lineno"> 87 </span>-- | Render control-points of a polyshape as circles.
|
||||
<span class="lineno"> 88 </span>renderPolyShapePoints :: PolyShape -> Tree
|
||||
<span class="lineno"> 89 </span><span class="decl"><span class="nottickedoff">renderPolyShapePoints = mkGroup . map renderPoint . plCurves</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="nottickedoff">renderPoint (CubicBezier (V2 x y) _ _ _) =</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="nottickedoff">translate x y $ mkCircle 0.02</span></span>
|
||||
<span class="lineno"> 93 </span>
|
||||
<span class="lineno"> 94 </span>-- | Length of polyshape circumference.
|
||||
<span class="lineno"> 95 </span>plLength :: PolyShape -> Double
|
||||
<span class="lineno"> 96 </span><span class="decl"><span class="nottickedoff">plLength = sum . map cubicLength . plCurves</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">cubicLength c = arcLength c 1 polyShapeTolerance</span></span>
|
||||
<span class="lineno"> 99 </span>
|
||||
<span class="lineno"> 100 </span>-- | Area of polyshape.
|
||||
<span class="lineno"> 101 </span>plArea :: PolyShape -> Double
|
||||
<span class="lineno"> 102 </span><span class="decl"><span class="nottickedoff">plArea pl = realToFrac $ pArea $ plToPolygon polyShapeTolerance pl</span></span>
|
||||
<span class="lineno"> 103 </span>
|
||||
<span class="lineno"> 104 </span>-- 1/10th of a pixel if rendered at 2560x1440
|
||||
<span class="lineno"> 105 </span>polyShapeTolerance :: Double
|
||||
<span class="lineno"> 106 </span><span class="decl"><span class="nottickedoff">polyShapeTolerance = screenWidth/25600</span></span>
|
||||
<span class="lineno"> 107 </span>
|
||||
<span class="lineno"> 108 </span>-- | Construct a polyshape from the vertices in a polygon.
|
||||
<span class="lineno"> 109 </span>plFromPolygon :: [RPoint] -> PolyShape
|
||||
<span class="lineno"> 110 </span><span class="decl"><span class="nottickedoff">plFromPolygon = PolyShape . ClosedPath . map worker</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="nottickedoff">worker val = (val, JoinLine)</span></span>
|
||||
<span class="lineno"> 113 </span>
|
||||
<span class="lineno"> 114 </span>-- | Approximate a polyshape as a polygon within the given tolerance.
|
||||
<span class="lineno"> 115 </span>plToPolygon :: Double -> PolyShape -> Polygon
|
||||
<span class="lineno"> 116 </span><span class="decl"><span class="istickedoff">plToPolygon tol pl =</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">let p = V.init . V.fromList . map (fmap realToFrac) .</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">plPolygonify tol $ pl</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">in if <span class="tickonlyfalse">pIsCCW (mkPolygon p)</span> then <span class="nottickedoff">mkPolygon p</span> else mkPolygon (V.reverse p)</span></span>
|
||||
<span class="lineno"> 120 </span>
|
||||
<span class="lineno"> 121 </span>-- | Partially draw polyshape.
|
||||
<span class="lineno"> 122 </span>plPartial :: Double -> PolyShape -> PolyShape
|
||||
<span class="lineno"> 123 </span><span class="decl"><span class="nottickedoff">plPartial delta pl | delta >= 1 = pl</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"></span><span class="nottickedoff">plPartial delta pl = PolyShape $ curvesToClosed (lineOut ++ [joinB] ++ lineIn)</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">lineOutEnd = cubicC3 (last lineOut)</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">lineInBegin = cubicC0 (head lineIn)</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">joinB = CubicBezier lineOutEnd lineOutEnd lineOutEnd lineInBegin</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="nottickedoff">lineOut = takeLen (len*delta/2) $ plCurves pl</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">lineIn =</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">reverse $ map reorient $</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">takeLen (len*delta/2) $ reverse $ map reorient $ plCurves pl</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">len = plLength pl</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff">takeLen _ [] = []</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">takeLen l (c:cs) =</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">let cLen = arcLength c 1 polyShapeTolerance in</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">if l < cLen</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">then [bezierSubsegment c 0 (arcLengthParam c l polyShapeTolerance)]</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">else c : takeLen (l-cLen) cs</span></span>
|
||||
<span class="lineno"> 140 </span>
|
||||
<span class="lineno"> 141 </span>-- earClip :: Polygon -> Triangulation
|
||||
<span class="lineno"> 142 </span>-- dual :: Triangulation -> Dual
|
||||
<span class="lineno"> 143 </span>-- toPDual :: Polygon -> Dual -> PDual
|
||||
<span class="lineno"> 144 </span>-- pdualReduce :: Polygon -> PDual -> Int -> PDual
|
||||
<span class="lineno"> 145 </span>-- pdualPolygons :: Polygon -> PDual -> [Polygon]
|
||||
<span class="lineno"> 146 </span>-- splitPolyShape :: Double -> Int -> PolyShape -> [PolyShape]
|
||||
<span class="lineno"> 147 </span>-- splitPolyShape tol n poly =
|
||||
<span class="lineno"> 148 </span>-- let polygon = toPolygon (plPolygonify tol poly)
|
||||
<span class="lineno"> 149 </span>-- trig = triangulate $ pRing polygon
|
||||
<span class="lineno"> 150 </span>-- d = dual 0 trig
|
||||
<span class="lineno"> 151 </span>-- pd = toPDual (pRing polygon) d
|
||||
<span class="lineno"> 152 </span>-- reduced = pdualReduce (pRing polygon) pd n
|
||||
<span class="lineno"> 153 </span>-- polygons = pdualPolygons polygon reduced
|
||||
<span class="lineno"> 154 </span>-- in map toPolyShape polygons
|
||||
<span class="lineno"> 155 </span>-- where
|
||||
<span class="lineno"> 156 </span>-- toPolygon :: [RPoint] -> Polygon
|
||||
<span class="lineno"> 157 </span>-- toPolygon = mkPolygon . V.fromList . nub . map (fmap realToFrac)
|
||||
<span class="lineno"> 158 </span>-- toPolyShape :: Polygon -> PolyShape
|
||||
<span class="lineno"> 159 </span>-- toPolyShape = plFromPolygon . map (fmap realToFrac) . V.toList . polygonPoints
|
||||
<span class="lineno"> 160 </span>
|
||||
<span class="lineno"> 161 </span>-- plPartial' :: Double -> ([RPoint], PolyShape) -> PolyShape
|
||||
<span class="lineno"> 162 </span>-- plPartial' delta (seen', PolyShape (ClosedPath lst)) =
|
||||
<span class="lineno"> 163 </span>-- case lst of
|
||||
<span class="lineno"> 164 </span>-- [] -> PolyShape (ClosedPath [])
|
||||
<span class="lineno"> 165 </span>-- (startP, startJoin) : rest -> PolyShape $ ClosedPath $
|
||||
<span class="lineno"> 166 </span>-- (startP, startJoin) : worker startP rest
|
||||
<span class="lineno"> 167 </span>-- where
|
||||
<span class="lineno"> 168 </span>-- seen = filter (`elem` plPoints) seen'
|
||||
<span class="lineno"> 169 </span>-- closestSeen pt = minimumBy (comparing (vectorDistance pt)) seen
|
||||
<span class="lineno"> 170 </span>-- worker _ [] = []
|
||||
<span class="lineno"> 171 </span>-- worker _ ((newP, newJoin) : rest)
|
||||
<span class="lineno"> 172 </span>-- | newP `elem` seen = (newP, newJoin) : worker newP rest
|
||||
<span class="lineno"> 173 </span>-- | otherwise =
|
||||
<span class="lineno"> 174 </span>-- let newAt = interpolateVector (closestSeen newP) newP delta
|
||||
<span class="lineno"> 175 </span>-- in (newAt, newJoin) : worker newAt rest
|
||||
<span class="lineno"> 176 </span>-- plPoints =
|
||||
<span class="lineno"> 177 </span>-- [ p | (p,_) <- lst ]
|
||||
<span class="lineno"> 178 </span>
|
||||
<span class="lineno"> 179 </span>-- | Find intersection points.
|
||||
<span class="lineno"> 180 </span>plGroupTouching :: [PolyShape] -> [[([RPoint],PolyShape)]]
|
||||
<span class="lineno"> 181 </span><span class="decl"><span class="nottickedoff">plGroupTouching [] = []</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"></span><span class="nottickedoff">plGroupTouching pls = worker [polyShapeOrigin (head pls)] pls</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="nottickedoff">worker _ [] = []</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff">worker seen shapes =</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff">let (touching, notTouching) = partition (isTouching seen) shapes</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff">in if null touching</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="nottickedoff">then plGroupTouching notTouching</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="nottickedoff">else map ((,) seen . changeOrigin seen) touching :</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="nottickedoff">worker (seen ++ concatMap plPoints touching) notTouching</span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="nottickedoff">isTouching pts = any (`elem` pts) . plPoints</span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="nottickedoff">changeOrigin seen (PolyShape (ClosedPath segments)) = PolyShape $ ClosedPath $ helper [] segments</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="nottickedoff">helper acc [] = reverse acc</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="nottickedoff">helper acc lst@((startP,startJ):rest)</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="nottickedoff">| startP `elem` seen = lst ++ reverse acc</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = helper ((startP, startJ):acc) rest</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="nottickedoff">plPoints :: PolyShape -> [RPoint]</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="nottickedoff">plPoints (PolyShape (ClosedPath lst)) =</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="nottickedoff">[ p | (p,_) <- lst ]</span></span>
|
||||
<span class="lineno"> 201 </span>
|
||||
<span class="lineno"> 202 </span>-- | Deconstruct a polyshape into non-intersecting, convex polygons.
|
||||
<span class="lineno"> 203 </span>plDecompose :: [PolyShape] -> [[RPoint]]
|
||||
<span class="lineno"> 204 </span><span class="decl"><span class="nottickedoff">plDecompose = plDecompose' 0.001</span></span>
|
||||
<span class="lineno"> 205 </span>
|
||||
<span class="lineno"> 206 </span>-- | Deconstruct a polyshape into non-intersecting, convex polygons.
|
||||
<span class="lineno"> 207 </span>plDecompose' :: Double -> [PolyShape] -> [[RPoint]]
|
||||
<span class="lineno"> 208 </span><span class="decl"><span class="nottickedoff">plDecompose' tol =</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="nottickedoff">concatMap (decomposePolygon . plPolygonify tol . mergePolyShapeHoles) .</span>
|
||||
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="nottickedoff">plGroupShapes .</span>
|
||||
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="nottickedoff">unionPolyShapes</span></span>
|
||||
<span class="lineno"> 212 </span>
|
||||
<span class="lineno"> 213 </span>-- | Split polygon into smaller, convex polygons.
|
||||
<span class="lineno"> 214 </span>decomposePolygon :: [RPoint] -> [[RPoint]]
|
||||
<span class="lineno"> 215 </span><span class="decl"><span class="nottickedoff">decomposePolygon poly =</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="nottickedoff">[ [ V2 x y</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">| v <- V.toList (Geo.boundaryVertices f pg)</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="nottickedoff">, let Geo.Point2 x y =(pg^.Geo.vertexDataOf v) ^. Geo.location ]</span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="nottickedoff">| (f, Inside) <- V.toList (Geo.internalFaces pg) ]</span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 221 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="nottickedoff">pg = triangulate' Proxy p</span>
|
||||
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="nottickedoff">p = Geo.fromPoints $</span>
|
||||
<span class="lineno"> 224 </span><span class="spaces"> </span><span class="nottickedoff">[ Geo.Point2 x y :+ ()</span>
|
||||
<span class="lineno"> 225 </span><span class="spaces"> </span><span class="nottickedoff">| V2 x y <- poly ]</span></span>
|
||||
<span class="lineno"> 226 </span>
|
||||
<span class="lineno"> 227 </span>plPolygonify :: Double -> PolyShape -> [RPoint]
|
||||
<span class="lineno"> 228 </span><span class="decl"><span class="istickedoff">plPolygonify tol shape =</span>
|
||||
<span class="lineno"> 229 </span><span class="spaces"> </span><span class="istickedoff">startPoint (head curves) : concatMap worker curves</span>
|
||||
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="istickedoff">curves = plCurves shape</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="istickedoff">worker c | <span class="tickonlyfalse">endPoint c == startPoint c</span> =</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[]</span> -- error $ "Bad bezier: " ++ show c</span>
|
||||
<span class="lineno"> 234 </span><span class="spaces"> </span><span class="istickedoff">worker c =</span>
|
||||
<span class="lineno"> 235 </span><span class="spaces"> </span><span class="istickedoff">if colinear c tol -- && arcLength c 1 tol < 1</span>
|
||||
<span class="lineno"> 236 </span><span class="spaces"> </span><span class="istickedoff">then [endPoint c]</span>
|
||||
<span class="lineno"> 237 </span><span class="spaces"> </span><span class="istickedoff">else</span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="istickedoff">let (lhs,rhs) = splitBezier c 0.5</span>
|
||||
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="istickedoff">in worker lhs ++ worker rhs</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="istickedoff">endPoint (CubicBezier _ _ _ d) = d</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="istickedoff">startPoint (CubicBezier a _ _ _) = a</span></span>
|
||||
<span class="lineno"> 242 </span>
|
||||
<span class="lineno"> 243 </span>-- | Convert a polyshape to a list of SVG path commands.
|
||||
<span class="lineno"> 244 </span>plPathCommands :: PolyShape -> [PathCommand]
|
||||
<span class="lineno"> 245 </span><span class="decl"><span class="nottickedoff">plPathCommands = lineToPath . plLineCommands</span></span>
|
||||
<span class="lineno"> 246 </span>
|
||||
<span class="lineno"> 247 </span>-- | Convert a polyshape to a list of line commands.
|
||||
<span class="lineno"> 248 </span>plLineCommands :: PolyShape -> [LineCommand]
|
||||
<span class="lineno"> 249 </span><span class="decl"><span class="nottickedoff">plLineCommands pl =</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="nottickedoff">case curves of</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="nottickedoff">[] -> []</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="nottickedoff">(CubicBezier start _ _ _:_) -></span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="nottickedoff">LineMove start :</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="nottickedoff">zipWith worker (drop 1 dstList ++ [start]) joinList ++</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="nottickedoff">[LineEnd start]</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="nottickedoff">ClosedPath closedPath = unPolyShape pl</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="nottickedoff">(dstList, joinList) = unzip closedPath</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="nottickedoff">curves = plCurves pl</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="nottickedoff">worker dst JoinLine =</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="nottickedoff">LineBezier [dst]</span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="nottickedoff">worker dst (JoinCurve a b) =</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="nottickedoff">LineBezier [a,b,dst]</span></span>
|
||||
<span class="lineno"> 264 </span>
|
||||
<span class="lineno"> 265 </span>-- | Extract all shapes from SVG nodes. Drawing attributes such
|
||||
<span class="lineno"> 266 </span>-- as stroke and fill color are discarded.
|
||||
<span class="lineno"> 267 </span>svgToPolyShapes :: Tree -> [PolyShape]
|
||||
<span class="lineno"> 268 </span><span class="decl"><span class="istickedoff">svgToPolyShapes = cmdsToPolyShapes . toLineCommands . extractPath</span></span>
|
||||
<span class="lineno"> 269 </span>
|
||||
<span class="lineno"> 270 </span>-- | Extract all polygons from SVG nodes. Curves are approximated to
|
||||
<span class="lineno"> 271 </span>-- within the given tolerance.
|
||||
<span class="lineno"> 272 </span>svgToPolygons :: Double -> SVG -> [Polygon]
|
||||
<span class="lineno"> 273 </span><span class="decl"><span class="nottickedoff">svgToPolygons tol = map (toPolygon . plPolygonify tol) . svgToPolyShapes</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="nottickedoff">toPolygon :: [RPoint] -> Polygon</span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="nottickedoff">toPolygon = mkPolygon .</span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList . nub . map (fmap realToFrac)</span></span>
|
||||
<span class="lineno"> 278 </span>
|
||||
<span class="lineno"> 279 </span>cmdsToPolyShapes :: [LineCommand] -> [PolyShape]
|
||||
<span class="lineno"> 280 </span><span class="decl"><span class="istickedoff">cmdsToPolyShapes [] = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 281 </span><span class="spaces"></span><span class="istickedoff">cmdsToPolyShapes cmds =</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="istickedoff">case cmds of</span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="istickedoff">(LineMove dst:cont) -> map PolyShape $ worker dst [] cont</span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">bad</span></span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">bad = error $ "Reanimate.PolyShape: Invalid commands: " ++ show cmds</span></span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="istickedoff">finalize [] rest = <span class="nottickedoff">rest</span></span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="istickedoff">finalize acc rest = ClosedPath (reverse acc) : rest</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="istickedoff">worker _from acc [] = <span class="nottickedoff">finalize acc []</span></span>
|
||||
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="istickedoff">worker _from acc (LineMove newStart : xs) =</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">finalize acc $</span></span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">worker newStart [] xs</span></span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="istickedoff">worker from acc (LineEnd orig:LineMove dst:xs) | <span class="nottickedoff">from /= orig</span> =</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">finalize ((from, JoinLine):acc) $</span></span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">worker dst [] xs</span></span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="istickedoff">worker _from acc (LineEnd{}:LineMove dst:xs) =</span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">finalize acc $</span></span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">worker dst [] xs</span></span>
|
||||
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="istickedoff">worker from acc [LineEnd orig] | <span class="tickonlytrue">from /= orig</span> =</span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="istickedoff">finalize ((from, JoinLine):acc) []</span>
|
||||
<span class="lineno"> 301 </span><span class="spaces"> </span><span class="istickedoff">worker _from acc [LineEnd{}] =</span>
|
||||
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">finalize acc []</span></span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="istickedoff">worker from acc (LineBezier [x]:xs) =</span>
|
||||
<span class="lineno"> 304 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">worker x ((from, JoinLine) : acc) xs</span></span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="istickedoff">worker from acc (LineBezier [a,b]:xs) =</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="istickedoff">let quad = QuadBezier from a b</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="istickedoff">CubicBezier _ a' b' c' = quadToCubic quad</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="istickedoff">in worker from acc (LineBezier [a',b',c']:xs)</span>
|
||||
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="istickedoff">worker from acc (LineBezier [a,b,c]:xs) =</span>
|
||||
<span class="lineno"> 310 </span><span class="spaces"> </span><span class="istickedoff">worker c ((from, JoinCurve a b) : acc) xs</span>
|
||||
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="istickedoff">worker _ _ _ = <span class="nottickedoff">bad</span></span></span>
|
||||
<span class="lineno"> 312 </span>
|
||||
<span class="lineno"> 313 </span>-- | Merge overlapping shapes.
|
||||
<span class="lineno"> 314 </span>unionPolyShapes :: [PolyShape] -> [PolyShape]
|
||||
<span class="lineno"> 315 </span><span class="decl"><span class="nottickedoff">unionPolyShapes shapes =</span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="nottickedoff">map PolyShape $</span>
|
||||
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="nottickedoff">union (map unPolyShape shapes) FillNonZero (polyShapeTolerance/10000)</span></span>
|
||||
<span class="lineno"> 318 </span>
|
||||
<span class="lineno"> 319 </span>-- | Merge overlapping shapes to within given tolerance.
|
||||
<span class="lineno"> 320 </span>unionPolyShapes' :: Double -> [PolyShape] -> [PolyShape]
|
||||
<span class="lineno"> 321 </span><span class="decl"><span class="nottickedoff">unionPolyShapes' tol shapes =</span>
|
||||
<span class="lineno"> 322 </span><span class="spaces"> </span><span class="nottickedoff">map PolyShape $</span>
|
||||
<span class="lineno"> 323 </span><span class="spaces"> </span><span class="nottickedoff">union (map unPolyShape shapes) FillNonZero tol</span></span>
|
||||
<span class="lineno"> 324 </span>
|
||||
<span class="lineno"> 325 </span>-- | True iff lhs is inside of rhs.
|
||||
<span class="lineno"> 326 </span>-- lhs and rhs may not overlap.
|
||||
<span class="lineno"> 327 </span>-- Implementation: Trace a vertical line through the origin of A and check
|
||||
<span class="lineno"> 328 </span>-- of this line intersects and odd number of times on both sides of A.
|
||||
<span class="lineno"> 329 </span>isInsideOf :: PolyShape -> PolyShape -> Bool
|
||||
<span class="lineno"> 330 </span><span class="decl"><span class="nottickedoff">lhs `isInsideOf` rhs =</span>
|
||||
<span class="lineno"> 331 </span><span class="spaces"> </span><span class="nottickedoff">odd (length upHits) && odd (length downHits)</span>
|
||||
<span class="lineno"> 332 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 333 </span><span class="spaces"> </span><span class="nottickedoff">(upHits, downHits) = polyIntersections origin rhs</span>
|
||||
<span class="lineno"> 334 </span><span class="spaces"> </span><span class="nottickedoff">origin = polyShapeOrigin lhs</span></span>
|
||||
<span class="lineno"> 335 </span>
|
||||
<span class="lineno"> 336 </span>polyIntersections :: RPoint -> PolyShape -> ([RPoint],[RPoint])
|
||||
<span class="lineno"> 337 </span><span class="decl"><span class="nottickedoff">polyIntersections origin rhs =</span>
|
||||
<span class="lineno"> 338 </span><span class="spaces"> </span><span class="nottickedoff">(nub $ concatMap (intersections rayUp) curves</span>
|
||||
<span class="lineno"> 339 </span><span class="spaces"> </span><span class="nottickedoff">,nub $ concatMap (intersections rayDown) curves)</span>
|
||||
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="nottickedoff">curves = plCurves rhs</span>
|
||||
<span class="lineno"> 342 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 343 </span><span class="spaces"> </span><span class="nottickedoff">intersections line bs =</span>
|
||||
<span class="lineno"> 344 </span><span class="spaces"> </span><span class="nottickedoff">map (evalBezier bs . fst) (bezierIntersection bs line polyShapeTolerance)</span>
|
||||
<span class="lineno"> 345 </span><span class="spaces"> </span><span class="nottickedoff">limit = 1000</span>
|
||||
<span class="lineno"> 346 </span><span class="spaces"> </span><span class="nottickedoff">rayUp = CubicBezier origin origin origin (V2 limit limit)</span>
|
||||
<span class="lineno"> 347 </span><span class="spaces"> </span><span class="nottickedoff">rayDown = CubicBezier origin origin origin (V2 (-limit) (-limit))</span></span>
|
||||
<span class="lineno"> 348 </span>
|
||||
<span class="lineno"> 349 </span>polyShapeOrigin :: PolyShape -> V2 Double
|
||||
<span class="lineno"> 350 </span><span class="decl"><span class="nottickedoff">polyShapeOrigin (PolyShape closedPath) =</span>
|
||||
<span class="lineno"> 351 </span><span class="spaces"> </span><span class="nottickedoff">case closedPath of</span>
|
||||
<span class="lineno"> 352 </span><span class="spaces"> </span><span class="nottickedoff">ClosedPath [] -> V2 0 0</span>
|
||||
<span class="lineno"> 353 </span><span class="spaces"> </span><span class="nottickedoff">ClosedPath ((start,_):_) -> start</span></span>
|
||||
<span class="lineno"> 354 </span>
|
||||
<span class="lineno"> 355 </span>-- | Find holes and group them with their parent.
|
||||
<span class="lineno"> 356 </span>plGroupShapes :: [PolyShape] -> [PolyShapeWithHoles]
|
||||
<span class="lineno"> 357 </span><span class="decl"><span class="istickedoff">plGroupShapes = worker</span>
|
||||
<span class="lineno"> 358 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 359 </span><span class="spaces"> </span><span class="istickedoff">worker (s:rest)</span>
|
||||
<span class="lineno"> 360 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">null (parents <span class="nottickedoff">s</span> rest)</span> =</span>
|
||||
<span class="lineno"> 361 </span><span class="spaces"> </span><span class="istickedoff">let <span class="nottickedoff">isOnlyChild x = parents x (s:rest) == [s]</span></span>
|
||||
<span class="lineno"> 362 </span><span class="spaces"> </span><span class="istickedoff">(holes, nonHoles) = partition <span class="nottickedoff">isOnlyChild</span> rest</span>
|
||||
<span class="lineno"> 363 </span><span class="spaces"> </span><span class="istickedoff">prime = PolyShapeWithHoles</span>
|
||||
<span class="lineno"> 364 </span><span class="spaces"> </span><span class="istickedoff">{ polyShapeParent = s</span>
|
||||
<span class="lineno"> 365 </span><span class="spaces"> </span><span class="istickedoff">, polyShapeHoles = holes }</span>
|
||||
<span class="lineno"> 366 </span><span class="spaces"> </span><span class="istickedoff">in prime : worker nonHoles</span>
|
||||
<span class="lineno"> 367 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">worker (rest ++ [s])</span></span>
|
||||
<span class="lineno"> 368 </span><span class="spaces"> </span><span class="istickedoff">worker [] = []</span>
|
||||
<span class="lineno"> 369 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 370 </span><span class="spaces"> </span><span class="istickedoff">parents :: PolyShape -> [PolyShape] -> [PolyShape]</span>
|
||||
<span class="lineno"> 371 </span><span class="spaces"> </span><span class="istickedoff">parents self = filter <span class="nottickedoff">(self `isInsideOf`)</span> . filter <span class="nottickedoff">(/=self)</span></span></span>
|
||||
<span class="lineno"> 372 </span>
|
||||
<span class="lineno"> 373 </span>instance Eq PolyShape where
|
||||
<span class="lineno"> 374 </span> <span class="decl"><span class="nottickedoff">a == b = plCurves a == plCurves b</span></span>
|
||||
<span class="lineno"> 375 </span>
|
||||
<span class="lineno"> 376 </span>-- | Cut out holes.
|
||||
<span class="lineno"> 377 </span>mergePolyShapeHoles :: PolyShapeWithHoles -> PolyShape
|
||||
<span class="lineno"> 378 </span><span class="decl"><span class="istickedoff">mergePolyShapeHoles (PolyShapeWithHoles parent []) = parent</span>
|
||||
<span class="lineno"> 379 </span><span class="spaces"></span><span class="istickedoff">mergePolyShapeHoles (PolyShapeWithHoles parent (child:children)) =</span>
|
||||
<span class="lineno"> 380 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mergePolyShapeHoles $</span></span>
|
||||
<span class="lineno"> 381 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">PolyShapeWithHoles (mergePolyShapeHole parent child) children</span></span></span>
|
||||
<span class="lineno"> 382 </span>
|
||||
<span class="lineno"> 383 </span>-- Merge
|
||||
<span class="lineno"> 384 </span>mergePolyShapeHole :: PolyShape -> PolyShape -> PolyShape
|
||||
<span class="lineno"> 385 </span><span class="decl"><span class="nottickedoff">mergePolyShapeHole parent child =</span>
|
||||
<span class="lineno"> 386 </span><span class="spaces"> </span><span class="nottickedoff">snd $ head $</span>
|
||||
<span class="lineno"> 387 </span><span class="spaces"> </span><span class="nottickedoff">sortOn fst</span>
|
||||
<span class="lineno"> 388 </span><span class="spaces"> </span><span class="nottickedoff">[ cutSingleHole newParent child</span>
|
||||
<span class="lineno"> 389 </span><span class="spaces"> </span><span class="nottickedoff">| newParent <- polyShapePermutations parent ]</span></span>
|
||||
<span class="lineno"> 390 </span>
|
||||
<span class="lineno"> 391 </span>{-
|
||||
<span class="lineno"> 392 </span>parent:
|
||||
<span class="lineno"> 393 </span> (a,b)
|
||||
<span class="lineno"> 394 </span> (b,c)
|
||||
<span class="lineno"> 395 </span> (c,a)
|
||||
<span class="lineno"> 396 </span>
|
||||
<span class="lineno"> 397 </span>child:
|
||||
<span class="lineno"> 398 </span> (x,y)
|
||||
<span class="lineno"> 399 </span> (y,z)
|
||||
<span class="lineno"> 400 </span> (z,x)
|
||||
<span class="lineno"> 401 </span>
|
||||
<span class="lineno"> 402 </span>P = split (a,b)
|
||||
<span class="lineno"> 403 </span>new:
|
||||
<span class="lineno"> 404 </span> (P,b) p2b
|
||||
<span class="lineno"> 405 </span> (b,c) pTail
|
||||
<span class="lineno"> 406 </span> (c,a) pTail
|
||||
<span class="lineno"> 407 </span> (a,P) a2p
|
||||
<span class="lineno"> 408 </span>
|
||||
<span class="lineno"> 409 </span> (P,x) p2x
|
||||
<span class="lineno"> 410 </span>
|
||||
<span class="lineno"> 411 </span> (x,y) childCurves
|
||||
<span class="lineno"> 412 </span> (y,z) childCurves
|
||||
<span class="lineno"> 413 </span> (z,x) childCurves
|
||||
<span class="lineno"> 414 </span>
|
||||
<span class="lineno"> 415 </span> (x,P) x2p
|
||||
<span class="lineno"> 416 </span>
|
||||
<span class="lineno"> 417 </span>-}
|
||||
<span class="lineno"> 418 </span>cutSingleHole :: PolyShape -> PolyShape -> (Double, PolyShape)
|
||||
<span class="lineno"> 419 </span><span class="decl"><span class="nottickedoff">cutSingleHole parent child =</span>
|
||||
<span class="lineno"> 420 </span><span class="spaces"> </span><span class="nottickedoff">(score, PolyShape $ curvesToClosed $</span>
|
||||
<span class="lineno"> 421 </span><span class="spaces"> </span><span class="nottickedoff">p2b:pTail ++ [a2p] ++</span>
|
||||
<span class="lineno"> 422 </span><span class="spaces"> </span><span class="nottickedoff">[p2x] ++ childCurves ++</span>
|
||||
<span class="lineno"> 423 </span><span class="spaces"> </span><span class="nottickedoff">[x2p]</span>
|
||||
<span class="lineno"> 424 </span><span class="spaces"> </span><span class="nottickedoff">)</span>
|
||||
<span class="lineno"> 425 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 426 </span><span class="spaces"> </span><span class="nottickedoff">-- vect = (childOrigin - p) * 0 -- 0.0001</span>
|
||||
<span class="lineno"> 427 </span><span class="spaces"> </span><span class="nottickedoff">vectL = 0 -- rotate90L $* vect</span>
|
||||
<span class="lineno"> 428 </span><span class="spaces"> </span><span class="nottickedoff">vectR = 0 -- rotate90R $* vect</span>
|
||||
<span class="lineno"> 429 </span><span class="spaces"> </span><span class="nottickedoff">score = vectorDistance childOrigin p</span>
|
||||
<span class="lineno"> 430 </span><span class="spaces"> </span><span class="nottickedoff">childOrigin = polyShapeOrigin child</span>
|
||||
<span class="lineno"> 431 </span><span class="spaces"> </span><span class="nottickedoff">childOrigin' = childOrigin - vectL</span>
|
||||
<span class="lineno"> 432 </span><span class="spaces"> </span><span class="nottickedoff">(pHead:pTail) = plCurves parent</span>
|
||||
<span class="lineno"> 433 </span><span class="spaces"> </span><span class="nottickedoff">childCurves = plCurves child</span>
|
||||
<span class="lineno"> 434 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 435 </span><span class="spaces"> </span><span class="nottickedoff">pParam = closest pHead childOrigin polyShapeTolerance</span>
|
||||
<span class="lineno"> 436 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 437 </span><span class="spaces"> </span><span class="nottickedoff">(a2p, p2b') = splitBezier pHead pParam</span>
|
||||
<span class="lineno"> 438 </span><span class="spaces"> </span><span class="nottickedoff">p2b = case p2b' of</span>
|
||||
<span class="lineno"> 439 </span><span class="spaces"> </span><span class="nottickedoff">CubicBezier a b c d -> CubicBezier (a - vectL) b c d</span>
|
||||
<span class="lineno"> 440 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 441 </span><span class="spaces"> </span><span class="nottickedoff">p = evalBezier pHead pParam</span>
|
||||
<span class="lineno"> 442 </span><span class="spaces"> </span><span class="nottickedoff">-- straight line to child origin</span>
|
||||
<span class="lineno"> 443 </span><span class="spaces"> </span><span class="nottickedoff">p2x = lineBetween (p - vectR) childOrigin</span>
|
||||
<span class="lineno"> 444 </span><span class="spaces"> </span><span class="nottickedoff">-- straight line from child origin</span>
|
||||
<span class="lineno"> 445 </span><span class="spaces"> </span><span class="nottickedoff">x2p = lineBetween childOrigin' p</span>
|
||||
<span class="lineno"> 446 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 447 </span><span class="spaces"> </span><span class="nottickedoff">lineBetween a = CubicBezier a a a</span></span>
|
||||
<span class="lineno"> 448 </span>
|
||||
<span class="lineno"> 449 </span>-- | Destruct a polyshape into constituent curves.
|
||||
<span class="lineno"> 450 </span>plCurves :: PolyShape -> [CubicBezier Double]
|
||||
<span class="lineno"> 451 </span><span class="decl"><span class="istickedoff">plCurves = closedPathCurves . unPolyShape</span></span>
|
||||
<span class="lineno"> 452 </span>
|
||||
<span class="lineno"> 453 </span>polyShapePermutations :: PolyShape -> [PolyShape]
|
||||
<span class="lineno"> 454 </span><span class="decl"><span class="nottickedoff">polyShapePermutations =</span>
|
||||
<span class="lineno"> 455 </span><span class="spaces"> </span><span class="nottickedoff">map (PolyShape . curvesToClosed) . cycleList . plCurves</span>
|
||||
<span class="lineno"> 456 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 457 </span><span class="spaces"> </span><span class="nottickedoff">cycleList lst =</span>
|
||||
<span class="lineno"> 458 </span><span class="spaces"> </span><span class="nottickedoff">let n = length lst in</span>
|
||||
<span class="lineno"> 459 </span><span class="spaces"> </span><span class="nottickedoff">[ take n $ drop i $ cycle lst</span>
|
||||
<span class="lineno"> 460 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0.. n-1] ]</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
338
reanimate-0.4.2.0-inplace/Reanimate.Raster.hs.html
Normal file
338
reanimate-0.4.2.0-inplace/Reanimate.Raster.hs.html
Normal file
|
|
@ -0,0 +1,338 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Module : Reanimate.Raster
|
||||
<span class="lineno"> 3 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 4 </span>License : Unlicense
|
||||
<span class="lineno"> 5 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 6 </span>Stability : experimental
|
||||
<span class="lineno"> 7 </span>Portability : POSIX
|
||||
<span class="lineno"> 8 </span>
|
||||
<span class="lineno"> 9 </span>Tools for generating, manipulating, and embedding raster images.
|
||||
<span class="lineno"> 10 </span>
|
||||
<span class="lineno"> 11 </span>-}
|
||||
<span class="lineno"> 12 </span>module Reanimate.Raster
|
||||
<span class="lineno"> 13 </span> ( mkImage -- :: Double -> Double -> FilePath -> SVG
|
||||
<span class="lineno"> 14 </span> , cacheImage -- :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
|
||||
<span class="lineno"> 15 </span> , prerenderSvg -- :: Hashable a => a -> SVG -> SVG
|
||||
<span class="lineno"> 16 </span> , prerenderSvgFile -- :: Hashable a => a -> Width -> Height -> SVG -> FilePath
|
||||
<span class="lineno"> 17 </span> , embedImage -- :: PngSavable a => Image a -> SVG
|
||||
<span class="lineno"> 18 </span> , embedDynamicImage -- :: DynamicImage -> SVG
|
||||
<span class="lineno"> 19 </span> , embedPng -- :: Double -> Double -> LBS.ByteString -> SVG
|
||||
<span class="lineno"> 20 </span> , raster -- :: SVG -> DynamicImage
|
||||
<span class="lineno"> 21 </span> , rasterSized -- :: Width -> Height -> SVG -> DynamicImage
|
||||
<span class="lineno"> 22 </span> , vectorize -- :: FilePath -> SVG
|
||||
<span class="lineno"> 23 </span> , vectorize_ -- :: [String] -> FilePath -> SVG
|
||||
<span class="lineno"> 24 </span> , svgAsPngFile -- :: SVG -> FilePath
|
||||
<span class="lineno"> 25 </span> , svgAsPngFile' -- :: Width -> Height -> SVG -> FilePath
|
||||
<span class="lineno"> 26 </span> )
|
||||
<span class="lineno"> 27 </span>where
|
||||
<span class="lineno"> 28 </span>
|
||||
<span class="lineno"> 29 </span>import Codec.Picture
|
||||
<span class="lineno"> 30 </span>import Control.Lens ( (&)
|
||||
<span class="lineno"> 31 </span> , (.~)
|
||||
<span class="lineno"> 32 </span> )
|
||||
<span class="lineno"> 33 </span>import Control.Monad
|
||||
<span class="lineno"> 34 </span>import qualified Data.ByteString as B
|
||||
<span class="lineno"> 35 </span>import qualified Data.ByteString.Base64.Lazy as Base64
|
||||
<span class="lineno"> 36 </span>import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||
<span class="lineno"> 37 </span>import Data.Hashable
|
||||
<span class="lineno"> 38 </span>import qualified Data.Text as T
|
||||
<span class="lineno"> 39 </span>import Graphics.SvgTree ( Number(..)
|
||||
<span class="lineno"> 40 </span> , Tree(..)
|
||||
<span class="lineno"> 41 </span> , defaultSvg
|
||||
<span class="lineno"> 42 </span> , parseSvgFile
|
||||
<span class="lineno"> 43 </span> )
|
||||
<span class="lineno"> 44 </span>import qualified Graphics.SvgTree as Svg
|
||||
<span class="lineno"> 45 </span>import Reanimate.Animation
|
||||
<span class="lineno"> 46 </span>import Reanimate.Cache
|
||||
<span class="lineno"> 47 </span>import Reanimate.Driver.Magick
|
||||
<span class="lineno"> 48 </span>import Reanimate.Misc
|
||||
<span class="lineno"> 49 </span>import Reanimate.Render
|
||||
<span class="lineno"> 50 </span>import Reanimate.Parameters
|
||||
<span class="lineno"> 51 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 52 </span>import Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 53 </span>import Reanimate.Svg.Unuse
|
||||
<span class="lineno"> 54 </span>import System.Directory
|
||||
<span class="lineno"> 55 </span>import System.FilePath
|
||||
<span class="lineno"> 56 </span>import System.IO
|
||||
<span class="lineno"> 57 </span>import System.IO.Temp
|
||||
<span class="lineno"> 58 </span>import System.IO.Unsafe
|
||||
<span class="lineno"> 59 </span>
|
||||
<span class="lineno"> 60 </span>-- | Load an external image. Width and height must be specified,
|
||||
<span class="lineno"> 61 </span>-- ignoring the image's aspect ratio. The center of the image is
|
||||
<span class="lineno"> 62 </span>-- placed at position (0,0).
|
||||
<span class="lineno"> 63 </span>--
|
||||
<span class="lineno"> 64 </span>-- For security reasons, must SVG renderer do not allow arbitrary
|
||||
<span class="lineno"> 65 </span>-- image links. For some renderers, we can get around this by placing
|
||||
<span class="lineno"> 66 </span>-- the images in the same root directory as the parent SVG file. Other
|
||||
<span class="lineno"> 67 </span>-- renderers (like Chrome and ffmpeg) requires that the image is inlined
|
||||
<span class="lineno"> 68 </span>-- as base64 data. External SVG files are an exception, though, as must
|
||||
<span class="lineno"> 69 </span>-- always be inlined directly. `mkImage` attempts to hide all the complexity
|
||||
<span class="lineno"> 70 </span>-- but edge-cases may exist.
|
||||
<span class="lineno"> 71 </span>--
|
||||
<span class="lineno"> 72 </span>-- Example:
|
||||
<span class="lineno"> 73 </span>--
|
||||
<span class="lineno"> 74 </span>-- > mkImage screenWidth screenHeight "../data/haskell.svg"
|
||||
<span class="lineno"> 75 </span>--
|
||||
<span class="lineno"> 76 </span>-- <<docs/gifs/doc_mkImage.gif>>
|
||||
<span class="lineno"> 77 </span>mkImage
|
||||
<span class="lineno"> 78 </span> :: Double -- ^ Desired image width.
|
||||
<span class="lineno"> 79 </span> -> Double -- ^ Desired image height.
|
||||
<span class="lineno"> 80 </span> -> FilePath -- ^ Path to external image file.
|
||||
<span class="lineno"> 81 </span> -> SVG
|
||||
<span class="lineno"> 82 </span><span class="decl"><span class="nottickedoff">mkImage width height path | takeExtension path == ".svg" = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="nottickedoff">svg_data <- B.readFile path</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="nottickedoff">case parseSvgFile path svg_data of</span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> error "Malformed svg"</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="nottickedoff">Just svg -></span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="nottickedoff">return</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="nottickedoff">$ scaleXY (width / screenWidth) (height / screenHeight)</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="nottickedoff">$ embedDocument svg</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"></span><span class="nottickedoff">mkImage width height path | pRaster == RasterNone = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="nottickedoff">inp <- LBS.readFile path</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="nottickedoff">let imgData = LBS.unpack $ Base64.encode inp</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="nottickedoff">return</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="nottickedoff">$ flipYAxis</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="nottickedoff">$ ImageTree</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="nottickedoff">$ defaultSvg</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageWidth</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">.~ Svg.Num width</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageHeight</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="nottickedoff">.~ Svg.Num height</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageHref</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="nottickedoff">.~ ("data:" ++ mimeType ++ ";base64," ++ imgData)</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageCornerUpperLeft</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="nottickedoff">.~ (Svg.Num (-width / 2), Svg.Num (-height / 2))</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageAspectRatio</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="nottickedoff">.~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">-- FIXME: Is there a better way to do this?</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">mimeType = case takeExtension path of</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="nottickedoff">".jpg" -> "image/jpeg"</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="nottickedoff">ext -> "image/" ++ drop 1 ext</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"></span><span class="nottickedoff">mkImage width height path = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="nottickedoff">exists <- doesFileExist target</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="nottickedoff">unless exists $ copyFile path target</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="nottickedoff">return</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">$ flipYAxis</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">$ ImageTree</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">$ defaultSvg</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageWidth</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">.~ Svg.Num width</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageHeight</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">.~ Svg.Num height</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageHref</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">.~ ("file://" ++ target)</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageCornerUpperLeft</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">.~ (Svg.Num (-width / 2), Svg.Num (-height / 2))</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">& Svg.imageAspectRatio</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">.~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">target = pRootDirectory </> encodeInt hashPath <.> takeExtension path</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">hashPath = hash path</span></span>
|
||||
<span class="lineno"> 132 </span>
|
||||
<span class="lineno"> 133 </span>-- | Write in-memory image to cache file if (and only if) such cache file doesn't
|
||||
<span class="lineno"> 134 </span>-- already exist.
|
||||
<span class="lineno"> 135 </span>cacheImage :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
|
||||
<span class="lineno"> 136 </span><span class="decl"><span class="nottickedoff">cacheImage key gen = unsafePerformIO $ cacheFile template $ \path -></span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">writePng path gen</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">where template = encodeInt (hash key) <.> "png"</span></span>
|
||||
<span class="lineno"> 139 </span>
|
||||
<span class="lineno"> 140 </span>-- Warning: Caching svg elements with links to external objects does
|
||||
<span class="lineno"> 141 </span>-- not work. 2020-06-01
|
||||
<span class="lineno"> 142 </span>-- | Same as 'prerenderSvg' but returns the location of the rendered image
|
||||
<span class="lineno"> 143 </span>-- as a FilePath.
|
||||
<span class="lineno"> 144 </span>prerenderSvgFile :: Hashable a => a -> Width -> Height -> SVG -> FilePath
|
||||
<span class="lineno"> 145 </span><span class="decl"><span class="nottickedoff">prerenderSvgFile key width height svg =</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="nottickedoff">unsafePerformIO $ cacheFile template $ \path -> do</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = replaceExtension path "svg"</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="nottickedoff">writeFile svgPath rendered</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">engine <- requireRaster pRaster</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">applyRaster engine svgPath</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">template = encodeInt (hash (key, width, height)) <.> "png"</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">rendered = renderSvg (Just $ Px $ fromIntegral width)</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">(Just $ Px $ fromIntegral height)</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">svg</span></span>
|
||||
<span class="lineno"> 156 </span>
|
||||
<span class="lineno"> 157 </span>-- | Render SVG node to a PNG file and return a new node containing
|
||||
<span class="lineno"> 158 </span>-- that image. For static SVG nodes, this can hugely improve performance.
|
||||
<span class="lineno"> 159 </span>-- The first argument is the key that determines SVG uniqueness. It
|
||||
<span class="lineno"> 160 </span>-- is entirely your responsibility to ensure that all keys are unique.
|
||||
<span class="lineno"> 161 </span>-- If they are not, you will be served stale results from the cache.
|
||||
<span class="lineno"> 162 </span>prerenderSvg :: Hashable a => a -> SVG -> SVG
|
||||
<span class="lineno"> 163 </span><span class="decl"><span class="nottickedoff">prerenderSvg key =</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">mkImage screenWidth screenHeight . prerenderSvgFile key pWidth pHeight</span></span>
|
||||
<span class="lineno"> 165 </span>
|
||||
<span class="lineno"> 166 </span>
|
||||
<span class="lineno"> 167 </span>{-# INLINE embedImage #-}
|
||||
<span class="lineno"> 168 </span>-- | Embed an in-memory PNG image. Note, the pixel size of the image
|
||||
<span class="lineno"> 169 </span>-- is used as the dimensions. As such, embedding a 100x100 PNG will
|
||||
<span class="lineno"> 170 </span>-- result in an image 100 units wide and 100 units high. Consider
|
||||
<span class="lineno"> 171 </span>-- using with 'scaleToSize'.
|
||||
<span class="lineno"> 172 </span>embedImage :: PngSavable a => Image a -> SVG
|
||||
<span class="lineno"> 173 </span><span class="decl"><span class="istickedoff">embedImage img = embedPng width height (encodePng img)</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="istickedoff">width = fromIntegral $ imageWidth img</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="istickedoff">height = fromIntegral $ imageHeight img</span></span>
|
||||
<span class="lineno"> 177 </span>
|
||||
<span class="lineno"> 178 </span>-- | Embed in-memory PNG bytestring without parsing it.
|
||||
<span class="lineno"> 179 </span>embedPng
|
||||
<span class="lineno"> 180 </span> :: Double -- ^ Width
|
||||
<span class="lineno"> 181 </span> -> Double -- ^ Height
|
||||
<span class="lineno"> 182 </span> -> LBS.ByteString -- ^ Raw PNG data
|
||||
<span class="lineno"> 183 </span> -> SVG
|
||||
<span class="lineno"> 184 </span>-- embedPng w h png = unsafePerformIO $ do
|
||||
<span class="lineno"> 185 </span>-- LBS.writeFile path png
|
||||
<span class="lineno"> 186 </span>-- return $ ImageTree $ defaultSvg
|
||||
<span class="lineno"> 187 </span>-- & Svg.imageCornerUpperLeft .~ (Svg.Num (-w/2), Svg.Num (-h/2))
|
||||
<span class="lineno"> 188 </span>-- & Svg.imageWidth .~ Svg.Num w
|
||||
<span class="lineno"> 189 </span>-- & Svg.imageHeight .~ Svg.Num h
|
||||
<span class="lineno"> 190 </span>-- & Svg.imageHref .~ ("file://"++path)
|
||||
<span class="lineno"> 191 </span>-- where
|
||||
<span class="lineno"> 192 </span>-- path = "/tmp" </> show (hash png) <.> "png"
|
||||
<span class="lineno"> 193 </span><span class="decl"><span class="istickedoff">embedPng w h png =</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff">$ ImageTree</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="istickedoff">$ defaultSvg</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageCornerUpperLeft</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff">.~ (Svg.Num (-w / 2), Svg.Num (-h / 2))</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageWidth</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff">.~ Svg.Num w</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageHeight</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff">.~ Svg.Num h</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageHref</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="istickedoff">.~ ("data:image/png;base64," ++ imgData)</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff">where imgData = LBS.unpack $ Base64.encode png</span></span>
|
||||
<span class="lineno"> 206 </span>
|
||||
<span class="lineno"> 207 </span>
|
||||
<span class="lineno"> 208 </span>{-# INLINE embedDynamicImage #-}
|
||||
<span class="lineno"> 209 </span>-- | Embed an in-memory image. Note, the pixel size of the image
|
||||
<span class="lineno"> 210 </span>-- is used as the dimensions. As such, embedding a 100x100 image will
|
||||
<span class="lineno"> 211 </span>-- result in an image 100 units wide and 100 units high. Consider
|
||||
<span class="lineno"> 212 </span>-- using with 'scaleToSize'.
|
||||
<span class="lineno"> 213 </span>embedDynamicImage :: DynamicImage -> SVG
|
||||
<span class="lineno"> 214 </span><span class="decl"><span class="nottickedoff">embedDynamicImage img = embedPng width height imgData</span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="nottickedoff">width = fromIntegral $ dynamicMap imageWidth img</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">height = fromIntegral $ dynamicMap imageHeight img</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="nottickedoff">imgData = case encodeDynamicPng img of</span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="nottickedoff">Left err -> error err</span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="nottickedoff">Right dat -> dat</span></span>
|
||||
<span class="lineno"> 221 </span>
|
||||
<span class="lineno"> 222 </span>-- embedImageFile :: FilePath -> Tree
|
||||
<span class="lineno"> 223 </span>-- embedImageFile path = unsafePerformIO $ do
|
||||
<span class="lineno"> 224 </span>-- png <- B.readFile path
|
||||
<span class="lineno"> 225 </span>-- case decodePng png of
|
||||
<span class="lineno"> 226 </span>-- Left{} -> error "bad image"
|
||||
<span class="lineno"> 227 </span>-- Right img -> return $
|
||||
<span class="lineno"> 228 </span>-- let width = fromIntegral $ dynamicMap imageWidth img
|
||||
<span class="lineno"> 229 </span>-- height = fromIntegral $ dynamicMap imageHeight img in
|
||||
<span class="lineno"> 230 </span>-- ImageTree $ defaultSvg
|
||||
<span class="lineno"> 231 </span>-- & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))
|
||||
<span class="lineno"> 232 </span>-- & Svg.imageWidth .~ Svg.Num width
|
||||
<span class="lineno"> 233 </span>-- & Svg.imageHeight .~ Svg.Num height
|
||||
<span class="lineno"> 234 </span>-- & Svg.imageHref .~ ("file://" ++ path)
|
||||
<span class="lineno"> 235 </span>
|
||||
<span class="lineno"> 236 </span>
|
||||
<span class="lineno"> 237 </span>-- | Convert an SVG object to a pixel-based image. The default resolution
|
||||
<span class="lineno"> 238 </span>-- is 2560x1440. See also 'rasterSized'. Multiple raster engines are supported
|
||||
<span class="lineno"> 239 </span>-- and are selected using the '--raster' flag in the driver.
|
||||
<span class="lineno"> 240 </span>raster :: SVG -> DynamicImage
|
||||
<span class="lineno"> 241 </span><span class="decl"><span class="nottickedoff">raster = rasterSized 2560 1440</span></span>
|
||||
<span class="lineno"> 242 </span>
|
||||
<span class="lineno"> 243 </span>-- | Convert an SVG object to a pixel-based image.
|
||||
<span class="lineno"> 244 </span>rasterSized
|
||||
<span class="lineno"> 245 </span> :: Width -- ^ X resolution in pixels
|
||||
<span class="lineno"> 246 </span> -> Height -- ^ Y resolution in pixels
|
||||
<span class="lineno"> 247 </span> -> SVG -- ^ SVG object
|
||||
<span class="lineno"> 248 </span> -> DynamicImage
|
||||
<span class="lineno"> 249 </span><span class="decl"><span class="nottickedoff">rasterSized w h svg = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="nottickedoff">png <- B.readFile (svgAsPngFile' w h svg)</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="nottickedoff">case decodePng png of</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="nottickedoff">Left{} -> error "bad image"</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="nottickedoff">Right img -> return img</span></span>
|
||||
<span class="lineno"> 254 </span>
|
||||
<span class="lineno"> 255 </span>-- | Use \'potrace\' to trace edges in a raster image and convert them to SVG polygons.
|
||||
<span class="lineno"> 256 </span>vectorize :: FilePath -> SVG
|
||||
<span class="lineno"> 257 </span><span class="decl"><span class="nottickedoff">vectorize = vectorize_ []</span></span>
|
||||
<span class="lineno"> 258 </span>
|
||||
<span class="lineno"> 259 </span>-- | Same as 'vectorize' but takes a list of arguments for \'potrace\'.
|
||||
<span class="lineno"> 260 </span>vectorize_ :: [String] -> FilePath -> SVG
|
||||
<span class="lineno"> 261 </span><span class="decl"><span class="nottickedoff">vectorize_ _ path | pNoExternals = mkText $ T.pack path</span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"></span><span class="nottickedoff">vectorize_ args path = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="nottickedoff">root <- getXdgDirectory XdgCache "reanimate"</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="nottickedoff">createDirectoryIfMissing True root</span>
|
||||
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = root </> encodeInt key <.> "svg"</span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="nottickedoff">hit <- doesFileExist svgPath</span>
|
||||
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="nottickedoff">unless hit $ withSystemTempFile "file.svg" $ \tmpSvgPath svgH -></span>
|
||||
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="nottickedoff">withSystemTempFile "file.bmp" $ \tmpBmpPath bmpH -> do</span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="nottickedoff">hClose svgH</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="nottickedoff">hClose bmpH</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="nottickedoff">potrace <- requireExecutable "potrace"</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="nottickedoff">magick <- requireExecutable magickCmd</span>
|
||||
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="nottickedoff">runCmd magick [path, "-flatten", tmpBmpPath]</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="nottickedoff">runCmd potrace (args ++ ["--svg", "--output", tmpSvgPath, tmpBmpPath])</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="nottickedoff">renameOrCopyFile tmpSvgPath svgPath</span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="nottickedoff">svg_data <- B.readFile svgPath</span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="nottickedoff">case parseSvgFile svgPath svg_data of</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> do</span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="nottickedoff">removeFile svgPath</span>
|
||||
<span class="lineno"> 280 </span><span class="spaces"> </span><span class="nottickedoff">error "Malformed svg"</span>
|
||||
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="nottickedoff">Just svg -> return $ unbox $ replaceUses svg</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="nottickedoff">where key = hash (path, args)</span></span>
|
||||
<span class="lineno"> 283 </span>
|
||||
<span class="lineno"> 284 </span>-- imageAsFile :: DynamicImage -> FilePath
|
||||
<span class="lineno"> 285 </span>-- imageAsFile img
|
||||
<span class="lineno"> 286 </span>
|
||||
<span class="lineno"> 287 </span>-- | Convert an SVG object to a pixel-based image and save it to disk, returning
|
||||
<span class="lineno"> 288 </span>-- the filepath. The default resolution is 2560x1440. See also 'svgAsPngFile''.
|
||||
<span class="lineno"> 289 </span>-- Multiple raster engines are supported and are selected using the '--raster'
|
||||
<span class="lineno"> 290 </span>-- flag in the driver.
|
||||
<span class="lineno"> 291 </span>svgAsPngFile :: SVG -> FilePath
|
||||
<span class="lineno"> 292 </span><span class="decl"><span class="nottickedoff">svgAsPngFile = svgAsPngFile' width height</span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="nottickedoff">width = 2560</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">height = width * 9 `div` 16</span></span>
|
||||
<span class="lineno"> 296 </span>
|
||||
<span class="lineno"> 297 </span>-- | Convert an SVG object to a pixel-based image and save it to disk, returning
|
||||
<span class="lineno"> 298 </span>-- the filepath.
|
||||
<span class="lineno"> 299 </span>svgAsPngFile'
|
||||
<span class="lineno"> 300 </span> :: Width -- ^ Width
|
||||
<span class="lineno"> 301 </span> -> Height -- ^ Height
|
||||
<span class="lineno"> 302 </span> -> SVG -- ^ SVG object
|
||||
<span class="lineno"> 303 </span> -> FilePath
|
||||
<span class="lineno"> 304 </span><span class="decl"><span class="nottickedoff">svgAsPngFile' _ _ _ | pNoExternals = "/svgAsPngFile/has/been/disabled"</span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"></span><span class="nottickedoff">svgAsPngFile' width height svg =</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="nottickedoff">unsafePerformIO $ cacheFile template $ \pngPath -> do</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = replaceExtension pngPath "svg"</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="nottickedoff">writeFile svgPath rendered</span>
|
||||
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="nottickedoff">engine <- requireRaster pRaster</span>
|
||||
<span class="lineno"> 310 </span><span class="spaces"> </span><span class="nottickedoff">applyRaster engine svgPath</span>
|
||||
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="nottickedoff">template = encodeInt (hash rendered) <.> "png"</span>
|
||||
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="nottickedoff">rendered = renderSvg (Just $ Px $ fromIntegral width)</span>
|
||||
<span class="lineno"> 314 </span><span class="spaces"> </span><span class="nottickedoff">(Just $ Px $ fromIntegral height)</span>
|
||||
<span class="lineno"> 315 </span><span class="spaces"> </span><span class="nottickedoff">svg</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
437
reanimate-0.4.2.0-inplace/Reanimate.Render.hs.html
Normal file
437
reanimate-0.4.2.0-inplace/Reanimate.Render.hs.html
Normal file
|
|
@ -0,0 +1,437 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE MultiWayIf #-}
|
||||
<span class="lineno"> 2 </span>{-|
|
||||
<span class="lineno"> 3 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 4 </span>License : Unlicense
|
||||
<span class="lineno"> 5 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 6 </span>Stability : experimental
|
||||
<span class="lineno"> 7 </span>Portability : POSIX
|
||||
<span class="lineno"> 8 </span>
|
||||
<span class="lineno"> 9 </span>Internal tools for rastering SVGs and rendering videos. You are unlikely
|
||||
<span class="lineno"> 10 </span>to ever directly use the functions in this module.
|
||||
<span class="lineno"> 11 </span>
|
||||
<span class="lineno"> 12 </span>-}
|
||||
<span class="lineno"> 13 </span>module Reanimate.Render
|
||||
<span class="lineno"> 14 </span> ( render
|
||||
<span class="lineno"> 15 </span> , renderSvgs
|
||||
<span class="lineno"> 16 </span> , renderSnippets -- :: Animation -> IO ()
|
||||
<span class="lineno"> 17 </span> , renderOneFrame
|
||||
<span class="lineno"> 18 </span> , Format(..)
|
||||
<span class="lineno"> 19 </span> , Raster(..)
|
||||
<span class="lineno"> 20 </span> , Width, Height, FPS
|
||||
<span class="lineno"> 21 </span> , requireRaster -- :: Raster -> IO Raster
|
||||
<span class="lineno"> 22 </span> , selectRaster -- :: Raster -> IO Raster
|
||||
<span class="lineno"> 23 </span> , applyRaster -- :: Raster -> FilePath -> IO ()
|
||||
<span class="lineno"> 24 </span> ) where
|
||||
<span class="lineno"> 25 </span>
|
||||
<span class="lineno"> 26 </span>import Control.Concurrent
|
||||
<span class="lineno"> 27 </span>import Control.Exception
|
||||
<span class="lineno"> 28 </span>import Control.Monad (forM_, forever, unless, void, when)
|
||||
<span class="lineno"> 29 </span>import Data.Either
|
||||
<span class="lineno"> 30 </span>import Data.Function
|
||||
<span class="lineno"> 31 </span>import qualified Data.Text as T
|
||||
<span class="lineno"> 32 </span>import qualified Data.Text.IO as T
|
||||
<span class="lineno"> 33 </span>import Data.Time
|
||||
<span class="lineno"> 34 </span>import Graphics.SvgTree (Number (..))
|
||||
<span class="lineno"> 35 </span>import Numeric
|
||||
<span class="lineno"> 36 </span>import Reanimate.Animation
|
||||
<span class="lineno"> 37 </span>import Reanimate.Driver.Check
|
||||
<span class="lineno"> 38 </span>import Reanimate.Driver.Magick
|
||||
<span class="lineno"> 39 </span>import Reanimate.Misc
|
||||
<span class="lineno"> 40 </span>import Reanimate.Parameters
|
||||
<span class="lineno"> 41 </span>import System.Console.ANSI.Codes
|
||||
<span class="lineno"> 42 </span>import System.Exit
|
||||
<span class="lineno"> 43 </span>import System.FileLock (withTryFileLock, SharedExclusive(..), unlockFile)
|
||||
<span class="lineno"> 44 </span>import System.Directory
|
||||
<span class="lineno"> 45 </span>import System.FilePath (replaceExtension, (<.>), (</>))
|
||||
<span class="lineno"> 46 </span>import System.IO
|
||||
<span class="lineno"> 47 </span>import Text.Printf (printf)
|
||||
<span class="lineno"> 48 </span>
|
||||
<span class="lineno"> 49 </span>idempotentFile :: FilePath -> IO () -> IO ()
|
||||
<span class="lineno"> 50 </span><span class="decl"><span class="nottickedoff">idempotentFile path action = do</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">_ <- withTryFileLock lockFile Exclusive $ \lock -> do</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="nottickedoff">haveFile <- doesFileExist path</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="nottickedoff">unless haveFile action</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="nottickedoff">unlockFile lock</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">_ <- try (removeFile lockFile) :: IO (Either SomeException ())</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">return ()</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">return ()</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">lockFile = path <.> "lock"</span></span>
|
||||
<span class="lineno"> 60 </span>
|
||||
<span class="lineno"> 61 </span>-- | Generate SVGs at 60fps and put them in a folder.
|
||||
<span class="lineno"> 62 </span>renderSvgs :: FilePath -> Int -> Bool -> Animation -> IO ()
|
||||
<span class="lineno"> 63 </span><span class="decl"><span class="nottickedoff">renderSvgs folder offset _prettyPrint ani = do</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="nottickedoff">print frameCount</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="nottickedoff">lock <- newMVar ()</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">handle errHandler $ concurrentForM_ (frameOrder rate frameCount) $ \nth' -> do</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">let nth = (nth'+offset) `mod` frameCount</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">frame = frameAt (if frameCount <= 1 then 0 else now) ani</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">svg = renderSvg Nothing Nothing frame</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">path = folder </> show nth <.> "svg"</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">idempotentFile path $ writeFile path svg</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">withMVar lock $ \_ -> do</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">print nth</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="nottickedoff">hFlush stdout</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="nottickedoff">rate = 60</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="nottickedoff">frameCount = round (duration ani * fromIntegral rate) :: Int</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="nottickedoff">errHandler (ErrorCall msg) = do</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn stderr msg</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="nottickedoff">exitWith (ExitFailure 1)</span></span>
|
||||
<span class="lineno"> 84 </span>
|
||||
<span class="lineno"> 85 </span>-- | Select a single frame that doesn't already exist in the output
|
||||
<span class="lineno"> 86 </span>-- folder and render it. If all frames have been rendered, print "Done".
|
||||
<span class="lineno"> 87 </span>renderOneFrame :: FilePath -> Int -> Bool -> Int -> Animation -> IO ()
|
||||
<span class="lineno"> 88 </span><span class="decl"><span class="nottickedoff">renderOneFrame folder offset _prettyPrint rate ani =</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="nottickedoff">worker (frameOrder rate frameCount)</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="nottickedoff">worker [] = putStrLn "Done"</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="nottickedoff">worker (x:xs) = do</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="nottickedoff">let nth = (x+offset) `mod` frameCount</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="nottickedoff">now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="nottickedoff">frame = frameAt (if frameCount <= 1 then 0 else now) ani</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="nottickedoff">svg = renderSvg Nothing Nothing frame</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">path = folder </> show nth <.> "svg"</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">tmpPath = path <.> "tmp"</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="nottickedoff">haveFile <- doesFileExist path</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="nottickedoff">if haveFile</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="nottickedoff">then worker xs</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="nottickedoff">else do</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="nottickedoff">writeFile tmpPath svg</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="nottickedoff">renameOrCopyFile tmpPath path</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="nottickedoff">print nth</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="nottickedoff">frameCount = round (duration ani * fromIntegral rate) :: Int</span></span>
|
||||
<span class="lineno"> 107 </span>
|
||||
<span class="lineno"> 108 </span>-- XXX: Merge with 'renderSvgs'
|
||||
<span class="lineno"> 109 </span>-- | Render 10 frames and print them to stdout. Used for testing.
|
||||
<span class="lineno"> 110 </span>--
|
||||
<span class="lineno"> 111 </span>-- XXX: Not related to the snippets in the playground.
|
||||
<span class="lineno"> 112 </span>renderSnippets :: Animation -> IO ()
|
||||
<span class="lineno"> 113 </span><span class="decl"><span class="istickedoff">renderSnippets ani = forM_ [0 .. frameCount - 1] $ \nth -> do</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff">let now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">frame = frameAt now ani</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">svg = renderSvg Nothing Nothing frame</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">putStr (show nth)</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">T.putStrLn $ T.concat . T.lines . T.pack $ svg</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">where frameCount = 10 :: Integer</span></span>
|
||||
<span class="lineno"> 120 </span>
|
||||
<span class="lineno"> 121 </span>frameOrder :: Int -> Int -> [Int]
|
||||
<span class="lineno"> 122 </span><span class="decl"><span class="nottickedoff">frameOrder fps nFrames = worker [] fps</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">worker _seen 0 = []</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">worker seen nthFrame = filterFrameList seen nthFrame nFrames</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">++ worker (nthFrame : seen) (nthFrame `div` 2)</span></span>
|
||||
<span class="lineno"> 127 </span>
|
||||
<span class="lineno"> 128 </span>filterFrameList :: [Int] -> Int -> Int -> [Int]
|
||||
<span class="lineno"> 129 </span><span class="decl"><span class="nottickedoff">filterFrameList seen nthFrame nFrames = filter (not . isSeen)</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">[0, nthFrame .. nFrames - 1]</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">where isSeen x = any (\y -> x `mod` y == 0) seen</span></span>
|
||||
<span class="lineno"> 132 </span>
|
||||
<span class="lineno"> 133 </span>-- | Video formats supported by reanimate.
|
||||
<span class="lineno"> 134 </span>data Format = RenderMp4 | RenderGif | RenderWebm
|
||||
<span class="lineno"> 135 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 136 </span>
|
||||
<span class="lineno"> 137 </span>mp4Arguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
|
||||
<span class="lineno"> 138 </span><span class="decl"><span class="nottickedoff">mp4Arguments fps progress template target =</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">[ "-r"</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="nottickedoff">, show fps</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="nottickedoff">, "-i"</span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="nottickedoff">, template</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="nottickedoff">, "-y"</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">, "-c:v"</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="nottickedoff">, "libx264"</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="nottickedoff">, "-vf"</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="nottickedoff">, "fps=" ++ show fps</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="nottickedoff">, "-preset"</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">, "slow"</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">, "-crf"</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">, "18"</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">, "-movflags"</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">, "+faststart"</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">, "-progress"</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">, progress</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">, "-pix_fmt"</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="nottickedoff">, "yuv420p"</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="nottickedoff">, target</span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
||||
<span class="lineno"> 160 </span>
|
||||
<span class="lineno"> 161 </span>-- gifArguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
|
||||
<span class="lineno"> 162 </span>-- gifArguments fps progress template target =
|
||||
<span class="lineno"> 163 </span>
|
||||
<span class="lineno"> 164 </span>-- | Render animation to a video file with given parameters.
|
||||
<span class="lineno"> 165 </span>render
|
||||
<span class="lineno"> 166 </span> :: Animation
|
||||
<span class="lineno"> 167 </span> -> FilePath
|
||||
<span class="lineno"> 168 </span> -> Raster
|
||||
<span class="lineno"> 169 </span> -> Format
|
||||
<span class="lineno"> 170 </span> -> Width
|
||||
<span class="lineno"> 171 </span> -> Height
|
||||
<span class="lineno"> 172 </span> -> FPS
|
||||
<span class="lineno"> 173 </span> -> Bool
|
||||
<span class="lineno"> 174 </span> -> IO ()
|
||||
<span class="lineno"> 175 </span><span class="decl"><span class="nottickedoff">render ani target raster format width height fps partial = do</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="nottickedoff">printf "Starting render of animation: %.1f\n" (duration ani)</span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="nottickedoff">ffmpeg <- requireExecutable "ffmpeg"</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">generateFrames raster ani width height fps partial $ \template -></span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">withTempFile "txt" $ \progress -> do</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">writeFile progress ""</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">progressH <- openFile progress ReadMode</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="nottickedoff">hSetBuffering progressH NoBuffering</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="nottickedoff">allFinished <- newEmptyMVar</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="nottickedoff">void $ forkIO $ do</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff">progressPrinter "rendered" (animationFrameCount ani fps)</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff">$ \done -> fix $ \loop -> do</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff">eof <- hIsEOF progressH</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="nottickedoff">if eof</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="nottickedoff">then threadDelay 1000000 >> loop</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="nottickedoff">else do</span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="nottickedoff">l <- try (hGetLine progressH)</span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="nottickedoff">case l of</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="nottickedoff">Left SomeException{} -> return ()</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="nottickedoff">Right str -></span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="nottickedoff">case take 6 str of</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="nottickedoff">"frame=" -> do</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="nottickedoff">void $ swapMVar done (read (drop 6 str))</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="nottickedoff">loop</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="nottickedoff">_ | str == "progress=end" -> return ()</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="nottickedoff">_ -> loop</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="nottickedoff">putMVar allFinished ()</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="nottickedoff">case format of</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="nottickedoff">RenderMp4 -> runCmd ffmpeg (mp4Arguments fps progress template target)</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="nottickedoff">RenderGif -> withTempFile "png" $ \palette -> do</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="nottickedoff">runCmd</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="nottickedoff">ffmpeg</span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="nottickedoff">[ "-i"</span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="nottickedoff">, template</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="nottickedoff">, "-y"</span>
|
||||
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="nottickedoff">, "-vf"</span>
|
||||
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="nottickedoff">, "fps="</span>
|
||||
<span class="lineno"> 212 </span><span class="spaces"> </span><span class="nottickedoff">++ show fps</span>
|
||||
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="nottickedoff">++ ",scale="</span>
|
||||
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="nottickedoff">++ show width</span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="nottickedoff">++ ":"</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="nottickedoff">++ show height</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">++ ":flags=lanczos,palettegen"</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="nottickedoff">, "-t"</span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="nottickedoff">, showFFloat Nothing (duration ani) ""</span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="nottickedoff">, palette</span>
|
||||
<span class="lineno"> 221 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="nottickedoff">runCmd</span>
|
||||
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="nottickedoff">ffmpeg</span>
|
||||
<span class="lineno"> 224 </span><span class="spaces"> </span><span class="nottickedoff">[ "-framerate"</span>
|
||||
<span class="lineno"> 225 </span><span class="spaces"> </span><span class="nottickedoff">, show fps</span>
|
||||
<span class="lineno"> 226 </span><span class="spaces"> </span><span class="nottickedoff">, "-i"</span>
|
||||
<span class="lineno"> 227 </span><span class="spaces"> </span><span class="nottickedoff">, template</span>
|
||||
<span class="lineno"> 228 </span><span class="spaces"> </span><span class="nottickedoff">, "-y"</span>
|
||||
<span class="lineno"> 229 </span><span class="spaces"> </span><span class="nottickedoff">, "-i"</span>
|
||||
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="nottickedoff">, palette</span>
|
||||
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="nottickedoff">, "-progress"</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="nottickedoff">, progress</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="nottickedoff">, "-filter_complex"</span>
|
||||
<span class="lineno"> 234 </span><span class="spaces"> </span><span class="nottickedoff">, "fps="</span>
|
||||
<span class="lineno"> 235 </span><span class="spaces"> </span><span class="nottickedoff">++ show fps</span>
|
||||
<span class="lineno"> 236 </span><span class="spaces"> </span><span class="nottickedoff">++ ",scale="</span>
|
||||
<span class="lineno"> 237 </span><span class="spaces"> </span><span class="nottickedoff">++ show width</span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="nottickedoff">++ ":"</span>
|
||||
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="nottickedoff">++ show height</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="nottickedoff">++ ":flags=lanczos[x];[x][1:v]paletteuse"</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="nottickedoff">, "-t"</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="nottickedoff">, showFFloat Nothing (duration ani) ""</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="nottickedoff">, target</span>
|
||||
<span class="lineno"> 244 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 245 </span><span class="spaces"> </span><span class="nottickedoff">RenderWebm -> runCmd</span>
|
||||
<span class="lineno"> 246 </span><span class="spaces"> </span><span class="nottickedoff">ffmpeg</span>
|
||||
<span class="lineno"> 247 </span><span class="spaces"> </span><span class="nottickedoff">[ "-r"</span>
|
||||
<span class="lineno"> 248 </span><span class="spaces"> </span><span class="nottickedoff">, show fps</span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="nottickedoff">, "-i"</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="nottickedoff">, template</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="nottickedoff">, "-y"</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="nottickedoff">, "-progress"</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="nottickedoff">, progress</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="nottickedoff">, "-c:v"</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="nottickedoff">, "libvpx-vp9"</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="nottickedoff">, "-vf"</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="nottickedoff">, "fps=" ++ show fps</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="nottickedoff">, target</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="nottickedoff">takeMVar allFinished</span></span>
|
||||
<span class="lineno"> 261 </span>
|
||||
<span class="lineno"> 262 </span>---------------------------------------------------------------------------------
|
||||
<span class="lineno"> 263 </span>-- Helpers
|
||||
<span class="lineno"> 264 </span>
|
||||
<span class="lineno"> 265 </span>progressPrinter :: String -> Int -> (MVar Int -> IO ()) -> IO ()
|
||||
<span class="lineno"> 266 </span><span class="decl"><span class="nottickedoff">progressPrinter typeName maxCount action = do</span>
|
||||
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="nottickedoff">printf "\rFrames %s: 0/%d" typeName maxCount</span>
|
||||
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="nottickedoff">putStr $ clearFromCursorToLineEndCode ++ "\r"</span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="nottickedoff">done <- newMVar (0 :: Int)</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="nottickedoff">start <- getCurrentTime</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="nottickedoff">let bgThread = forever $ do</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="nottickedoff">nDone <- readMVar done</span>
|
||||
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="nottickedoff">now <- getCurrentTime</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="nottickedoff">let spent = diffUTCTime now start</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="nottickedoff">remaining =</span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="nottickedoff">(spent / (fromIntegral nDone / fromIntegral maxCount)) - spent</span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="nottickedoff">printf "\rFrames %s: %d/%d" typeName nDone maxCount</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="nottickedoff">putStr $ ", time spent: " ++ ppDiff spent</span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="nottickedoff">unless (nDone == 0) $ do</span>
|
||||
<span class="lineno"> 280 </span><span class="spaces"> </span><span class="nottickedoff">putStr $ ", time remaining: " ++ ppDiff remaining</span>
|
||||
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="nottickedoff">putStr $ ", total time: " ++ ppDiff (remaining + spent)</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="nottickedoff">putStr $ clearFromCursorToLineEndCode ++ "\r"</span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="nottickedoff">hFlush stdout</span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="nottickedoff">threadDelay 1000000</span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="nottickedoff">withBackgroundThread bgThread $ action done</span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="nottickedoff">now <- getCurrentTime</span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="nottickedoff">let spent = diffUTCTime now start</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="nottickedoff">printf "\rFrames %s: %d/%d" typeName maxCount maxCount</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="nottickedoff">putStr $ ", time spent: " ++ ppDiff spent</span>
|
||||
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="nottickedoff">putStr $ clearFromCursorToLineEndCode ++ "\n"</span></span>
|
||||
<span class="lineno"> 291 </span>
|
||||
<span class="lineno"> 292 </span>animationFrameCount :: Animation -> FPS -> Int
|
||||
<span class="lineno"> 293 </span><span class="decl"><span class="nottickedoff">animationFrameCount ani rate = round (duration ani * fromIntegral rate) :: Int</span></span>
|
||||
<span class="lineno"> 294 </span>
|
||||
<span class="lineno"> 295 </span>generateFrames
|
||||
<span class="lineno"> 296 </span> :: Raster -> Animation -> Width -> Height -> FPS -> Bool -> (FilePath -> IO a) -> IO a
|
||||
<span class="lineno"> 297 </span><span class="decl"><span class="nottickedoff">generateFrames raster ani width_ height_ rate partial action = withTempDir $ \tmp -> do</span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="nottickedoff">let frameName nth = tmp </> printf nameTemplate nth</span>
|
||||
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="nottickedoff">setRootDirectory tmp</span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="nottickedoff">progressPrinter "generated" frameCount</span>
|
||||
<span class="lineno"> 301 </span><span class="spaces"> </span><span class="nottickedoff">$ \done -> handle h $ concurrentForM_ frames $ \n -> do</span>
|
||||
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="nottickedoff">writeFile (frameName n) $ renderSvg width height $ nthFrame n</span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="nottickedoff">modifyMVar_ done $ \nDone -> return (nDone + 1)</span>
|
||||
<span class="lineno"> 304 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="nottickedoff">when (isValidRaster raster)</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="nottickedoff">$ progressPrinter "rastered" frameCount</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">$ \done -> handle h $ concurrentForM_ frames $ \n -> do</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="nottickedoff">applyRaster raster (frameName n)</span>
|
||||
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="nottickedoff">modifyMVar_ done $ \nDone -> return (nDone + 1)</span>
|
||||
<span class="lineno"> 310 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="nottickedoff">action (tmp </> rasterTemplate raster)</span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="nottickedoff">isValidRaster RasterNone = False</span>
|
||||
<span class="lineno"> 314 </span><span class="spaces"> </span><span class="nottickedoff">isValidRaster RasterAuto = False</span>
|
||||
<span class="lineno"> 315 </span><span class="spaces"> </span><span class="nottickedoff">isValidRaster _ = True</span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="nottickedoff">width = Just $ Px $ fromIntegral width_</span>
|
||||
<span class="lineno"> 318 </span><span class="spaces"> </span><span class="nottickedoff">height = Just $ Px $ fromIntegral height_</span>
|
||||
<span class="lineno"> 319 </span><span class="spaces"> </span><span class="nottickedoff">h UserInterrupt | partial = do</span>
|
||||
<span class="lineno"> 320 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn</span>
|
||||
<span class="lineno"> 321 </span><span class="spaces"> </span><span class="nottickedoff">stderr</span>
|
||||
<span class="lineno"> 322 </span><span class="spaces"> </span><span class="nottickedoff">"\nCtrl-C detected. Trying to generate video with available frames. \</span>
|
||||
<span class="lineno"> 323 </span><span class="spaces"> </span><span class="nottickedoff">\Hit ctrl-c again to abort."</span>
|
||||
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="nottickedoff">return ()</span>
|
||||
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="nottickedoff">h other = throwIO other</span>
|
||||
<span class="lineno"> 326 </span><span class="spaces"> </span><span class="nottickedoff">-- frames = [0..frameCount-1]</span>
|
||||
<span class="lineno"> 327 </span><span class="spaces"> </span><span class="nottickedoff">frames = frameOrder rate frameCount</span>
|
||||
<span class="lineno"> 328 </span><span class="spaces"> </span><span class="nottickedoff">nthFrame nth = frameAt (recip (fromIntegral rate) * fromIntegral nth) ani</span>
|
||||
<span class="lineno"> 329 </span><span class="spaces"> </span><span class="nottickedoff">frameCount = animationFrameCount ani rate</span>
|
||||
<span class="lineno"> 330 </span><span class="spaces"> </span><span class="nottickedoff">nameTemplate :: String</span>
|
||||
<span class="lineno"> 331 </span><span class="spaces"> </span><span class="nottickedoff">nameTemplate = "render-%05d.svg"</span></span>
|
||||
<span class="lineno"> 332 </span>
|
||||
<span class="lineno"> 333 </span>withBackgroundThread :: IO () -> IO a -> IO a
|
||||
<span class="lineno"> 334 </span><span class="decl"><span class="nottickedoff">withBackgroundThread t = bracket (forkIO t) killThread . const</span></span>
|
||||
<span class="lineno"> 335 </span>
|
||||
<span class="lineno"> 336 </span>ppDiff :: NominalDiffTime -> String
|
||||
<span class="lineno"> 337 </span><span class="decl"><span class="nottickedoff">ppDiff diff | hours == 0 && mins == 0 = show secs ++ "s"</span>
|
||||
<span class="lineno"> 338 </span><span class="spaces"> </span><span class="nottickedoff">| hours == 0 = printf "%.2d:%.2d" mins secs</span>
|
||||
<span class="lineno"> 339 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = printf "%.2d:%.2d:%.2d" hours mins secs</span>
|
||||
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="nottickedoff">(osecs, secs) = round diff `divMod` (60 :: Int)</span>
|
||||
<span class="lineno"> 342 </span><span class="spaces"> </span><span class="nottickedoff">(hours, mins) = osecs `divMod` 60</span></span>
|
||||
<span class="lineno"> 343 </span>
|
||||
<span class="lineno"> 344 </span>rasterTemplate :: Raster -> String
|
||||
<span class="lineno"> 345 </span><span class="decl"><span class="nottickedoff">rasterTemplate RasterNone = "render-%05d.svg"</span>
|
||||
<span class="lineno"> 346 </span><span class="spaces"></span><span class="nottickedoff">rasterTemplate RasterAuto = "render-%05d.svg"</span>
|
||||
<span class="lineno"> 347 </span><span class="spaces"></span><span class="nottickedoff">rasterTemplate _ = "render-%05d.png"</span></span>
|
||||
<span class="lineno"> 348 </span>
|
||||
<span class="lineno"> 349 </span>-- | Resolve RasterNone and RasterAuto. If no valid raster can
|
||||
<span class="lineno"> 350 </span>-- be found, exit with an error message.
|
||||
<span class="lineno"> 351 </span>requireRaster :: Raster -> IO Raster
|
||||
<span class="lineno"> 352 </span><span class="decl"><span class="nottickedoff">requireRaster raster = do</span>
|
||||
<span class="lineno"> 353 </span><span class="spaces"> </span><span class="nottickedoff">raster' <- selectRaster (if raster == RasterNone then RasterAuto else raster)</span>
|
||||
<span class="lineno"> 354 </span><span class="spaces"> </span><span class="nottickedoff">case raster' of</span>
|
||||
<span class="lineno"> 355 </span><span class="spaces"> </span><span class="nottickedoff">RasterNone -> do</span>
|
||||
<span class="lineno"> 356 </span><span class="spaces"> </span><span class="nottickedoff">hPutStrLn</span>
|
||||
<span class="lineno"> 357 </span><span class="spaces"> </span><span class="nottickedoff">stderr</span>
|
||||
<span class="lineno"> 358 </span><span class="spaces"> </span><span class="nottickedoff">"Raster required but none could be found. \</span>
|
||||
<span class="lineno"> 359 </span><span class="spaces"> </span><span class="nottickedoff">\Please install either inkscape, imagemagick, or rsvg-convert."</span>
|
||||
<span class="lineno"> 360 </span><span class="spaces"> </span><span class="nottickedoff">exitWith (ExitFailure 1)</span>
|
||||
<span class="lineno"> 361 </span><span class="spaces"> </span><span class="nottickedoff">_ -> pure raster'</span></span>
|
||||
<span class="lineno"> 362 </span>
|
||||
<span class="lineno"> 363 </span>-- | Resolve RasterNone and RasterAuto. If no valid raster can
|
||||
<span class="lineno"> 364 </span>-- be found, return RasterNone.
|
||||
<span class="lineno"> 365 </span>selectRaster :: Raster -> IO Raster
|
||||
<span class="lineno"> 366 </span><span class="decl"><span class="nottickedoff">selectRaster RasterAuto = do</span>
|
||||
<span class="lineno"> 367 </span><span class="spaces"> </span><span class="nottickedoff">rsvg <- hasRSvg</span>
|
||||
<span class="lineno"> 368 </span><span class="spaces"> </span><span class="nottickedoff">ink <- hasInkscape</span>
|
||||
<span class="lineno"> 369 </span><span class="spaces"> </span><span class="nottickedoff">magick <- hasMagick</span>
|
||||
<span class="lineno"> 370 </span><span class="spaces"> </span><span class="nottickedoff">if</span>
|
||||
<span class="lineno"> 371 </span><span class="spaces"> </span><span class="nottickedoff">| isRight rsvg -> pure RasterRSvg</span>
|
||||
<span class="lineno"> 372 </span><span class="spaces"> </span><span class="nottickedoff">| isRight ink -> pure RasterInkscape</span>
|
||||
<span class="lineno"> 373 </span><span class="spaces"> </span><span class="nottickedoff">| isRight magick -> pure RasterMagick</span>
|
||||
<span class="lineno"> 374 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise -> pure RasterNone</span>
|
||||
<span class="lineno"> 375 </span><span class="spaces"></span><span class="nottickedoff">selectRaster r = pure r</span></span>
|
||||
<span class="lineno"> 376 </span>
|
||||
<span class="lineno"> 377 </span>-- | Convert SVG file to a PNG file with selected raster engine. If
|
||||
<span class="lineno"> 378 </span>-- raster engine is RasterAuto or RasterNone, do nothing.
|
||||
<span class="lineno"> 379 </span>applyRaster :: Raster -> FilePath -> IO ()
|
||||
<span class="lineno"> 380 </span><span class="decl"><span class="nottickedoff">applyRaster RasterNone _ = return ()</span>
|
||||
<span class="lineno"> 381 </span><span class="spaces"></span><span class="nottickedoff">applyRaster RasterAuto _ = return ()</span>
|
||||
<span class="lineno"> 382 </span><span class="spaces"></span><span class="nottickedoff">applyRaster RasterInkscape path = runCmd</span>
|
||||
<span class="lineno"> 383 </span><span class="spaces"> </span><span class="nottickedoff">"inkscape"</span>
|
||||
<span class="lineno"> 384 </span><span class="spaces"> </span><span class="nottickedoff">[ "--without-gui"</span>
|
||||
<span class="lineno"> 385 </span><span class="spaces"> </span><span class="nottickedoff">, "--file=" ++ path</span>
|
||||
<span class="lineno"> 386 </span><span class="spaces"> </span><span class="nottickedoff">, "--export-png=" ++ replaceExtension path "png"</span>
|
||||
<span class="lineno"> 387 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
||||
<span class="lineno"> 388 </span><span class="spaces"></span><span class="nottickedoff">applyRaster RasterRSvg path = runCmd</span>
|
||||
<span class="lineno"> 389 </span><span class="spaces"> </span><span class="nottickedoff">"rsvg-convert"</span>
|
||||
<span class="lineno"> 390 </span><span class="spaces"> </span><span class="nottickedoff">[path, "--unlimited", "--output", replaceExtension path "png"]</span>
|
||||
<span class="lineno"> 391 </span><span class="spaces"></span><span class="nottickedoff">applyRaster RasterMagick path =</span>
|
||||
<span class="lineno"> 392 </span><span class="spaces"> </span><span class="nottickedoff">runCmd magickCmd [path, replaceExtension path "png"]</span></span>
|
||||
<span class="lineno"> 393 </span>
|
||||
<span class="lineno"> 394 </span>concurrentForM_ :: [a] -> (a -> IO ()) -> IO ()
|
||||
<span class="lineno"> 395 </span><span class="decl"><span class="nottickedoff">concurrentForM_ lst action = do</span>
|
||||
<span class="lineno"> 396 </span><span class="spaces"> </span><span class="nottickedoff">n <- getNumCapabilities</span>
|
||||
<span class="lineno"> 397 </span><span class="spaces"> </span><span class="nottickedoff">sem <- newQSemN n</span>
|
||||
<span class="lineno"> 398 </span><span class="spaces"> </span><span class="nottickedoff">eVar <- newEmptyMVar</span>
|
||||
<span class="lineno"> 399 </span><span class="spaces"> </span><span class="nottickedoff">forM_ lst $ \elt -> do</span>
|
||||
<span class="lineno"> 400 </span><span class="spaces"> </span><span class="nottickedoff">waitQSemN sem 1</span>
|
||||
<span class="lineno"> 401 </span><span class="spaces"> </span><span class="nottickedoff">emp <- isEmptyMVar eVar</span>
|
||||
<span class="lineno"> 402 </span><span class="spaces"> </span><span class="nottickedoff">if emp</span>
|
||||
<span class="lineno"> 403 </span><span class="spaces"> </span><span class="nottickedoff">then</span>
|
||||
<span class="lineno"> 404 </span><span class="spaces"> </span><span class="nottickedoff">void</span>
|
||||
<span class="lineno"> 405 </span><span class="spaces"> </span><span class="nottickedoff">$ forkIO</span>
|
||||
<span class="lineno"> 406 </span><span class="spaces"> </span><span class="nottickedoff">( catch (action elt) (void . tryPutMVar eVar)</span>
|
||||
<span class="lineno"> 407 </span><span class="spaces"> </span><span class="nottickedoff">`finally` signalQSemN sem 1</span>
|
||||
<span class="lineno"> 408 </span><span class="spaces"> </span><span class="nottickedoff">)</span>
|
||||
<span class="lineno"> 409 </span><span class="spaces"> </span><span class="nottickedoff">else signalQSemN sem 1</span>
|
||||
<span class="lineno"> 410 </span><span class="spaces"> </span><span class="nottickedoff">waitQSemN sem n</span>
|
||||
<span class="lineno"> 411 </span><span class="spaces"> </span><span class="nottickedoff">mbE <- tryTakeMVar eVar</span>
|
||||
<span class="lineno"> 412 </span><span class="spaces"> </span><span class="nottickedoff">case mbE of</span>
|
||||
<span class="lineno"> 413 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> return ()</span>
|
||||
<span class="lineno"> 414 </span><span class="spaces"> </span><span class="nottickedoff">Just e -> throwIO (e :: SomeException)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
1203
reanimate-0.4.2.0-inplace/Reanimate.Scene.hs.html
Normal file
1203
reanimate-0.4.2.0-inplace/Reanimate.Scene.hs.html
Normal file
File diff suppressed because it is too large
Load diff
153
reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox.hs.html
Normal file
153
reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox.hs.html
Normal file
|
|
@ -0,0 +1,153 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span> Bounding-boxes can be immensely useful for aligning objects
|
||||
<span class="lineno"> 3 </span> but they are not part of the SVG specification and cannot be
|
||||
<span class="lineno"> 4 </span> computed for all SVG nodes. In particular, you'll get bad results
|
||||
<span class="lineno"> 5 </span> when asking for the bounding boxes of Text nodes (because fonts
|
||||
<span class="lineno"> 6 </span> are difficult), clipped nodes, and filtered nodes.
|
||||
<span class="lineno"> 7 </span>-}
|
||||
<span class="lineno"> 8 </span>module Reanimate.Svg.BoundingBox
|
||||
<span class="lineno"> 9 </span> ( boundingBox
|
||||
<span class="lineno"> 10 </span> , svgHeight
|
||||
<span class="lineno"> 11 </span> , svgWidth
|
||||
<span class="lineno"> 12 </span> ) where
|
||||
<span class="lineno"> 13 </span>
|
||||
<span class="lineno"> 14 </span>import Control.Arrow ((***))
|
||||
<span class="lineno"> 15 </span>import Control.Lens ((^.))
|
||||
<span class="lineno"> 16 </span>import Data.List
|
||||
<span class="lineno"> 17 </span>import Data.Maybe (mapMaybe)
|
||||
<span class="lineno"> 18 </span>import qualified Data.Vector.Unboxed as V
|
||||
<span class="lineno"> 19 </span>import qualified Geom2D.CubicBezier.Linear as Bezier
|
||||
<span class="lineno"> 20 </span>import Graphics.SvgTree hiding (height, line, path, use, width)
|
||||
<span class="lineno"> 21 </span>import Linear.V2 hiding (angle)
|
||||
<span class="lineno"> 22 </span>import Linear.Vector
|
||||
<span class="lineno"> 23 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 24 </span>import Reanimate.Svg.LineCommand
|
||||
<span class="lineno"> 25 </span>import qualified Reanimate.Transform as Transform
|
||||
<span class="lineno"> 26 </span>
|
||||
<span class="lineno"> 27 </span>-- | Return bounding box of SVG tree.
|
||||
<span class="lineno"> 28 </span>-- The four numbers returned are (minimal X-coordinate, minimal Y-coordinate, width, height)
|
||||
<span class="lineno"> 29 </span>--
|
||||
<span class="lineno"> 30 </span>-- Note: Bounding boxes are computed on a best-effort basis and will not work
|
||||
<span class="lineno"> 31 </span>-- in all cases. The only supported SVG nodes are: path, circle, polyline,
|
||||
<span class="lineno"> 32 </span>-- ellipse, line, rectangle, image. All other nodes return (0,0,0,0).
|
||||
<span class="lineno"> 33 </span>boundingBox :: Tree -> (Double, Double, Double, Double)
|
||||
<span class="lineno"> 34 </span><span class="decl"><span class="istickedoff">boundingBox t =</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="istickedoff">case svgBoundingPoints t of</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="istickedoff">[] -> (0,0,0,0)</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">(V2 x y:rest) -></span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">let (minx, miny, maxx, maxy) = foldl' worker (x, y, x, y) rest</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">in (minx, miny, maxx-minx, maxy-miny)</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">worker (minx, miny, maxx, maxy) (V2 x y) =</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">(min minx x, min miny y, max maxx x, max maxy y)</span></span>
|
||||
<span class="lineno"> 43 </span>
|
||||
<span class="lineno"> 44 </span>-- | Height of SVG node in local units (not pixels). Computed on best-effort basis
|
||||
<span class="lineno"> 45 </span>-- and will not give accurate results for all SVG nodes.
|
||||
<span class="lineno"> 46 </span>svgHeight :: Tree -> Double
|
||||
<span class="lineno"> 47 </span><span class="decl"><span class="nottickedoff">svgHeight t = h</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, _w, h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 50 </span>
|
||||
<span class="lineno"> 51 </span>-- | Width of SVG node in local units (not pixels). Computed on best-effort basis
|
||||
<span class="lineno"> 52 </span>-- and will not give accurate results for all SVG nodes.
|
||||
<span class="lineno"> 53 </span>svgWidth :: Tree -> Double
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">svgWidth t = w</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, w, _h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 57 </span>
|
||||
<span class="lineno"> 58 </span>-- | Sampling of points in a line path.
|
||||
<span class="lineno"> 59 </span>linePoints :: [LineCommand] -> [RPoint]
|
||||
<span class="lineno"> 60 </span><span class="decl"><span class="nottickedoff">linePoints = worker zero</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">worker _from [] = []</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="nottickedoff">worker from (x:xs) =</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="nottickedoff">case x of</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="nottickedoff">LineMove to -> worker to xs</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="nottickedoff">-- LineDraw to -> from:to:worker to xs</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">LineBezier [p] -></span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">p : worker p xs</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">LineBezier ctrl -> -- approximation</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">let bezier = Bezier.AnyBezier (V.fromList (from:ctrl))</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">in [ Bezier.evalBezier bezier (recip chunks*i) | i <- [0..chunks]] ++</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">worker (last ctrl) xs</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">LineEnd p -> p : worker p xs</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="nottickedoff">chunks = 10</span></span>
|
||||
<span class="lineno"> 75 </span>
|
||||
<span class="lineno"> 76 </span>svgBoundingPoints :: Tree -> [RPoint]
|
||||
<span class="lineno"> 77 </span><span class="decl"><span class="istickedoff">svgBoundingPoints t = map (Transform.transformPoint m) $</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="istickedoff">case t of</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="istickedoff">None -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="istickedoff">UseTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -> concatMap svgBoundingPoints (g^.groupChildren)</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">SymbolTree (Symbol g) -> <span class="nottickedoff">concatMap svgBoundingPoints (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">FilterTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">DefinitionTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">PathTree p -> <span class="nottickedoff">linePoints $ toLineCommands (p^.pathDefinition)</span></span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">CircleTree c -> <span class="nottickedoff">circleBoundingPoints c</span></span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">PolyLineTree pl -> <span class="nottickedoff">pl ^. polyLinePoints</span></span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">EllipseTree e -> <span class="nottickedoff">ellipseBoundingPoints e</span></span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">LineTree line -> <span class="nottickedoff">map pointToRPoint [line^.linePoint1, line^.linePoint2]</span></span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff">RectangleTree rect -></span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case pointToRPoint (rect^.rectUpperLeftCorner) of</span></span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">V2 x y -> V2 x y :</span></span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case mapTuple (fmap $ toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of</span></span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)]</span></span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">TextTree{} -> []</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">ImageTree img -></span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff">((Num x, Num y), Num w, Num h) -></span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="istickedoff">[V2 x y, V2 (x+w) (y+h)]</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="istickedoff">MeshGradientTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="istickedoff">m = Transform.mkMatrix (t^.transform)</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mapTuple f = f *** f</span></span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pointToRPoint p =</span></span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case mapTuple (toUserUnit defaultDPI) p of</span></span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(Num x, Num y) -> V2 x y</span></span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."</span></span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">circleBoundingPoints circ =</span></span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let (xnum, ynum) = circ ^. circleCenter</span></span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">rnum = circ ^. circleRadius</span></span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in case mapMaybe unpackNumber [xnum, ynum, rnum] of</span></span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[x, y, r] -> [ V2 (x + r * cos angle) (y + r * sin angle) | angle <- [0, pi/10 .. 2 * pi]]</span></span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">ellipseBoundingPoints e =</span></span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let (xnum,ynum) = e ^. ellipseCenter</span></span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">xrnum = e ^. ellipseXRadius</span></span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">yrnum = e ^. ellipseYRadius</span></span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in case mapMaybe unpackNumber [xnum, ynum, xrnum, yrnum] of</span></span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[x,y,xr,yr] -> [V2 (x + xr * cos angle) (y + yr * sin angle) | angle <- [0, pi/10 .. 2 * pi]]</span></span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">unpackNumber n =</span></span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case toUserUnit defaultDPI n of</span></span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Num d -> Just d</span></span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> Nothing</span></span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
444
reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors.hs.html
Normal file
444
reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors.hs.html
Normal file
|
|
@ -0,0 +1,444 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-| Functions for creating basic SVG elements and applying transformations to them. -}
|
||||
<span class="lineno"> 2 </span>module Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 3 </span> ( -- * Primitive shapes
|
||||
<span class="lineno"> 4 </span> mkCircle
|
||||
<span class="lineno"> 5 </span> , mkEllipse
|
||||
<span class="lineno"> 6 </span> , mkRect
|
||||
<span class="lineno"> 7 </span> , mkLine
|
||||
<span class="lineno"> 8 </span> , mkPath
|
||||
<span class="lineno"> 9 </span> , mkPathString
|
||||
<span class="lineno"> 10 </span> , mkPathText
|
||||
<span class="lineno"> 11 </span> , mkLinePath
|
||||
<span class="lineno"> 12 </span> , mkLinePathClosed
|
||||
<span class="lineno"> 13 </span> , mkClipPath
|
||||
<span class="lineno"> 14 </span> , mkText
|
||||
<span class="lineno"> 15 </span> -- * Grouping shapes and definitions
|
||||
<span class="lineno"> 16 </span> , mkGroup
|
||||
<span class="lineno"> 17 </span> , mkDefinitions
|
||||
<span class="lineno"> 18 </span> , mkUse
|
||||
<span class="lineno"> 19 </span> -- * Attributes
|
||||
<span class="lineno"> 20 </span> , withId
|
||||
<span class="lineno"> 21 </span> , withStrokeColor
|
||||
<span class="lineno"> 22 </span> , withStrokeColorPixel
|
||||
<span class="lineno"> 23 </span> , withStrokeDashArray
|
||||
<span class="lineno"> 24 </span> , withStrokeLineJoin
|
||||
<span class="lineno"> 25 </span> , withFillColor
|
||||
<span class="lineno"> 26 </span> , withFillColorPixel
|
||||
<span class="lineno"> 27 </span> , withFillOpacity
|
||||
<span class="lineno"> 28 </span> , withGroupOpacity
|
||||
<span class="lineno"> 29 </span> , withStrokeWidth
|
||||
<span class="lineno"> 30 </span> , withClipPathRef
|
||||
<span class="lineno"> 31 </span> -- * Transformations
|
||||
<span class="lineno"> 32 </span> , center
|
||||
<span class="lineno"> 33 </span> , centerX
|
||||
<span class="lineno"> 34 </span> , centerY
|
||||
<span class="lineno"> 35 </span> , centerUsing
|
||||
<span class="lineno"> 36 </span> , translate
|
||||
<span class="lineno"> 37 </span> , rotate
|
||||
<span class="lineno"> 38 </span> , rotateAroundCenter
|
||||
<span class="lineno"> 39 </span> , rotateAround
|
||||
<span class="lineno"> 40 </span> , scale
|
||||
<span class="lineno"> 41 </span> , scaleToSize
|
||||
<span class="lineno"> 42 </span> , scaleToWidth
|
||||
<span class="lineno"> 43 </span> , scaleToHeight
|
||||
<span class="lineno"> 44 </span> , scaleXY
|
||||
<span class="lineno"> 45 </span> , flipXAxis
|
||||
<span class="lineno"> 46 </span> , flipYAxis
|
||||
<span class="lineno"> 47 </span> , aroundCenter
|
||||
<span class="lineno"> 48 </span> , aroundCenterX
|
||||
<span class="lineno"> 49 </span> , aroundCenterY
|
||||
<span class="lineno"> 50 </span> , withTransformations
|
||||
<span class="lineno"> 51 </span> , withViewBox
|
||||
<span class="lineno"> 52 </span> -- * Other
|
||||
<span class="lineno"> 53 </span> , mkColor
|
||||
<span class="lineno"> 54 </span> , mkBackground
|
||||
<span class="lineno"> 55 </span> , mkBackgroundPixel
|
||||
<span class="lineno"> 56 </span> , gridLayout
|
||||
<span class="lineno"> 57 </span>
|
||||
<span class="lineno"> 58 </span> ) where
|
||||
<span class="lineno"> 59 </span>
|
||||
<span class="lineno"> 60 </span>import Codec.Picture (PixelRGBA8 (..))
|
||||
<span class="lineno"> 61 </span>import Control.Lens ((&), (.~), (?~))
|
||||
<span class="lineno"> 62 </span>import Data.Attoparsec.Text (parseOnly)
|
||||
<span class="lineno"> 63 </span>import qualified Data.Map as Map
|
||||
<span class="lineno"> 64 </span>import qualified Data.Text as T
|
||||
<span class="lineno"> 65 </span>import Graphics.SvgTree hiding (height, line, path, use,
|
||||
<span class="lineno"> 66 </span> width)
|
||||
<span class="lineno"> 67 </span>import Graphics.SvgTree.NamedColors
|
||||
<span class="lineno"> 68 </span>import Graphics.SvgTree.PathParser
|
||||
<span class="lineno"> 69 </span>import Linear.V2 hiding (angle)
|
||||
<span class="lineno"> 70 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 71 </span>import Reanimate.Svg.BoundingBox
|
||||
<span class="lineno"> 72 </span>
|
||||
<span class="lineno"> 73 </span>-- | Apply list of transformations to given image.
|
||||
<span class="lineno"> 74 </span>withTransformations :: [Transformation] -> Tree -> Tree
|
||||
<span class="lineno"> 75 </span><span class="decl"><span class="istickedoff">withTransformations transformations t =</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="istickedoff">mkGroup [t] & transform ?~ transformations</span></span>
|
||||
<span class="lineno"> 77 </span>
|
||||
<span class="lineno"> 78 </span>-- | @translate x y image@ moves the @image@ by @x@ along X-axis and by @y@ along Y-axis.
|
||||
<span class="lineno"> 79 </span>translate :: Double -> Double -> Tree -> Tree
|
||||
<span class="lineno"> 80 </span><span class="decl"><span class="istickedoff">translate x y = withTransformations [Translate x y]</span></span>
|
||||
<span class="lineno"> 81 </span>
|
||||
<span class="lineno"> 82 </span>-- | @rotate angle image@ rotates the @image@ around origin @(0,0)@ counterclockwise by @angle@
|
||||
<span class="lineno"> 83 </span>-- given in degrees.
|
||||
<span class="lineno"> 84 </span>rotate :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 85 </span><span class="decl"><span class="istickedoff">rotate a = withTransformations [Rotate a Nothing]</span></span>
|
||||
<span class="lineno"> 86 </span>
|
||||
<span class="lineno"> 87 </span>-- | @rotate angle point image@ rotates the @image@ around given @point@ counterclockwise by
|
||||
<span class="lineno"> 88 </span>-- @angle@ given in degrees.
|
||||
<span class="lineno"> 89 </span>rotateAround :: Double -> RPoint -> Tree -> Tree
|
||||
<span class="lineno"> 90 </span><span class="decl"><span class="nottickedoff">rotateAround a (V2 x y) = withTransformations [Rotate a (Just (x,y))]</span></span>
|
||||
<span class="lineno"> 91 </span>
|
||||
<span class="lineno"> 92 </span>-- | @rotate angle image@ rotates the @image@ around the center of its bounding box counterclockwise
|
||||
<span class="lineno"> 93 </span>-- by @angle@ given in degrees.
|
||||
<span class="lineno"> 94 </span>rotateAroundCenter :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 95 </span><span class="decl"><span class="nottickedoff">rotateAroundCenter a t =</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="nottickedoff">rotateAround a (V2 (x+w/2) (y+h/2)) t</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">(x,y,w,h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 99 </span>
|
||||
<span class="lineno"> 100 </span>-- | @aroundCenter f image@ first moves the image so the center of its bounding box is at the origin
|
||||
<span class="lineno"> 101 </span>-- @(0, 0)@, applies transformation @f@ to it and then moves the transformed image back to its
|
||||
<span class="lineno"> 102 </span>-- original position.
|
||||
<span class="lineno"> 103 </span>aroundCenter :: (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 104 </span><span class="decl"><span class="nottickedoff">aroundCenter fn t =</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="nottickedoff">translate (-offsetX) (-offsetY) $ fn $ translate offsetX offsetY t</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="nottickedoff">offsetX = -x-w/2</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">offsetY = -y-h/2</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">(x,y,w,h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 110 </span>
|
||||
<span class="lineno"> 111 </span>-- | Same as 'aroundCenter' but only for the Y-axis.
|
||||
<span class="lineno"> 112 </span>aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 113 </span><span class="decl"><span class="nottickedoff">aroundCenterY fn t =</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="nottickedoff">translate 0 (-offsetY) $ fn $ translate 0 offsetY t</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">offsetY = -y-h/2</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">(_x,y,_w,h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 118 </span>
|
||||
<span class="lineno"> 119 </span>-- | Same as 'aroundCenter' but only for the X-axis.
|
||||
<span class="lineno"> 120 </span>aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 121 </span><span class="decl"><span class="nottickedoff">aroundCenterX fn t =</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">translate (-offsetX) 0 $ fn $ translate offsetX 0 t</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">offsetX = -x-w/2</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">(x,_y,w,_h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 126 </span>
|
||||
<span class="lineno"> 127 </span>-- | Scale the image uniformly by given factor along both X and Y axes.
|
||||
<span class="lineno"> 128 </span>-- For example @scale 2 image@ makes the image twice as large, while @scale 0.5 image@ makes it
|
||||
<span class="lineno"> 129 </span>-- half the original size. Negative values are also allowed, and lead to flipping the image along
|
||||
<span class="lineno"> 130 </span>-- both X and Y axes.
|
||||
<span class="lineno"> 131 </span>scale :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 132 </span><span class="decl"><span class="istickedoff">scale a = withTransformations [Scale a Nothing]</span></span>
|
||||
<span class="lineno"> 133 </span>
|
||||
<span class="lineno"> 134 </span>-- | @scaleToSize width height@ resizes the image so that its bounding box has corresponding @width@
|
||||
<span class="lineno"> 135 </span>-- and @height@.
|
||||
<span class="lineno"> 136 </span>scaleToSize :: Double -> Double -> Tree -> Tree
|
||||
<span class="lineno"> 137 </span><span class="decl"><span class="istickedoff">scaleToSize w h t =</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff">scaleXY (w/w') (h/h') t</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff">(_x, _y, w', h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 141 </span>
|
||||
<span class="lineno"> 142 </span>-- | @scaleToWidth width@ scales the image so that the width of its bounding box ends up having
|
||||
<span class="lineno"> 143 </span>-- given @width@.
|
||||
<span class="lineno"> 144 </span>scaleToWidth :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 145 </span><span class="decl"><span class="istickedoff">scaleToWidth w t =</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff">scale (w/w') t</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff">(_x, _y, w', _h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 149 </span>
|
||||
<span class="lineno"> 150 </span>-- | @scaleToHeight height@ scales the image so that the height of its bounding box ends up having
|
||||
<span class="lineno"> 151 </span>-- given @height@.
|
||||
<span class="lineno"> 152 </span>scaleToHeight :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 153 </span><span class="decl"><span class="nottickedoff">scaleToHeight h t =</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">scale (h/h') t</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, _w', h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 157 </span>
|
||||
<span class="lineno"> 158 </span>-- | Similar to 'scale', except scale factors for X and Y axes are specified separately.
|
||||
<span class="lineno"> 159 </span>scaleXY :: Double -> Double -> Tree -> Tree
|
||||
<span class="lineno"> 160 </span><span class="decl"><span class="istickedoff">scaleXY x y = withTransformations [Scale x (Just y)]</span></span>
|
||||
<span class="lineno"> 161 </span>
|
||||
<span class="lineno"> 162 </span>
|
||||
<span class="lineno"> 163 </span>-- | Flip the image along vertical axis so that what was on the right will end up on left and vice
|
||||
<span class="lineno"> 164 </span>-- versa.
|
||||
<span class="lineno"> 165 </span>flipXAxis :: Tree -> Tree
|
||||
<span class="lineno"> 166 </span><span class="decl"><span class="istickedoff">flipXAxis = scaleXY (-1) 1</span></span>
|
||||
<span class="lineno"> 167 </span>
|
||||
<span class="lineno"> 168 </span>-- | Flip the image along horizontal so that what was on the top will end up in the bottom and vice
|
||||
<span class="lineno"> 169 </span>-- versa.
|
||||
<span class="lineno"> 170 </span>flipYAxis :: Tree -> Tree
|
||||
<span class="lineno"> 171 </span><span class="decl"><span class="istickedoff">flipYAxis = scaleXY 1 (-1)</span></span>
|
||||
<span class="lineno"> 172 </span>
|
||||
<span class="lineno"> 173 </span>-- | Translate given image so that the center of its bouding box coincides with coordinates
|
||||
<span class="lineno"> 174 </span>-- @(0, 0)@.
|
||||
<span class="lineno"> 175 </span>center :: Tree -> Tree
|
||||
<span class="lineno"> 176 </span><span class="decl"><span class="istickedoff">center t = centerUsing t t</span></span>
|
||||
<span class="lineno"> 177 </span>
|
||||
<span class="lineno"> 178 </span>-- | Translate given image so that the X-coordinate of the center of its bouding box is 0.
|
||||
<span class="lineno"> 179 </span>centerX :: Tree -> Tree
|
||||
<span class="lineno"> 180 </span><span class="decl"><span class="nottickedoff">centerX t = translate (-x-w/2) 0 t</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="nottickedoff">(x, _y, w, _h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 183 </span>
|
||||
<span class="lineno"> 184 </span>-- | Translate given image so that the Y-coordinate of the center of its bouding box is 0.
|
||||
<span class="lineno"> 185 </span>centerY :: Tree -> Tree
|
||||
<span class="lineno"> 186 </span><span class="decl"><span class="nottickedoff">centerY t = translate 0 (-y-h/2) t</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="nottickedoff">(_x, y, _w, h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 189 </span>
|
||||
<span class="lineno"> 190 </span>-- | Center the second argument using the bounding-box of the first.
|
||||
<span class="lineno"> 191 </span>centerUsing :: Tree -> Tree -> Tree
|
||||
<span class="lineno"> 192 </span><span class="decl"><span class="istickedoff">centerUsing a = translate (-x-w/2) (-y-h/2)</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff">(x, y, w, h) = boundingBox a</span></span>
|
||||
<span class="lineno"> 195 </span>
|
||||
<span class="lineno"> 196 </span>-- | Create 'Texture' based on SVG color name.
|
||||
<span class="lineno"> 197 </span>-- See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.
|
||||
<span class="lineno"> 198 </span>-- If the provided name doesn't correspond to valid SVG color name, white-ish color is used.
|
||||
<span class="lineno"> 199 </span>mkColor :: String -> Texture
|
||||
<span class="lineno"> 200 </span><span class="decl"><span class="istickedoff">mkColor name =</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff">case Map.lookup (T.pack name) svgNamedColors of</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff">Nothing -> <span class="nottickedoff">ColorRef (PixelRGBA8 240 248 255 255)</span></span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">Just c -> ColorRef c</span></span>
|
||||
<span class="lineno"> 204 </span>
|
||||
<span class="lineno"> 205 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
|
||||
<span class="lineno"> 206 </span>withStrokeColor :: String -> Tree -> Tree
|
||||
<span class="lineno"> 207 </span><span class="decl"><span class="istickedoff">withStrokeColor color = strokeColor .~ pure (mkColor color)</span></span>
|
||||
<span class="lineno"> 208 </span>
|
||||
<span class="lineno"> 209 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
|
||||
<span class="lineno"> 210 </span>withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
|
||||
<span class="lineno"> 211 </span><span class="decl"><span class="istickedoff">withStrokeColorPixel color = strokeColor .~ pure (ColorRef color)</span></span>
|
||||
<span class="lineno"> 212 </span>
|
||||
<span class="lineno"> 213 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dasharray>
|
||||
<span class="lineno"> 214 </span>withStrokeDashArray :: [Double] -> Tree -> Tree
|
||||
<span class="lineno"> 215 </span><span class="decl"><span class="nottickedoff">withStrokeDashArray arr = strokeDashArray .~ pure (map Num arr)</span></span>
|
||||
<span class="lineno"> 216 </span>
|
||||
<span class="lineno"> 217 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>
|
||||
<span class="lineno"> 218 </span>withStrokeLineJoin :: LineJoin -> Tree -> Tree
|
||||
<span class="lineno"> 219 </span><span class="decl"><span class="nottickedoff">withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin</span></span>
|
||||
<span class="lineno"> 220 </span>
|
||||
<span class="lineno"> 221 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
|
||||
<span class="lineno"> 222 </span>withFillColor :: String -> Tree -> Tree
|
||||
<span class="lineno"> 223 </span><span class="decl"><span class="istickedoff">withFillColor color = fillColor .~ pure (mkColor color)</span></span>
|
||||
<span class="lineno"> 224 </span>
|
||||
<span class="lineno"> 225 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
|
||||
<span class="lineno"> 226 </span>withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
|
||||
<span class="lineno"> 227 </span><span class="decl"><span class="istickedoff">withFillColorPixel color = fillColor .~ pure (ColorRef color)</span></span>
|
||||
<span class="lineno"> 228 </span>
|
||||
<span class="lineno"> 229 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
|
||||
<span class="lineno"> 230 </span>withFillOpacity :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 231 </span><span class="decl"><span class="istickedoff">withFillOpacity opacity = fillOpacity ?~ realToFrac opacity</span></span>
|
||||
<span class="lineno"> 232 </span>
|
||||
<span class="lineno"> 233 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/opacity>
|
||||
<span class="lineno"> 234 </span>withGroupOpacity :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 235 </span><span class="decl"><span class="istickedoff">withGroupOpacity opacity = groupOpacity ?~ realToFrac opacity</span></span>
|
||||
<span class="lineno"> 236 </span>
|
||||
<span class="lineno"> 237 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>
|
||||
<span class="lineno"> 238 </span>withStrokeWidth :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 239 </span><span class="decl"><span class="istickedoff">withStrokeWidth width = strokeWidth .~ pure (Num width)</span></span>
|
||||
<span class="lineno"> 240 </span>
|
||||
<span class="lineno"> 241 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>
|
||||
<span class="lineno"> 242 </span>withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
|
||||
<span class="lineno"> 243 </span> -> Tree -- ^ Image that will be clipped by the referenced clip path
|
||||
<span class="lineno"> 244 </span> -> Tree
|
||||
<span class="lineno"> 245 </span><span class="decl"><span class="nottickedoff">withClipPathRef ref sub = mkGroup [sub] & clipPathRef .~ pure ref</span></span>
|
||||
<span class="lineno"> 246 </span>
|
||||
<span class="lineno"> 247 </span>-- | Assigns ID attribute to given image.
|
||||
<span class="lineno"> 248 </span>withId :: String -> Tree -> Tree
|
||||
<span class="lineno"> 249 </span><span class="decl"><span class="nottickedoff">withId idTag = attrId ?~ idTag</span></span>
|
||||
<span class="lineno"> 250 </span>
|
||||
<span class="lineno"> 251 </span>-- | @mkRect width height@ creates a rectangle with given @with@ and @height@, centered at @(0, 0)@.
|
||||
<span class="lineno"> 252 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>
|
||||
<span class="lineno"> 253 </span>mkRect :: Double -> Double -> Tree
|
||||
<span class="lineno"> 254 </span><span class="decl"><span class="istickedoff">mkRect width height = translate (-width/2) (-height/2) $ RectangleTree $ defaultSvg</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="istickedoff">& rectUpperLeftCorner .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="istickedoff">& rectWidth ?~ Num width</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="istickedoff">& rectHeight ?~ Num height</span></span>
|
||||
<span class="lineno"> 258 </span>
|
||||
<span class="lineno"> 259 </span>-- | Create a circle with given radius, centered at @(0, 0)@.
|
||||
<span class="lineno"> 260 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>
|
||||
<span class="lineno"> 261 </span>mkCircle :: Double -> Tree
|
||||
<span class="lineno"> 262 </span><span class="decl"><span class="istickedoff">mkCircle radius = CircleTree $ defaultSvg</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">& circleCenter .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="istickedoff">& circleRadius .~ Num radius</span></span>
|
||||
<span class="lineno"> 265 </span>
|
||||
<span class="lineno"> 266 </span>-- | Create an ellipse given X-axis radius, and Y-axis radius, with center at @(0, 0)@.
|
||||
<span class="lineno"> 267 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>
|
||||
<span class="lineno"> 268 </span>mkEllipse :: Double -> Double -> Tree
|
||||
<span class="lineno"> 269 </span><span class="decl"><span class="istickedoff">mkEllipse rx ry = EllipseTree $ defaultSvg</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="istickedoff">& ellipseCenter .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">& ellipseXRadius .~ Num rx</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">& ellipseYRadius .~ Num ry</span></span>
|
||||
<span class="lineno"> 273 </span>
|
||||
<span class="lineno"> 274 </span>-- | Create a line segment between two points given by their @(x, y)@ coordinates.
|
||||
<span class="lineno"> 275 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>
|
||||
<span class="lineno"> 276 </span>mkLine :: (Double,Double) -> (Double, Double) -> Tree
|
||||
<span class="lineno"> 277 </span><span class="decl"><span class="istickedoff">mkLine (x1,y1) (x2,y2) = LineTree $ defaultSvg</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="istickedoff">& linePoint1 .~ (Num x1, Num y1)</span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="istickedoff">& linePoint2 .~ (Num x2, Num y2)</span></span>
|
||||
<span class="lineno"> 280 </span>
|
||||
<span class="lineno"> 281 </span>-- | Merges multiple images into one.
|
||||
<span class="lineno"> 282 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>
|
||||
<span class="lineno"> 283 </span>mkGroup :: [Tree] -> Tree
|
||||
<span class="lineno"> 284 </span><span class="decl"><span class="istickedoff">mkGroup forest = GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="istickedoff">& groupChildren .~ forest</span></span>
|
||||
<span class="lineno"> 286 </span>
|
||||
<span class="lineno"> 287 </span>-- | Create definition of graphical objects that can be used at later time.
|
||||
<span class="lineno"> 288 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>
|
||||
<span class="lineno"> 289 </span>mkDefinitions :: [Tree] -> Tree
|
||||
<span class="lineno"> 290 </span><span class="decl"><span class="nottickedoff">mkDefinitions forest = DefinitionTree $ defaultSvg</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ forest</span></span>
|
||||
<span class="lineno"> 292 </span>
|
||||
<span class="lineno"> 293 </span>-- | Create an element by referring to existing element defined previously.
|
||||
<span class="lineno"> 294 </span>-- For example you can create a graphical element, assign ID to it using 'withId', wrap it in
|
||||
<span class="lineno"> 295 </span>-- 'mkDefinitions' and then use it via @use "myId"@.
|
||||
<span class="lineno"> 296 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>
|
||||
<span class="lineno"> 297 </span>mkUse :: String -> Tree
|
||||
<span class="lineno"> 298 </span><span class="decl"><span class="nottickedoff">mkUse name = UseTree (defaultSvg & useName .~ name) Nothing</span></span>
|
||||
<span class="lineno"> 299 </span>
|
||||
<span class="lineno"> 300 </span>-- | A clip path restricts the region to which paint can be applied.
|
||||
<span class="lineno"> 301 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>
|
||||
<span class="lineno"> 302 </span>mkClipPath :: String -- ^ ID of the clip path, which can then be referred to by other elements
|
||||
<span class="lineno"> 303 </span> -- using 'withClipPathRef'.
|
||||
<span class="lineno"> 304 </span> -> [Tree] -- ^ List of shapes that will determine the final shape of the clipping region
|
||||
<span class="lineno"> 305 </span> -> Tree
|
||||
<span class="lineno"> 306 </span><span class="decl"><span class="nottickedoff">mkClipPath idTag forest = withId idTag $ ClipPathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">& clipPathContent .~ forest</span></span>
|
||||
<span class="lineno"> 308 </span>
|
||||
<span class="lineno"> 309 </span>-- | Create a path from the list of path commands.
|
||||
<span class="lineno"> 310 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d#Path_commands>
|
||||
<span class="lineno"> 311 </span>mkPath :: [PathCommand] -> Tree
|
||||
<span class="lineno"> 312 </span><span class="decl"><span class="istickedoff">mkPath cmds = PathTree $ defaultSvg & pathDefinition .~ cmds</span></span>
|
||||
<span class="lineno"> 313 </span>
|
||||
<span class="lineno"> 314 </span>-- | Similar to 'mkPathText', but taking SVG path command as a String.
|
||||
<span class="lineno"> 315 </span>mkPathString :: String -> Tree
|
||||
<span class="lineno"> 316 </span><span class="decl"><span class="istickedoff">mkPathString = mkPathText . T.pack</span></span>
|
||||
<span class="lineno"> 317 </span>
|
||||
<span class="lineno"> 318 </span>-- | Create path from textual representation of SVG path command.
|
||||
<span class="lineno"> 319 </span>-- If the text doesn't represent valid path command, this function fails with 'Prelude.error'.
|
||||
<span class="lineno"> 320 </span>-- Use 'mkPath' for type safe way of creating paths.
|
||||
<span class="lineno"> 321 </span>mkPathText :: T.Text -> Tree
|
||||
<span class="lineno"> 322 </span><span class="decl"><span class="istickedoff">mkPathText str =</span>
|
||||
<span class="lineno"> 323 </span><span class="spaces"> </span><span class="istickedoff">case parseOnly pathParser str of</span>
|
||||
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="istickedoff">Left err -> <span class="nottickedoff">error err</span></span>
|
||||
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="istickedoff">Right cmds -> mkPath cmds</span></span>
|
||||
<span class="lineno"> 326 </span>
|
||||
<span class="lineno"> 327 </span>-- | Create a path from a list of @(x, y)@ coordinates of points along the path.
|
||||
<span class="lineno"> 328 </span>mkLinePath :: [(Double, Double)] -> Tree
|
||||
<span class="lineno"> 329 </span><span class="decl"><span class="nottickedoff">mkLinePath [] = mkGroup []</span>
|
||||
<span class="lineno"> 330 </span><span class="spaces"></span><span class="nottickedoff">mkLinePath ((startX, startY):rest) =</span>
|
||||
<span class="lineno"> 331 </span><span class="spaces"> </span><span class="nottickedoff">PathTree $ defaultSvg & pathDefinition .~ cmds</span>
|
||||
<span class="lineno"> 332 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 333 </span><span class="spaces"> </span><span class="nottickedoff">cmds = [ MoveTo OriginAbsolute [V2 startX startY]</span>
|
||||
<span class="lineno"> 334 </span><span class="spaces"> </span><span class="nottickedoff">, LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ] ]</span></span>
|
||||
<span class="lineno"> 335 </span>
|
||||
<span class="lineno"> 336 </span>-- | Create a path from a list of @(x, y)@ coordinates of points along the path.
|
||||
<span class="lineno"> 337 </span>mkLinePathClosed :: [(Double, Double)] -> Tree
|
||||
<span class="lineno"> 338 </span><span class="decl"><span class="istickedoff">mkLinePathClosed [] = <span class="nottickedoff">mkGroup []</span></span>
|
||||
<span class="lineno"> 339 </span><span class="spaces"></span><span class="istickedoff">mkLinePathClosed ((startX, startY):rest) =</span>
|
||||
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg & pathDefinition .~ cmds</span>
|
||||
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 342 </span><span class="spaces"> </span><span class="istickedoff">cmds = [ MoveTo OriginAbsolute [V2 startX startY]</span>
|
||||
<span class="lineno"> 343 </span><span class="spaces"> </span><span class="istickedoff">, LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ]</span>
|
||||
<span class="lineno"> 344 </span><span class="spaces"> </span><span class="istickedoff">, EndPath ]</span></span>
|
||||
<span class="lineno"> 345 </span>
|
||||
<span class="lineno"> 346 </span>-- | Rectangle with a uniform color and the same size as the screen.
|
||||
<span class="lineno"> 347 </span>--
|
||||
<span class="lineno"> 348 </span>-- Example:
|
||||
<span class="lineno"> 349 </span>--
|
||||
<span class="lineno"> 350 </span>-- > animate $ const $ mkBackground "yellow"
|
||||
<span class="lineno"> 351 </span>--
|
||||
<span class="lineno"> 352 </span>-- <<docs/gifs/doc_mkBackground.gif>>
|
||||
<span class="lineno"> 353 </span>mkBackground :: String -> Tree
|
||||
<span class="lineno"> 354 </span><span class="decl"><span class="istickedoff">mkBackground color = withFillOpacity 1 $ withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 355 </span><span class="spaces"> </span><span class="istickedoff">withFillColor color $ mkRect screenWidth screenHeight</span></span>
|
||||
<span class="lineno"> 356 </span>
|
||||
<span class="lineno"> 357 </span>-- | Rectangle with a uniform color and the same size as the screen.
|
||||
<span class="lineno"> 358 </span>mkBackgroundPixel :: PixelRGBA8 -> Tree
|
||||
<span class="lineno"> 359 </span><span class="decl"><span class="istickedoff">mkBackgroundPixel pixel =</span>
|
||||
<span class="lineno"> 360 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $ withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 361 </span><span class="spaces"> </span><span class="istickedoff">withFillColorPixel pixel $ mkRect screenWidth screenHeight</span></span>
|
||||
<span class="lineno"> 362 </span>
|
||||
<span class="lineno"> 363 </span>-- | Take list of rows, where each row consists of number of images and display them in regular
|
||||
<span class="lineno"> 364 </span>-- grid structure.
|
||||
<span class="lineno"> 365 </span>-- All rows will get equal amount of vertical space.
|
||||
<span class="lineno"> 366 </span>-- The images within each row will get equal amount of horizontal space, independent of the other
|
||||
<span class="lineno"> 367 </span>-- rows. Each row can contain different number of cells.
|
||||
<span class="lineno"> 368 </span>gridLayout :: [[Tree]] -> Tree
|
||||
<span class="lineno"> 369 </span><span class="decl"><span class="istickedoff">gridLayout rows = mkGroup</span>
|
||||
<span class="lineno"> 370 </span><span class="spaces"> </span><span class="istickedoff">[ translate (-screenWidth/2+colSep*nCol + colSep*0.5)</span>
|
||||
<span class="lineno"> 371 </span><span class="spaces"> </span><span class="istickedoff">(screenHeight/2-rowSep*nRow - rowSep*0.5)</span>
|
||||
<span class="lineno"> 372 </span><span class="spaces"> </span><span class="istickedoff">elt</span>
|
||||
<span class="lineno"> 373 </span><span class="spaces"> </span><span class="istickedoff">| (nRow, row) <- zip [0..] rows</span>
|
||||
<span class="lineno"> 374 </span><span class="spaces"> </span><span class="istickedoff">, let nCols = length row</span>
|
||||
<span class="lineno"> 375 </span><span class="spaces"> </span><span class="istickedoff">colSep = screenWidth / fromIntegral nCols</span>
|
||||
<span class="lineno"> 376 </span><span class="spaces"> </span><span class="istickedoff">, (nCol, elt) <- zip [0..] row ]</span>
|
||||
<span class="lineno"> 377 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 378 </span><span class="spaces"> </span><span class="istickedoff">rowSep = screenHeight / fromIntegral nRows</span>
|
||||
<span class="lineno"> 379 </span><span class="spaces"> </span><span class="istickedoff">nRows = length rows</span></span>
|
||||
<span class="lineno"> 380 </span>
|
||||
<span class="lineno"> 381 </span>-- | Insert a native text object anchored at the middle.
|
||||
<span class="lineno"> 382 </span>--
|
||||
<span class="lineno"> 383 </span>-- Example:
|
||||
<span class="lineno"> 384 </span>--
|
||||
<span class="lineno"> 385 </span>-- > mkAnimation 2 $ \t -> scale 2 $ withStrokeWidth 0.05 $ mkText (T.take (round $ t*15) "text")
|
||||
<span class="lineno"> 386 </span>--
|
||||
<span class="lineno"> 387 </span>-- <<docs/gifs/doc_mkText.gif>>
|
||||
<span class="lineno"> 388 </span>mkText :: T.Text -> Tree
|
||||
<span class="lineno"> 389 </span><span class="decl"><span class="istickedoff">mkText str =</span>
|
||||
<span class="lineno"> 390 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis</span>
|
||||
<span class="lineno"> 391 </span><span class="spaces"> </span><span class="istickedoff">(TextTree Nothing $ defaultSvg</span>
|
||||
<span class="lineno"> 392 </span><span class="spaces"> </span><span class="istickedoff">& textRoot .~ span_</span>
|
||||
<span class="lineno"> 393 </span><span class="spaces"> </span><span class="istickedoff">& fontSize .~ pure (Num 2))</span>
|
||||
<span class="lineno"> 394 </span><span class="spaces"> </span><span class="istickedoff">& textAnchor .~ pure TextAnchorMiddle</span>
|
||||
<span class="lineno"> 395 </span><span class="spaces"> </span><span class="istickedoff">-- Note: TextAnchorMiddle is placed on the 'flipYAxis' group such that it can easily</span>
|
||||
<span class="lineno"> 396 </span><span class="spaces"> </span><span class="istickedoff">-- be overwritten by the user.</span>
|
||||
<span class="lineno"> 397 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 398 </span><span class="spaces"> </span><span class="istickedoff">span_ = defaultSvg & spanContent .~ [SpanText str]</span></span>
|
||||
<span class="lineno"> 399 </span>
|
||||
<span class="lineno"> 400 </span>-- | Switch from the default viewbox to a custom viewbox. Nesting custom viewboxes is
|
||||
<span class="lineno"> 401 </span>-- unlikely to give good results. If you need nested custom viewboxes, you will have
|
||||
<span class="lineno"> 402 </span>-- to configure them by hand.
|
||||
<span class="lineno"> 403 </span>--
|
||||
<span class="lineno"> 404 </span>-- The viewbox argument is (min-x, min-y, width, height).
|
||||
<span class="lineno"> 405 </span>--
|
||||
<span class="lineno"> 406 </span>-- Example:
|
||||
<span class="lineno"> 407 </span>--
|
||||
<span class="lineno"> 408 </span>-- > withViewBox (0,0,1,1) $ mkBackground "yellow"
|
||||
<span class="lineno"> 409 </span>--
|
||||
<span class="lineno"> 410 </span>-- <<docs/gifs/doc_withViewBox.gif>>
|
||||
<span class="lineno"> 411 </span>withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
|
||||
<span class="lineno"> 412 </span><span class="decl"><span class="istickedoff">withViewBox vbox child = translate (-screenWidth/2) (-screenHeight/2) $</span>
|
||||
<span class="lineno"> 413 </span><span class="spaces"> </span><span class="istickedoff">SvgTree $ Document</span>
|
||||
<span class="lineno"> 414 </span><span class="spaces"> </span><span class="istickedoff">{ _viewBox = Just vbox</span>
|
||||
<span class="lineno"> 415 </span><span class="spaces"> </span><span class="istickedoff">, _width = Just (Num screenWidth)</span>
|
||||
<span class="lineno"> 416 </span><span class="spaces"> </span><span class="istickedoff">, _height = Just (Num screenHeight)</span>
|
||||
<span class="lineno"> 417 </span><span class="spaces"> </span><span class="istickedoff">, _elements = [child]</span>
|
||||
<span class="lineno"> 418 </span><span class="spaces"> </span><span class="istickedoff">, _description = ""</span>
|
||||
<span class="lineno"> 419 </span><span class="spaces"> </span><span class="istickedoff">, _documentLocation = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 420 </span><span class="spaces"> </span><span class="istickedoff">, _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing</span>
|
||||
<span class="lineno"> 421 </span><span class="spaces"> </span><span class="istickedoff">}</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
302
reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand.hs.html
Normal file
302
reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand.hs.html
Normal file
|
|
@ -0,0 +1,302 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 3 </span>License : Unlicense
|
||||
<span class="lineno"> 4 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 5 </span>Stability : experimental
|
||||
<span class="lineno"> 6 </span>Portability : POSIX
|
||||
<span class="lineno"> 7 </span>-}
|
||||
<span class="lineno"> 8 </span>module Reanimate.Svg.LineCommand
|
||||
<span class="lineno"> 9 </span> ( CmdM
|
||||
<span class="lineno"> 10 </span> , LineCommand(..)
|
||||
<span class="lineno"> 11 </span> , lineLength
|
||||
<span class="lineno"> 12 </span> , toLineCommands
|
||||
<span class="lineno"> 13 </span> , lineToPath
|
||||
<span class="lineno"> 14 </span> , lineToPoints
|
||||
<span class="lineno"> 15 </span> , partialSvg
|
||||
<span class="lineno"> 16 </span> ) where
|
||||
<span class="lineno"> 17 </span>
|
||||
<span class="lineno"> 18 </span>import Control.Lens ((%~), (&), (.~))
|
||||
<span class="lineno"> 19 </span>import Control.Monad.Fix
|
||||
<span class="lineno"> 20 </span>import Control.Monad.State
|
||||
<span class="lineno"> 21 </span>import Data.Functor
|
||||
<span class="lineno"> 22 </span>import qualified Data.Vector.Unboxed as V
|
||||
<span class="lineno"> 23 </span>import qualified Geom2D.CubicBezier.Linear as Bezier
|
||||
<span class="lineno"> 24 </span>import Graphics.SvgTree hiding (height, line, path, use, width)
|
||||
<span class="lineno"> 25 </span>import Linear.Metric
|
||||
<span class="lineno"> 26 </span>import Linear.V2 hiding (angle)
|
||||
<span class="lineno"> 27 </span>import Linear.Vector
|
||||
<span class="lineno"> 28 </span>
|
||||
<span class="lineno"> 29 </span>-- | Line command monad used for keeping track of the current location.
|
||||
<span class="lineno"> 30 </span>type CmdM a = State RPoint a
|
||||
<span class="lineno"> 31 </span>
|
||||
<span class="lineno"> 32 </span>-- | Simplified version of a PathCommand where all points are absolute.
|
||||
<span class="lineno"> 33 </span>data LineCommand
|
||||
<span class="lineno"> 34 </span> = LineMove RPoint
|
||||
<span class="lineno"> 35 </span> -- | LineDraw RPoint
|
||||
<span class="lineno"> 36 </span> | LineBezier [RPoint]
|
||||
<span class="lineno"> 37 </span> | LineEnd RPoint
|
||||
<span class="lineno"> 38 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
|
||||
<span class="lineno"> 39 </span>
|
||||
<span class="lineno"> 40 </span>-- | Convert from line commands to path commands.
|
||||
<span class="lineno"> 41 </span>lineToPath :: [LineCommand] -> [PathCommand]
|
||||
<span class="lineno"> 42 </span><span class="decl"><span class="istickedoff">lineToPath = map worker</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="istickedoff">worker (LineMove p) = MoveTo OriginAbsolute [p]</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff">-- worker (LineDraw p) = LineTo OriginAbsolute [p]</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">worker (LineBezier [a,b,c]) = CurveTo OriginAbsolute [(a,b,c)]</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff">worker (LineBezier [a,b]) = QuadraticBezier OriginAbsolute [(a,b)]</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff">worker (LineBezier [a]) = LineTo OriginAbsolute [a]</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">worker LineBezier{} = <span class="nottickedoff">error "Reanimate.Svg.lineToPath: invalid bezier curve"</span></span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">worker LineEnd{} = EndPath</span></span>
|
||||
<span class="lineno"> 51 </span>
|
||||
<span class="lineno"> 52 </span>-- | Using @n@ control points, approximate the path of the curves.
|
||||
<span class="lineno"> 53 </span>lineToPoints :: Int -> [LineCommand] -> [RPoint]
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">lineToPoints nPoints cmds =</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">map lineEnd lineSegments</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">lineSegments = [ partialLine (fromIntegral n/ fromIntegral nPoints) cmds | n <- [0 .. nPoints-1] ]</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">lineEnd [LineBezier pts] = last pts</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">lineEnd (_:xs) = lineEnd xs</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">lineEnd _ = error "invalid line"</span></span>
|
||||
<span class="lineno"> 61 </span>
|
||||
<span class="lineno"> 62 </span>partialLine :: Double -> [LineCommand] -> [LineCommand]
|
||||
<span class="lineno"> 63 </span><span class="decl"><span class="istickedoff">partialLine alpha cmds = evalState (worker 0 cmds) <span class="nottickedoff">zero</span></span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="istickedoff">worker _d [] = <span class="nottickedoff">pure []</span></span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="istickedoff">worker d (cmd:xs) = do</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">from <- get</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff">len <- lineLength cmd</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="istickedoff">let frac = (targetLen-d) / len</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">if len == 0 || frac >= 1</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="istickedoff">then (cmd:) <$> worker (d+len) xs</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="istickedoff">else pure [adjustLineLength frac from cmd]</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="istickedoff">totalLen = evalState (sum <$> mapM lineLength cmds) <span class="nottickedoff">zero</span></span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="istickedoff">targetLen = totalLen * alpha</span></span>
|
||||
<span class="lineno"> 75 </span>
|
||||
<span class="lineno"> 76 </span>adjustLineLength :: Double -> RPoint -> LineCommand -> LineCommand
|
||||
<span class="lineno"> 77 </span><span class="decl"><span class="istickedoff">adjustLineLength alpha from cmd =</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="istickedoff">LineBezier points -> LineBezier $ drop 1 $ partialBezierPoints (from:points) 0 alpha</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="istickedoff">LineMove p -> <span class="nottickedoff">LineMove p</span></span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="istickedoff">-- LineDraw t -> LineDraw (lerp alpha t from)</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">LineEnd p -> LineBezier [lerp alpha p from]</span></span>
|
||||
<span class="lineno"> 83 </span>
|
||||
<span class="lineno"> 84 </span>-- | Estimated length of all segments in a line.
|
||||
<span class="lineno"> 85 </span>lineLength :: LineCommand -> CmdM Double
|
||||
<span class="lineno"> 86 </span><span class="decl"><span class="istickedoff">lineLength cmd =</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">LineMove to -> 0 <$ put to</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">-- Straight line:</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff">LineBezier [dst] -> gets (distance dst) <* put dst</span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff">-- Some kind of curve:</span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff">LineBezier lst -> do</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">from <- get</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">let bezier = rpointsToBezier (from:lst)</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">tol = 0.0001</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">put (last lst)</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">pure $ Bezier.arcLength bezier 1 tol</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">LineEnd to -> gets (distance to) <* <span class="nottickedoff">put to</span></span></span>
|
||||
<span class="lineno"> 99 </span>
|
||||
<span class="lineno"> 100 </span>rpointsToBezier :: [RPoint] -> Bezier.CubicBezier Double
|
||||
<span class="lineno"> 101 </span><span class="decl"><span class="istickedoff">rpointsToBezier lst =</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="istickedoff">case lst of</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="istickedoff">[a,b] -> <span class="nottickedoff">Bezier.CubicBezier a a b b</span></span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="istickedoff">[a,b,c] -> <span class="nottickedoff">Bezier.quadToCubic (Bezier.QuadBezier a b c)</span></span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="istickedoff">[a,b,c,d] -> Bezier.CubicBezier a b c d</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">error $ "rpointsToBezier: Invalid list of points: " ++ show lst</span></span></span>
|
||||
<span class="lineno"> 107 </span>
|
||||
<span class="lineno"> 108 </span>-- | Convert from path commands to line commands.
|
||||
<span class="lineno"> 109 </span>toLineCommands :: [PathCommand] -> [LineCommand]
|
||||
<span class="lineno"> 110 </span><span class="decl"><span class="istickedoff">toLineCommands ps = evalState (worker <span class="nottickedoff">zero</span> <span class="nottickedoff">Nothing</span> ps) <span class="nottickedoff">zero</span></span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff">worker _startPos _mbPrevControlPt [] = pure []</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff">worker startPos mbPrevControlPt (cmd:cmds) = do</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff">lcmds <- toLineCommand startPos <span class="nottickedoff">mbPrevControlPt</span> cmd</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">let startPos' =</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">case lcmds of</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">[LineMove pos] -> pos</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">_ -> startPos</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">(lcmds++) <$> worker startPos' <span class="nottickedoff">(cmdToControlPoint $ last lcmds)</span> cmds</span></span>
|
||||
<span class="lineno"> 120 </span>
|
||||
<span class="lineno"> 121 </span>cmdToControlPoint :: LineCommand -> Maybe RPoint
|
||||
<span class="lineno"> 122 </span><span class="decl"><span class="nottickedoff">cmdToControlPoint (LineBezier points) = Just (last (init points))</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"></span><span class="nottickedoff">cmdToControlPoint _ = Nothing</span></span>
|
||||
<span class="lineno"> 124 </span>
|
||||
<span class="lineno"> 125 </span>mkStraightLine :: RPoint -> LineCommand
|
||||
<span class="lineno"> 126 </span><span class="decl"><span class="istickedoff">mkStraightLine p = LineBezier [p]</span></span>
|
||||
<span class="lineno"> 127 </span>
|
||||
<span class="lineno"> 128 </span>toLineCommand :: RPoint -> Maybe RPoint -> PathCommand -> CmdM [LineCommand]
|
||||
<span class="lineno"> 129 </span><span class="decl"><span class="istickedoff">toLineCommand startPos mbPrevControlPt cmd =</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="istickedoff">MoveTo OriginAbsolute [] -> <span class="nottickedoff">pure []</span></span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="istickedoff">MoveTo OriginAbsolute lst -> put (last lst) *> gets (pure.LineMove)</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="istickedoff">MoveTo OriginRelative lst -> <span class="nottickedoff">modify (+ sum lst) *> gets (pure.LineMove)</span></span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff">LineTo OriginAbsolute lst -> forM lst (\to -> <span class="nottickedoff">put to</span> $> mkStraightLine to)</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="istickedoff">LineTo OriginRelative lst -> <span class="nottickedoff">forM lst (\to -> modify (+to) *> gets mkStraightLine)</span></span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff">HorizontalTo OriginAbsolute lst -></span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM lst $ \x -> modify (_x .~ x) *> gets mkStraightLine</span></span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff">HorizontalTo OriginRelative lst -></span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff">forM lst $ \x -> modify (_x %~ (+x)) *> gets mkStraightLine</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff">VerticalTo OriginAbsolute lst -></span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM lst $ \y -> modify (_y .~ y) *> gets mkStraightLine</span></span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff">VerticalTo OriginRelative lst -></span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff">forM lst $ \y -> modify (_y %~ (+y)) *> gets mkStraightLine</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff">CurveTo OriginAbsolute quads -></span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM quads $ \(a,b,c) -> put c $> LineBezier [a,b,c]</span></span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff">CurveTo OriginRelative quads -></span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM quads $ \(a,b,c) -> do</span></span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">from <- get <* modify (+c)</span></span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ LineBezier $ map (+from) [a,b,c]</span></span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="istickedoff">SmoothCurveTo o lst -> <span class="nottickedoff">mfix $ \result -> do</span></span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let ctrl = mbPrevControlPt : map cmdToControlPoint result</span></span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM (zip lst ctrl) $ \((c2,to), mbControl) -> do</span></span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">from <- get <* adjustPosition o to</span></span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let c1 = maybe (makeAbsolute o from c2) (mirrorPoint from) mbControl</span></span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ LineBezier [c1,makeAbsolute o from c2,makeAbsolute o from to]</span></span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff">QuadraticBezier OriginAbsolute pairs -></span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="istickedoff">forM pairs $ \(a,b) -> <span class="nottickedoff">put b</span> $> LineBezier [a,b]</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="istickedoff">QuadraticBezier OriginRelative pairs -></span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="istickedoff">forM pairs $ \(a,b) -> do</span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="istickedoff">from <- get <* <span class="nottickedoff">modify (+b)</span></span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="istickedoff">pure $ LineBezier $ map (+from) [a,b]</span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="istickedoff">SmoothQuadraticBezierCurveTo o lst -> <span class="nottickedoff">mfix $ \result -> do</span></span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let ctrl = mbPrevControlPt : map cmdToControlPoint result</span></span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM (zip lst ctrl) $ \(to, mbControl) -> do</span></span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">from <- get <* adjustPosition o to</span></span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let c1 = maybe from (mirrorPoint from) mbControl</span></span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ LineBezier [c1,makeAbsolute o from to]</span></span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="istickedoff">EllipticalArc o points -> concat <$></span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="istickedoff">forM points (\(rotX, rotY, angle, largeArc, sweepFlag, to) -> do</span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="istickedoff">from <- get <* adjustPosition o to</span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="istickedoff">return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to))</span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="istickedoff">EndPath -> <span class="nottickedoff">put startPos</span> $> [LineEnd startPos]</span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mirrorPoint c p = c*2-p</span></span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="istickedoff">adjustPosition OriginRelative p = modify (+p)</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="istickedoff">adjustPosition OriginAbsolute p = <span class="nottickedoff">put p</span></span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="istickedoff">makeAbsolute OriginAbsolute _from p = <span class="nottickedoff">p</span></span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="istickedoff">makeAbsolute OriginRelative from p = from+p</span></span>
|
||||
<span class="lineno"> 179 </span>
|
||||
<span class="lineno"> 180 </span>
|
||||
<span class="lineno"> 181 </span>calculateVectorAngle :: Double -> Double -> Double -> Double -> Double
|
||||
<span class="lineno"> 182 </span><span class="decl"><span class="istickedoff">calculateVectorAngle ux uy vx vy</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="istickedoff">| tb >= ta</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff">= tb - ta</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span></span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="istickedoff">= pi * 2 - (ta - tb)</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="istickedoff">ta = atan2 uy ux</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="istickedoff">tb = atan2 vy vx</span></span>
|
||||
<span class="lineno"> 190 </span>
|
||||
<span class="lineno"> 191 </span>-- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs
|
||||
<span class="lineno"> 192 </span>{- HLINT ignore convertSvgArc -}
|
||||
<span class="lineno"> 193 </span>convertSvgArc :: RPoint -> Coord -> Coord -> Coord -> Bool -> Bool -> RPoint -> [LineCommand]
|
||||
<span class="lineno"> 194 </span><span class="decl"><span class="istickedoff">convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlyfalse">x0 == x && <span class="nottickedoff">y0 == y</span></span></span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="istickedoff">= <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlyfalse">radiusX == 0.0 && <span class="nottickedoff">radiusY == 0.0</span></span></span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff">= <span class="nottickedoff">[LineBezier [V2 x y]]</span></span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span></span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff">= calcSegments x0 y0 theta1' segments'</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff">sinPhi = sin (angle * pi/180)</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">cosPhi = cos (angle * pi/180)</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff">x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="istickedoff">y1dash = -sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0</span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="istickedoff">numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">s = sqrt(1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))</span></span>
|
||||
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="istickedoff">rx = if <span class="tickonlyfalse">(numerator < 0.0)</span> then <span class="nottickedoff">(radiusX * s)</span> else radiusX</span>
|
||||
<span class="lineno"> 212 </span><span class="spaces"> </span><span class="istickedoff">ry = if <span class="tickonlyfalse">(numerator < 0.0)</span> then <span class="nottickedoff">(radiusY * s)</span> else radiusY</span>
|
||||
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="istickedoff">root = if <span class="tickonlyfalse">(numerator < 0.0)</span></span>
|
||||
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="istickedoff">then <span class="nottickedoff">(0.0)</span></span>
|
||||
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="istickedoff">else ((if <span class="tickonlyfalse">((largeArcFlag && sweepFlag) || (not largeArcFlag && <span class="nottickedoff">not sweepFlag</span>))</span> then <span class="nottickedoff">(-1.0)</span> else 1.0) *</span>
|
||||
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="istickedoff">sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="istickedoff">cxdash = root * rx * y1dash / ry</span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="istickedoff">cydash = -root * ry * x1dash / rx</span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 221 </span><span class="spaces"> </span><span class="istickedoff">cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0</span>
|
||||
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="istickedoff">cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0</span>
|
||||
<span class="lineno"> 223 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 224 </span><span class="spaces"> </span><span class="istickedoff">theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)</span>
|
||||
<span class="lineno"> 225 </span><span class="spaces"> </span><span class="istickedoff">dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((-x1dash - cxdash) / rx) ((-y1dash - cydash) / ry)</span>
|
||||
<span class="lineno"> 226 </span><span class="spaces"> </span><span class="istickedoff">dtheta = if <span class="tickonlytrue">(not sweepFlag && dtheta' > 0)</span></span>
|
||||
<span class="lineno"> 227 </span><span class="spaces"> </span><span class="istickedoff">then (dtheta' - 2 * pi)</span>
|
||||
<span class="lineno"> 228 </span><span class="spaces"> </span><span class="istickedoff">else <span class="nottickedoff">(if (sweepFlag && dtheta' < 0) then dtheta' + 2 * pi else dtheta')</span></span>
|
||||
<span class="lineno"> 229 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="istickedoff">segments' = ceiling (abs (dtheta / (pi / 2.0)))</span>
|
||||
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="istickedoff">delta = dtheta / fromInteger segments'</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="istickedoff">t = 8.0 / 3.0 * sin(delta / 4.0) * sin(delta / 4.0) / sin(delta / 2.0)</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 234 </span><span class="spaces"> </span><span class="istickedoff">calcSegments startX startY theta1 segments</span>
|
||||
<span class="lineno"> 235 </span><span class="spaces"> </span><span class="istickedoff">| segments == 0</span>
|
||||
<span class="lineno"> 236 </span><span class="spaces"> </span><span class="istickedoff">= []</span>
|
||||
<span class="lineno"> 237 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span></span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="istickedoff">= LineBezier [ V2 (startX + dx1) (startY + dy1)</span>
|
||||
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="istickedoff">, V2 (endpointX + dxe) (endpointY + dye)</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="istickedoff">, V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="istickedoff">cosTheta1 = cos theta1</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="istickedoff">sinTheta1 = sin theta1</span>
|
||||
<span class="lineno"> 244 </span><span class="spaces"> </span><span class="istickedoff">theta2 = theta1 + delta</span>
|
||||
<span class="lineno"> 245 </span><span class="spaces"> </span><span class="istickedoff">cosTheta2 = cos theta2</span>
|
||||
<span class="lineno"> 246 </span><span class="spaces"> </span><span class="istickedoff">sinTheta2 = sin theta2</span>
|
||||
<span class="lineno"> 247 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 248 </span><span class="spaces"> </span><span class="istickedoff">endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx</span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="istickedoff">endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="istickedoff">dx1 = t * (-cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="istickedoff">dy1 = t * (-sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1)</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="istickedoff">dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="istickedoff">dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)</span></span>
|
||||
<span class="lineno"> 256 </span>
|
||||
<span class="lineno"> 257 </span>partialBezierPoints :: [RPoint] -> Double -> Double -> [RPoint]
|
||||
<span class="lineno"> 258 </span><span class="decl"><span class="istickedoff">partialBezierPoints ps a b =</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="istickedoff">let c1 = Bezier.AnyBezier (V.fromList ps)</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="istickedoff">Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="istickedoff">in V.toList os</span></span>
|
||||
<span class="lineno"> 262 </span>
|
||||
<span class="lineno"> 263 </span>{- | Create an image showing portion of a path.
|
||||
<span class="lineno"> 264 </span> Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
|
||||
<span class="lineno"> 265 </span> You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
|
||||
<span class="lineno"> 266 </span>
|
||||
<span class="lineno"> 267 </span> Typical usage:
|
||||
<span class="lineno"> 268 </span>
|
||||
<span class="lineno"> 269 </span> > animate $ \t -> partialSvg t myPath
|
||||
<span class="lineno"> 270 </span>-}
|
||||
<span class="lineno"> 271 </span>partialSvg :: Double -- ^ number between 0 and 1 inclusively, determining what portion of the path to show
|
||||
<span class="lineno"> 272 </span> -> Tree -- ^ Image representing a path, of which we only want to display a portion determined by the first argument
|
||||
<span class="lineno"> 273 </span> -> Tree
|
||||
<span class="lineno"> 274 </span><span class="decl"><span class="istickedoff">partialSvg alpha | alpha >= 1 = id</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"></span><span class="istickedoff">partialSvg alpha = mapTree worker</span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="istickedoff">worker (PathTree path) =</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ path & pathDefinition %~ lineToPath . partialLine alpha . toLineCommands</span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="istickedoff">worker t = t</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
93
reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse.hs.html
Normal file
93
reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse.hs.html
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 3 </span>License : Unlicense
|
||||
<span class="lineno"> 4 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 5 </span>Stability : experimental
|
||||
<span class="lineno"> 6 </span>Portability : POSIX
|
||||
<span class="lineno"> 7 </span>-}
|
||||
<span class="lineno"> 8 </span>module Reanimate.Svg.Unuse
|
||||
<span class="lineno"> 9 </span> ( replaceUses
|
||||
<span class="lineno"> 10 </span> , unbox
|
||||
<span class="lineno"> 11 </span> , embedDocument
|
||||
<span class="lineno"> 12 </span> ) where
|
||||
<span class="lineno"> 13 </span>
|
||||
<span class="lineno"> 14 </span>import Control.Lens ((%~), (&), (.~), (?~), (^.))
|
||||
<span class="lineno"> 15 </span>import qualified Data.Map as Map
|
||||
<span class="lineno"> 16 </span>import Data.Maybe
|
||||
<span class="lineno"> 17 </span>import Graphics.SvgTree hiding (line, path, use)
|
||||
<span class="lineno"> 18 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 19 </span>import Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 20 </span>
|
||||
<span class="lineno"> 21 </span>-- | Replace all @<use>@ nodes with their definition.
|
||||
<span class="lineno"> 22 </span>replaceUses :: Document -> Document
|
||||
<span class="lineno"> 23 </span><span class="decl"><span class="nottickedoff">replaceUses doc = doc & elements %~ map (mapTree replace)</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="nottickedoff">replaceDefinition PathTree{} = None</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="nottickedoff">replaceDefinition t = t</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="nottickedoff">replace t@DefinitionTree{} = mapTree replaceDefinition t</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="nottickedoff">replace (UseTree _ Just{}) = error "replaceUses: subtree in use?"</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="nottickedoff">replace (UseTree use Nothing) =</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">case Map.lookup (use^.useName) idMap of</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> error $ "Unknown id: " ++ (use^.useName)</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="nottickedoff">Just tree -> mapTree replace $</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="nottickedoff">defaultSvg & groupChildren .~ [tree]</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">& transform ?~</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="nottickedoff">fromMaybe [] (use^.transform) ++</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">[baseToTransformation (use^.useBase)]</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">replace x = x</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">baseToTransformation (x,y) =</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="nottickedoff">(Num a, Num b) -> Translate a b</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="nottickedoff">_ -> TransformUnknown</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="nottickedoff">docTree = mkGroup (doc^.elements)</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="nottickedoff">idMap = foldTree updMap Map.empty docTree</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="nottickedoff">updMap m tree =</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="nottickedoff">case tree^.attrId of</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> m</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">Just tid -> Map.insert tid tree m</span></span>
|
||||
<span class="lineno"> 50 </span>
|
||||
<span class="lineno"> 51 </span>-- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
|
||||
<span class="lineno"> 52 </span>-- | Transform out viewbox. Definitions and CSS rules are discarded.
|
||||
<span class="lineno"> 53 </span>unbox :: Document -> Tree
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">unbox doc@Document{_viewBox = Just (_minx, _minw, _width, _height)} =</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ doc^.elements</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"></span><span class="nottickedoff">unbox doc =</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ doc^.elements</span></span>
|
||||
<span class="lineno"> 60 </span>
|
||||
<span class="lineno"> 61 </span>-- | Embed 'Document'. This keeps the entire document intact but makes
|
||||
<span class="lineno"> 62 </span>-- it more difficult to use, say, `Reanimate.Svg.pathify` on it.
|
||||
<span class="lineno"> 63 </span>embedDocument :: Document -> Tree
|
||||
<span class="lineno"> 64 </span><span class="decl"><span class="istickedoff">embedDocument doc =</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="istickedoff">translate (-screenWidth/2) (screenHeight/2) $</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis $</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="istickedoff">SvgTree $ doc & width .~ Nothing</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">& height .~ Nothing</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
371
reanimate-0.4.2.0-inplace/Reanimate.Svg.hs.html
Normal file
371
reanimate-0.4.2.0-inplace/Reanimate.Svg.hs.html
Normal file
|
|
@ -0,0 +1,371 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE LambdaCase #-}
|
||||
<span class="lineno"> 2 </span>{-|
|
||||
<span class="lineno"> 3 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 4 </span>License : Unlicense
|
||||
<span class="lineno"> 5 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 6 </span>Stability : experimental
|
||||
<span class="lineno"> 7 </span>Portability : POSIX
|
||||
<span class="lineno"> 8 </span>-}
|
||||
<span class="lineno"> 9 </span>module Reanimate.Svg
|
||||
<span class="lineno"> 10 </span> ( module Reanimate.Svg
|
||||
<span class="lineno"> 11 </span> , module Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 12 </span> , module Reanimate.Svg.LineCommand
|
||||
<span class="lineno"> 13 </span> , module Reanimate.Svg.BoundingBox
|
||||
<span class="lineno"> 14 </span> , module Reanimate.Svg.Unuse
|
||||
<span class="lineno"> 15 </span> ) where
|
||||
<span class="lineno"> 16 </span>
|
||||
<span class="lineno"> 17 </span>import Control.Lens ((%~), (&), (.~), (^.), (?~))
|
||||
<span class="lineno"> 18 </span>import Control.Monad.State
|
||||
<span class="lineno"> 19 </span>import Graphics.SvgTree hiding (height, line, path, use,
|
||||
<span class="lineno"> 20 </span> width)
|
||||
<span class="lineno"> 21 </span>import Linear.V2 hiding (angle)
|
||||
<span class="lineno"> 22 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 23 </span>import Reanimate.Animation (SVG)
|
||||
<span class="lineno"> 24 </span>import Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 25 </span>import Reanimate.Svg.LineCommand
|
||||
<span class="lineno"> 26 </span>import Reanimate.Svg.BoundingBox
|
||||
<span class="lineno"> 27 </span>import Reanimate.Svg.Unuse
|
||||
<span class="lineno"> 28 </span>import qualified Reanimate.Transform as Transform
|
||||
<span class="lineno"> 29 </span>
|
||||
<span class="lineno"> 30 </span>-- | Remove transformations (such as translations, rotations, scaling)
|
||||
<span class="lineno"> 31 </span>-- and apply them directly to the SVG nodes. Note, this function
|
||||
<span class="lineno"> 32 </span>-- may convert nodes (such as Circle or Rect) to paths. Also note
|
||||
<span class="lineno"> 33 </span>-- that /does/ change how the SVG is rendered. Particularly, stroke
|
||||
<span class="lineno"> 34 </span>-- width is affected by directly applying scaling.
|
||||
<span class="lineno"> 35 </span>--
|
||||
<span class="lineno"> 36 </span>-- @lowerTransformations (scale 2 (mkCircle 1)) = mkCircle 2@
|
||||
<span class="lineno"> 37 </span>lowerTransformations :: Tree -> Tree
|
||||
<span class="lineno"> 38 </span><span class="decl"><span class="istickedoff">lowerTransformations = worker <span class="nottickedoff">False</span> Transform.identity</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">updLineCmd m cmd =</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">LineMove p -> LineMove $ Transform.transformPoint m p</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="istickedoff">-- LineDraw p -> LineDraw $ Transform.transformPoint m p</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="istickedoff">LineBezier ps -> LineBezier $ map (Transform.transformPoint m) ps</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff">LineEnd p -> LineEnd $ <span class="nottickedoff">Transform.transformPoint m p</span></span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">updPath m = lineToPath . map (updLineCmd m) . toLineCommands</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">updPoint m (Num a,Num b) =</span></span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case Transform.transformPoint m (V2 a b) of</span></span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">V2 x y -> (Num x, Num y)</span></span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">updPoint _ other = other</span> -- XXX: Can we do better here?</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="istickedoff">worker hasPathified m t =</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff">let m' = m * Transform.mkMatrix (t^.transform) in</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">case t of</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff">PathTree path -> PathTree $</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">path & pathDefinition %~ updPath m'</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">& transform .~ Nothing</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -> <span class="nottickedoff">GroupTree $</span></span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">g & groupChildren %~ map (worker hasPathified m')</span></span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& transform .~ Nothing</span></span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">LineTree line -></span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">LineTree $</span></span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">line & linePoint1 %~ updPoint m</span></span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& linePoint2 %~ updPoint m</span></span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="istickedoff">ClipPathTree{} -> <span class="nottickedoff">t</span></span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="istickedoff">-- If we encounter an unknown node and we've already tried to convert</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="istickedoff">-- to paths, give up and insert an explicit transformation.</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">_ | <span class="nottickedoff">hasPathified</span> -></span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mkGroup [t] & transform ?~ [ Transform.toTransformation m ]</span></span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="istickedoff">-- If we haven't tried to pathify, run pathify only once.</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">worker True m (pathify t)</span></span></span>
|
||||
<span class="lineno"> 71 </span>
|
||||
<span class="lineno"> 72 </span>-- | Remove all @id@ attributes.
|
||||
<span class="lineno"> 73 </span>lowerIds :: Tree -> Tree
|
||||
<span class="lineno"> 74 </span><span class="decl"><span class="nottickedoff">lowerIds = mapTree worker</span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="nottickedoff">worker t@GroupTree{} = t & attrId .~ Nothing</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="nottickedoff">worker t@PathTree{} = t & attrId .~ Nothing</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="nottickedoff">worker t = t</span></span>
|
||||
<span class="lineno"> 79 </span>
|
||||
<span class="lineno"> 80 </span>-- | Optimize SVG tree without affecting how it is rendered.
|
||||
<span class="lineno"> 81 </span>simplify :: Tree -> Tree
|
||||
<span class="lineno"> 82 </span><span class="decl"><span class="istickedoff">simplify root =</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">case worker root of</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">[] -> <span class="nottickedoff">None</span></span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">[x] -> x</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">xs -> <span class="nottickedoff">mkGroup xs</span></span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">worker None = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">worker (DefinitionTree d) =</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap dropNulls</span></span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[DefinitionTree $ d & groupChildren %~ concatMap worker]</span></span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff">worker (GroupTree g)</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">g ^. drawAttributes == defaultSvg</span> =</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap dropNulls $</span></span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap worker (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> =</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">dropNulls $</span></span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">GroupTree $ g & groupChildren %~ concatMap worker</span></span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff">worker t = dropNulls t</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="istickedoff">dropNulls None = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="istickedoff">dropNulls (DefinitionTree d)</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">null (d^.groupChildren)</span> = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="istickedoff">dropNulls (GroupTree g)</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">null (g^.groupChildren)</span> = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="istickedoff">dropNulls t = [t]</span></span>
|
||||
<span class="lineno"> 107 </span>
|
||||
<span class="lineno"> 108 </span>-- | Separate grouped items. This is required by clip nodes.
|
||||
<span class="lineno"> 109 </span>--
|
||||
<span class="lineno"> 110 </span>-- @removeGroups (withFillColor "blue" $ mkGroup [mkCircle 1, mkRect 1 1])
|
||||
<span class="lineno"> 111 </span>-- = [ withFillColor "blue" $ mkCircle 1
|
||||
<span class="lineno"> 112 </span>-- , withFillColor "blue" $ mkRect 1 1 ]@
|
||||
<span class="lineno"> 113 </span>removeGroups :: Tree -> [Tree]
|
||||
<span class="lineno"> 114 </span><span class="decl"><span class="nottickedoff">removeGroups = worker defaultSvg</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">worker _attr None = []</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">worker _attr (DefinitionTree d) =</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">concatMap dropNulls</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">[DefinitionTree $ d & groupChildren %~ concatMap (worker defaultSvg)]</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">worker attr (GroupTree g)</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">| g ^. drawAttributes == defaultSvg =</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">concatMap dropNulls $</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">concatMap (worker attr) (g^.groupChildren)</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">concatMap (worker (attr <> g ^. drawAttributes)) (g^.groupChildren)</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">worker attr t = dropNulls (t & drawAttributes .~ attr)</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls None = []</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls (DefinitionTree d)</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">| null (d^.groupChildren) = []</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls (GroupTree g)</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">| null (g^.groupChildren) = []</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls t = [t]</span></span>
|
||||
<span class="lineno"> 134 </span>
|
||||
<span class="lineno"> 135 </span>-- | Extract all path commands from a node (and its children) and concatenate them.
|
||||
<span class="lineno"> 136 </span>extractPath :: Tree -> [PathCommand]
|
||||
<span class="lineno"> 137 </span><span class="decl"><span class="istickedoff">extractPath = worker . simplify . lowerTransformations . pathify</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff">worker (GroupTree g) = <span class="nottickedoff">concatMap worker (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff">worker (PathTree p) = p^.pathDefinition</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff">worker _ = <span class="nottickedoff">[]</span></span></span>
|
||||
<span class="lineno"> 142 </span>
|
||||
<span class="lineno"> 143 </span>-- | Map over indexed symbols.
|
||||
<span class="lineno"> 144 </span>--
|
||||
<span class="lineno"> 145 </span>-- @withSubglyphs [0,2] (scale 2) (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2])
|
||||
<span class="lineno"> 146 </span>-- = mkGroup [scale 2 (mkCircle 1), mkRect 2, scale 2 (mkEllipse 1 2)]@
|
||||
<span class="lineno"> 147 </span>withSubglyphs :: [Int] -> (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 148 </span><span class="decl"><span class="nottickedoff">withSubglyphs target fn = \t -> evalState (worker t) 0</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">worker :: Tree -> State Int Tree</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">worker t =</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">case t of</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree g -> do</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">cs <- mapM worker (g ^. groupChildren)</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">return $ GroupTree $ g & groupChildren .~ cs</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">PathTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="nottickedoff">CircleTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="nottickedoff">PolyLineTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="nottickedoff">PolygonTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="nottickedoff">EllipseTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="nottickedoff">LineTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="nottickedoff">RectangleTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff">_ -> return t</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph :: Tree -> State Int Tree</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph svg = do</span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="nottickedoff">n <- get <* modify (+1)</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="nottickedoff">if n `elem` target</span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="nottickedoff">then return $ fn svg</span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="nottickedoff">else return svg</span></span>
|
||||
<span class="lineno"> 170 </span>
|
||||
<span class="lineno"> 171 </span>-- | Split symbols.
|
||||
<span class="lineno"> 172 </span>--
|
||||
<span class="lineno"> 173 </span>-- @splitGlyphs [0,2] (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2])
|
||||
<span class="lineno"> 174 </span>-- = ([mkRect 2], [mkCircle 1, mkEllipse 1 2])@
|
||||
<span class="lineno"> 175 </span>splitGlyphs :: [Int] -> Tree -> (Tree, Tree)
|
||||
<span class="lineno"> 176 </span><span class="decl"><span class="nottickedoff">splitGlyphs target = \t -></span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="nottickedoff">let (_, l, r) = execState (worker id t) (0, [], [])</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">in (mkGroup l, mkGroup r)</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph :: Tree -> State (Int, [Tree], [Tree]) ()</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph t = do</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="nottickedoff">(n, l, r) <- get</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="nottickedoff">if n `elem` target</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="nottickedoff">then put (n+1, l, t:r)</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff">else put (n+1, t:l, r)</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff">worker :: (Tree -> Tree) -> Tree -> State (Int, [Tree], [Tree]) ()</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff">worker acc t =</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="nottickedoff">case t of</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree g -> do</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="nottickedoff">let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])</span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="nottickedoff">mapM_ (worker acc') (g ^. groupChildren)</span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="nottickedoff">PathTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="nottickedoff">CircleTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="nottickedoff">PolyLineTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="nottickedoff">PolygonTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="nottickedoff">EllipseTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="nottickedoff">LineTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="nottickedoff">RectangleTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="nottickedoff">DefinitionTree{} -> return ()</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="nottickedoff">_ -></span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="nottickedoff">modify $ \(n, l, r) -> (n, acc t:l, r)</span></span>
|
||||
<span class="lineno"> 202 </span>{-
|
||||
<span class="lineno"> 203 </span><g transform="translate(10,10)">
|
||||
<span class="lineno"> 204 </span> <g transform="scale(2)">
|
||||
<span class="lineno"> 205 </span> <circle/>
|
||||
<span class="lineno"> 206 </span> </g>
|
||||
<span class="lineno"> 207 </span> <g transform="scale(0.5)">
|
||||
<span class="lineno"> 208 </span> <rect/>
|
||||
<span class="lineno"> 209 </span> </g>
|
||||
<span class="lineno"> 210 </span></g>
|
||||
<span class="lineno"> 211 </span>
|
||||
<span class="lineno"> 212 </span>[ (\svg -> <g transform="translate(10,10)"><g transform="scale(2)">svg</g></g>, <circle/>)
|
||||
<span class="lineno"> 213 </span>, (\svg -> <g transform="translate(10,10)"><g transform="scale(0.5)">svg</g></g>, <rect/>)]
|
||||
<span class="lineno"> 214 </span>-}
|
||||
<span class="lineno"> 215 </span>-- | Split symbols and include their context and drawing attributes.
|
||||
<span class="lineno"> 216 </span>svgGlyphs :: Tree -> [(Tree -> Tree, DrawAttributes, Tree)]
|
||||
<span class="lineno"> 217 </span><span class="decl"><span class="istickedoff">svgGlyphs = worker <span class="nottickedoff">id</span> defaultSvg</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="istickedoff">worker acc attr =</span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="istickedoff">\case</span>
|
||||
<span class="lineno"> 221 </span><span class="spaces"> </span><span class="istickedoff">None -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -></span>
|
||||
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])</span></span>
|
||||
<span class="lineno"> 224 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">attr' = (g^.drawAttributes) `mappend` attr</span></span>
|
||||
<span class="lineno"> 225 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in concatMap (worker acc' attr') (g ^. groupChildren)</span></span>
|
||||
<span class="lineno"> 226 </span><span class="spaces"> </span><span class="istickedoff">t -> [(<span class="nottickedoff">acc</span>, (t^.drawAttributes) `mappend` attr, t)]</span></span>
|
||||
<span class="lineno"> 227 </span>
|
||||
<span class="lineno"> 228 </span>{-| Convert primitive SVG shapes (like those created by 'mkCircle', 'mkRect', 'mkLine' or
|
||||
<span class="lineno"> 229 </span> 'mkEllipse') into SVG path. This can be useful for creating animations of these shapes being
|
||||
<span class="lineno"> 230 </span> drawn progressively with 'partialSvg'.
|
||||
<span class="lineno"> 231 </span>
|
||||
<span class="lineno"> 232 </span> Example:
|
||||
<span class="lineno"> 233 </span>
|
||||
<span class="lineno"> 234 </span> > pathifyExample :: Animation
|
||||
<span class="lineno"> 235 </span> > pathifyExample = animate $ \t -> gridLayout
|
||||
<span class="lineno"> 236 </span> > [ [ partialSvg t $ pathify $ mkCircle 1
|
||||
<span class="lineno"> 237 </span> > , partialSvg t $ pathify $ mkRect 2 2
|
||||
<span class="lineno"> 238 </span> > ]
|
||||
<span class="lineno"> 239 </span> > , [ partialSvg t $ pathify $ mkEllipse 1 0.5
|
||||
<span class="lineno"> 240 </span> > , partialSvg t $ pathify $ mkLine (-1, -1) (1, 1)
|
||||
<span class="lineno"> 241 </span> > ]
|
||||
<span class="lineno"> 242 </span> > ]
|
||||
<span class="lineno"> 243 </span>
|
||||
<span class="lineno"> 244 </span> <<docs/gifs/doc_pathify.gif>>
|
||||
<span class="lineno"> 245 </span> -}
|
||||
<span class="lineno"> 246 </span>pathify :: Tree -> Tree
|
||||
<span class="lineno"> 247 </span><span class="decl"><span class="istickedoff">pathify = mapTree worker</span>
|
||||
<span class="lineno"> 248 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="istickedoff">worker =</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="istickedoff">\case</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="istickedoff">RectangleTree rect | Just (x,y,w,h) <- unpackRect rect -></span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ rect ^. drawAttributes</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="istickedoff">& strokeLineCap .~ pure CapSquare</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 x y]</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="istickedoff">,HorizontalTo OriginRelative [w]</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="istickedoff">,VerticalTo OriginRelative [h]</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="istickedoff">,HorizontalTo OriginRelative [-w]</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="istickedoff">,EndPath ]</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="istickedoff">LineTree line | Just (x1,y1, x2, y2) <- unpackLine line -></span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ line ^. drawAttributes</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 x1 y1]</span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="istickedoff">,LineTo OriginAbsolute [V2 x2 y2] ]</span>
|
||||
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="istickedoff">CircleTree circ | Just (x, y, r) <- unpackCircle circ -></span>
|
||||
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ circ ^. drawAttributes</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 (x-r) y]</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">,EllipticalArc OriginRelative [(r, r, 0,True,False,V2 (r*2) 0)</span>
|
||||
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="istickedoff">,(r, r, 0,True,False,V2 (-r*2) 0)]]</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="istickedoff">PolyLineTree pl -></span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let points = pl ^. polyLinePoints</span></span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in PathTree $ defaultSvg</span></span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& drawAttributes .~ pl ^. drawAttributes</span></span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& pathDefinition .~ pointsToPathCommands points</span></span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="istickedoff">PolygonTree pg -></span>
|
||||
<span class="lineno"> 280 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let points = pg ^. polygonPoints</span></span>
|
||||
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in PathTree $ defaultSvg</span></span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& drawAttributes .~ pg ^. drawAttributes</span></span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Polygon automatically connects the last point to the first. For path we must do</span></span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- it explicitly</span></span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& pathDefinition .~ (pointsToPathCommands points ++ [EndPath])</span></span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="istickedoff">EllipseTree elip | Just (cx,cy,rx,ry) <- unpackEllipse elip -></span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ elip ^. drawAttributes</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="istickedoff">[ MoveTo OriginAbsolute [V2 (cx-rx) cy]</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="istickedoff">, EllipticalArc OriginRelative [(rx, ry, 0,True,False,V2 (rx*2) 0)</span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="istickedoff">,(rx, ry, 0,True,False,V2 (-rx*2) 0)]]</span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="istickedoff">t -> t</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="istickedoff">unpackCircle circ = do</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="istickedoff">let (x,y) = circ ^. circleCenter</span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="istickedoff">liftM3 (,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ circ ^. circleRadius)</span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="istickedoff">unpackEllipse elip = do</span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="istickedoff">let (x,y) = elip ^. ellipseCenter</span>
|
||||
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="istickedoff">liftM4 (,,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ elip ^. ellipseXRadius)</span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="istickedoff">(unpackNumber $ elip ^. ellipseYRadius)</span>
|
||||
<span class="lineno"> 301 </span><span class="spaces"> </span><span class="istickedoff">unpackLine line = do</span>
|
||||
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="istickedoff">let (x1,y1) = line ^. linePoint1</span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="istickedoff">(x2,y2) = line ^. linePoint2</span>
|
||||
<span class="lineno"> 304 </span><span class="spaces"> </span><span class="istickedoff">liftM4 (,,,) (unpackNumber x1) (unpackNumber y1) (unpackNumber x2) (unpackNumber y2)</span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="istickedoff">unpackRect rect = do</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="istickedoff">let (x', y') = rect ^. rectUpperLeftCorner</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="istickedoff">x <- unpackNumber x'</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="istickedoff">y <- unpackNumber y'</span>
|
||||
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="istickedoff">w <- unpackNumber =<< rect ^. rectWidth</span>
|
||||
<span class="lineno"> 310 </span><span class="spaces"> </span><span class="istickedoff">h <- unpackNumber =<< rect ^. rectHeight</span>
|
||||
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="istickedoff">return (x,y,w,h)</span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pointsToPathCommands points = case points of</span></span>
|
||||
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[] -> []</span></span>
|
||||
<span class="lineno"> 314 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(p:ps) -> [ MoveTo OriginAbsolute [p]</span></span>
|
||||
<span class="lineno"> 315 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, LineTo OriginAbsolute ps ]</span></span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="istickedoff">unpackNumber n =</span>
|
||||
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="istickedoff">case toUserUnit <span class="nottickedoff">defaultDPI</span> n of</span>
|
||||
<span class="lineno"> 318 </span><span class="spaces"> </span><span class="istickedoff">Num d -> Just d</span>
|
||||
<span class="lineno"> 319 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">Nothing</span></span></span>
|
||||
<span class="lineno"> 320 </span>
|
||||
<span class="lineno"> 321 </span>-- | Map over all recursively-found path commands.
|
||||
<span class="lineno"> 322 </span>mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG
|
||||
<span class="lineno"> 323 </span><span class="decl"><span class="nottickedoff">mapSvgPaths fn = mapTree worker</span>
|
||||
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="nottickedoff">worker =</span>
|
||||
<span class="lineno"> 326 </span><span class="spaces"> </span><span class="nottickedoff">\case</span>
|
||||
<span class="lineno"> 327 </span><span class="spaces"> </span><span class="nottickedoff">PathTree path -> PathTree $</span>
|
||||
<span class="lineno"> 328 </span><span class="spaces"> </span><span class="nottickedoff">path & pathDefinition %~ fn</span>
|
||||
<span class="lineno"> 329 </span><span class="spaces"> </span><span class="nottickedoff">t -> t</span></span>
|
||||
<span class="lineno"> 330 </span>
|
||||
<span class="lineno"> 331 </span>-- | Map over all recursively-found line commands.
|
||||
<span class="lineno"> 332 </span>mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG
|
||||
<span class="lineno"> 333 </span><span class="decl"><span class="nottickedoff">mapSvgLines fn = mapSvgPaths (lineToPath . fn . toLineCommands)</span></span>
|
||||
<span class="lineno"> 334 </span>
|
||||
<span class="lineno"> 335 </span>-- Only maps points in paths
|
||||
<span class="lineno"> 336 </span>-- | Map over all line command control points.
|
||||
<span class="lineno"> 337 </span>mapSvgPoints :: (RPoint -> RPoint) -> SVG -> SVG
|
||||
<span class="lineno"> 338 </span><span class="decl"><span class="nottickedoff">mapSvgPoints fn = mapSvgLines (map worker)</span>
|
||||
<span class="lineno"> 339 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineMove p) = LineMove (fn p)</span>
|
||||
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineBezier ps) = LineBezier (map fn ps)</span>
|
||||
<span class="lineno"> 342 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineEnd p) = LineEnd (fn p)</span></span>
|
||||
<span class="lineno"> 343 </span>
|
||||
<span class="lineno"> 344 </span>-- | Convert coordinate system from degrees to radians.
|
||||
<span class="lineno"> 345 </span>svgPointsToRadians :: SVG -> SVG
|
||||
<span class="lineno"> 346 </span><span class="decl"><span class="nottickedoff">svgPointsToRadians = mapSvgPoints worker</span>
|
||||
<span class="lineno"> 347 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 348 </span><span class="spaces"> </span><span class="nottickedoff">worker (V2 x y) = V2 (x/180*pi) (y/180*pi)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
92
reanimate-0.4.2.0-inplace/Reanimate.Transform.hs.html
Normal file
92
reanimate-0.4.2.0-inplace/Reanimate.Transform.hs.html
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE BangPatterns #-}
|
||||
<span class="lineno"> 2 </span>{-|
|
||||
<span class="lineno"> 3 </span> 2D transformation matrices capable of translating, scaling,
|
||||
<span class="lineno"> 4 </span> rotating, and skewing.
|
||||
<span class="lineno"> 5 </span>-}
|
||||
<span class="lineno"> 6 </span>module Reanimate.Transform
|
||||
<span class="lineno"> 7 </span> ( identity
|
||||
<span class="lineno"> 8 </span> , transformPoint
|
||||
<span class="lineno"> 9 </span> , mkMatrix
|
||||
<span class="lineno"> 10 </span> , toTransformation
|
||||
<span class="lineno"> 11 </span> ) where
|
||||
<span class="lineno"> 12 </span>
|
||||
<span class="lineno"> 13 </span>-- XXX: Use Linear.Matrix instead of Data.Matrix to drop the 'matrix' dependency.
|
||||
<span class="lineno"> 14 </span>import Data.List
|
||||
<span class="lineno"> 15 </span>import Data.Matrix (Matrix)
|
||||
<span class="lineno"> 16 </span>import qualified Data.Matrix as M
|
||||
<span class="lineno"> 17 </span>import Data.Maybe
|
||||
<span class="lineno"> 18 </span>import Graphics.SvgTree
|
||||
<span class="lineno"> 19 </span>import Linear.V2
|
||||
<span class="lineno"> 20 </span>
|
||||
<span class="lineno"> 21 </span>-- | Identity matrix.
|
||||
<span class="lineno"> 22 </span>--
|
||||
<span class="lineno"> 23 </span>-- @transformPoints identity x = x@
|
||||
<span class="lineno"> 24 </span>identity :: Matrix Coord
|
||||
<span class="lineno"> 25 </span><span class="decl"><span class="istickedoff">identity = M.identity 3</span></span>
|
||||
<span class="lineno"> 26 </span>
|
||||
<span class="lineno"> 27 </span>fromList :: [Coord] -> Matrix Coord
|
||||
<span class="lineno"> 28 </span><span class="decl"><span class="istickedoff">fromList [a,b,c,d,e,f] = M.fromList 3 3 [a,c,e,b,d,f,0,0,1]</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"></span><span class="istickedoff">fromList _ = <span class="nottickedoff">error "Reanimate.Transform.fromList: bad input"</span></span></span>
|
||||
<span class="lineno"> 30 </span>
|
||||
<span class="lineno"> 31 </span>-- | Apply a transformation matrix to a 2D point.
|
||||
<span class="lineno"> 32 </span>transformPoint :: Matrix Coord -> RPoint -> RPoint
|
||||
<span class="lineno"> 33 </span><span class="decl"><span class="istickedoff">transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="istickedoff">!a = M.unsafeGet 1 1 m</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="istickedoff">!c = M.unsafeGet 1 2 m</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">!e = M.unsafeGet 1 3 m</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">!b = M.unsafeGet 2 1 m</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">!d = M.unsafeGet 2 2 m</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">!f = M.unsafeGet 2 3 m</span></span>
|
||||
<span class="lineno"> 41 </span> -- (a:c:e:b:d:f:_) = M.toList m
|
||||
<span class="lineno"> 42 </span>
|
||||
<span class="lineno"> 43 </span>-- | Convert multiple SVG transformations into a single transformation matrix.
|
||||
<span class="lineno"> 44 </span>mkMatrix :: Maybe [Transformation] -> Matrix Coord
|
||||
<span class="lineno"> 45 </span><span class="decl"><span class="istickedoff">mkMatrix Nothing = identity</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"></span><span class="istickedoff">mkMatrix (Just ts) = foldl' (*) identity (map transformationMatrix ts)</span></span>
|
||||
<span class="lineno"> 47 </span>
|
||||
<span class="lineno"> 48 </span>-- | Convert an SVG transformation into a transformation matrix.
|
||||
<span class="lineno"> 49 </span>transformationMatrix :: Transformation -> Matrix Coord
|
||||
<span class="lineno"> 50 </span><span class="decl"><span class="istickedoff">transformationMatrix transformation =</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="istickedoff">case transformation of</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff">TransformMatrix a b c d e f -> <span class="nottickedoff">fromList [a,b,c,d,e,f]</span></span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">Translate x y -> <span class="nottickedoff">translate x y</span></span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff">Scale sx mbSy -> fromList [sx,0,0,fromMaybe <span class="nottickedoff">sx</span> mbSy,0,0]</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">Rotate a Nothing -> <span class="nottickedoff">rotate a</span></span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">Rotate a (Just (x,y)) -> <span class="nottickedoff">translate x y * rotate a * translate (-x) (-y)</span></span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">SkewX a -> <span class="nottickedoff">fromList [1,0,tan (a*pi/180),1,0,0]</span></span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">SkewY a -> <span class="nottickedoff">fromList [1,tan (a*pi/180),0,1,0,0]</span></span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">TransformUnknown -> <span class="nottickedoff">identity</span></span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">translate x y = fromList [1,0,0,1,x,y]</span></span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">rotate a = fromList [cos r,sin r,-sin r,cos r,0,0]</span></span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">where r = a * pi / 180</span></span></span>
|
||||
<span class="lineno"> 64 </span>
|
||||
<span class="lineno"> 65 </span>-- | Convert a transformation matrix back into an SVG transformation.
|
||||
<span class="lineno"> 66 </span>toTransformation :: Matrix Coord -> Transformation
|
||||
<span class="lineno"> 67 </span><span class="decl"><span class="nottickedoff">toTransformation m = TransformMatrix a b c d e f</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">[a,c,e,b,d,f,_,_,_] = M.toList m</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
99
reanimate-0.4.2.0-inplace/Reanimate.Transition.hs.html
Normal file
99
reanimate-0.4.2.0-inplace/Reanimate.Transition.hs.html
Normal file
|
|
@ -0,0 +1,99 @@
|
|||
<html>
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
||||
<style type="text/css">
|
||||
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
||||
span.nottickedoff { background: yellow}
|
||||
span.istickedoff { background: white }
|
||||
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
||||
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
||||
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
||||
span.decl { font-weight: bold }
|
||||
span.spaces { background: white }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<pre>
|
||||
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
||||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span>Copyright : Written by David Himmelstrup
|
||||
<span class="lineno"> 3 </span>License : Unlicense
|
||||
<span class="lineno"> 4 </span>Maintainer : lemmih@gmail.com
|
||||
<span class="lineno"> 5 </span>Stability : experimental
|
||||
<span class="lineno"> 6 </span>Portability : POSIX
|
||||
<span class="lineno"> 7 </span>-}
|
||||
<span class="lineno"> 8 </span>module Reanimate.Transition
|
||||
<span class="lineno"> 9 </span> ( Transition
|
||||
<span class="lineno"> 10 </span> , signalT
|
||||
<span class="lineno"> 11 </span> , mapT
|
||||
<span class="lineno"> 12 </span> , overlapT
|
||||
<span class="lineno"> 13 </span> , chainT
|
||||
<span class="lineno"> 14 </span> , effectT
|
||||
<span class="lineno"> 15 </span> , fadeT
|
||||
<span class="lineno"> 16 </span> ) where
|
||||
<span class="lineno"> 17 </span>
|
||||
<span class="lineno"> 18 </span>import Reanimate.Animation
|
||||
<span class="lineno"> 19 </span>import Reanimate.Ease
|
||||
<span class="lineno"> 20 </span>import Reanimate.Effect
|
||||
<span class="lineno"> 21 </span>
|
||||
<span class="lineno"> 22 </span>-- | A transition transforms one animation into another.
|
||||
<span class="lineno"> 23 </span>type Transition = Animation -> Animation -> Animation
|
||||
<span class="lineno"> 24 </span>
|
||||
<span class="lineno"> 25 </span>-- | Apply a signal to the timing of a transition.
|
||||
<span class="lineno"> 26 </span>signalT :: Signal -> Transition -> Transition
|
||||
<span class="lineno"> 27 </span><span class="decl"><span class="istickedoff">signalT = mapT . signalA</span></span>
|
||||
<span class="lineno"> 28 </span>
|
||||
<span class="lineno"> 29 </span>-- | Map the result of a transition.
|
||||
<span class="lineno"> 30 </span>mapT :: (Animation -> Animation) -> Transition -> Transition
|
||||
<span class="lineno"> 31 </span><span class="decl"><span class="istickedoff">mapT fn t a b = fn (t a b)</span></span>
|
||||
<span class="lineno"> 32 </span>
|
||||
<span class="lineno"> 33 </span>-- | Apply transition only to @N@ seconds of the first
|
||||
<span class="lineno"> 34 </span>-- animation and to the last @N@ seconds of the second animation.
|
||||
<span class="lineno"> 35 </span>--
|
||||
<span class="lineno"> 36 </span>-- Example:
|
||||
<span class="lineno"> 37 </span>--
|
||||
<span class="lineno"> 38 </span>-- > overlapT 0.5 fadeT drawBox drawCircle
|
||||
<span class="lineno"> 39 </span>--
|
||||
<span class="lineno"> 40 </span>-- <<docs/gifs/doc_overlapT.gif>>
|
||||
<span class="lineno"> 41 </span>overlapT :: Double -> Transition -> Transition
|
||||
<span class="lineno"> 42 </span><span class="decl"><span class="istickedoff">overlapT overlap t a b =</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="istickedoff">aBefore `seqA` t aOverlap bOverlap `seqA` bAfter</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff">aBefore = takeA (duration a - overlap) a</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">aOverlap = lastA overlap a</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff">bOverlap = takeA overlap b</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff">bAfter = dropA overlap b</span></span>
|
||||
<span class="lineno"> 49 </span>
|
||||
<span class="lineno"> 50 </span>
|
||||
<span class="lineno"> 51 </span>-- | Create a transition between two animations by applying an effect to each respective animation.
|
||||
<span class="lineno"> 52 </span>effectT :: Effect -- ^ Effect to be applied to the first animation.
|
||||
<span class="lineno"> 53 </span> -> Effect -- ^ Effect to be applied to the second animation.
|
||||
<span class="lineno"> 54 </span> -> Transition
|
||||
<span class="lineno"> 55 </span><span class="decl"><span class="istickedoff">effectT eA eB a b = applyE eA a `parA` applyE eB b</span></span>
|
||||
<span class="lineno"> 56 </span>
|
||||
<span class="lineno"> 57 </span>-- | Combine a list of animations using a given transition.
|
||||
<span class="lineno"> 58 </span>--
|
||||
<span class="lineno"> 59 </span>-- Example:
|
||||
<span class="lineno"> 60 </span>--
|
||||
<span class="lineno"> 61 </span>-- > chainT (overlapT 0.5 fadeT) [drawBox, drawCircle, drawProgress]
|
||||
<span class="lineno"> 62 </span>--
|
||||
<span class="lineno"> 63 </span>-- <<docs/gifs/doc_chainT.gif>>
|
||||
<span class="lineno"> 64 </span>chainT :: Transition -> [Animation] -> Animation
|
||||
<span class="lineno"> 65 </span><span class="decl"><span class="istickedoff">chainT _ [] = <span class="nottickedoff">pause 0</span></span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"></span><span class="istickedoff">chainT t (x:xs) = foldl t x xs</span></span>
|
||||
<span class="lineno"> 67 </span>
|
||||
<span class="lineno"> 68 </span>-- | Fade out left-hand-side animation while fading in right-hand-side animation.
|
||||
<span class="lineno"> 69 </span>--
|
||||
<span class="lineno"> 70 </span>-- Example:
|
||||
<span class="lineno"> 71 </span>--
|
||||
<span class="lineno"> 72 </span>-- > drawBox `fadeT` drawCircle
|
||||
<span class="lineno"> 73 </span>--
|
||||
<span class="lineno"> 74 </span>-- <<docs/gifs/doc_fadeT.gif>>
|
||||
<span class="lineno"> 75 </span>fadeT :: Transition
|
||||
<span class="lineno"> 76 </span><span class="decl"><span class="istickedoff">fadeT = effectT fadeOutE fadeInE</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
</html>
|
||||
Loading…
Reference in a new issue