diff --git a/haddock.txt b/haddock.txt index c897628..d57c03f 100644 --- a/haddock.txt +++ b/haddock.txt @@ -1,5 +1,4 @@ 100% (155 /155) in 'Reanimate' - 100% (113 /113) in 'Reanimate.Scene' 100% ( 55 / 55) in 'Reanimate.Svg.Constructors' 100% ( 41 / 41) in 'Reanimate.Animation' 100% ( 40 / 40) in 'Reanimate.GeoProjection' @@ -37,3 +36,4 @@ 100% ( 3 / 3) in 'Reanimate.Math.Balloon' 100% ( 3 / 3) in 'Reanimate.Blender' 100% ( 2 / 2) in 'Reanimate.Builtin.CirclePlot' + 90% (113 /126) in 'Reanimate.Scene' diff --git a/hpc_badge.json b/hpc_badge.json index 4f3912c..2b5e58c 100644 --- a/hpc_badge.json +++ b/hpc_badge.json @@ -1 +1 @@ - { "schemaVersion": 1, "label": "api tests", "message": "31%", "color": "success" } + { "schemaVersion": 1, "label": "api tests", "message": "30%", "color": "success" } diff --git a/hpc_index.html b/hpc_index.html index 39ffa3e..28207e2 100644 --- a/hpc_index.html +++ b/hpc_index.html @@ -101,7 +101,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 5%1/19
0%0/53
4%39/852
  module reanimate-0.4.3.0-inplace/Reanimate.Scene -30%40/130
60%15/25
36%545/1483
+27%40/144
55%15/27
32%545/1694
  module reanimate-0.4.3.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
@@ -125,5 +125,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 100%6/6
50%1/2
95%43/45
  Program Coverage Total -31%248/800
15%131/828
29%4682/15607
+30%248/814
15%131/830
29%4682/15818
diff --git a/hpc_index_alt.html b/hpc_index_alt.html index 2e6ed3e..633e1f3 100644 --- a/hpc_index_alt.html +++ b/hpc_index_alt.html @@ -16,15 +16,15 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }   module reanimate-0.4.3.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
-  module reanimate-0.4.3.0-inplace/Reanimate.Scene -30%40/130
60%15/25
36%545/1483
-   module reanimate-0.4.3.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.4.3.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
+  module reanimate-0.4.3.0-inplace/Reanimate.Scene +27%40/144
55%15/27
32%545/1694
+   module reanimate-0.4.3.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
@@ -125,5 +125,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 15%3/20
- 0/0 14%7/49
  Program Coverage Total -31%248/800
15%131/828
29%4682/15607
+30%248/814
15%131/830
29%4682/15818
diff --git a/hpc_index_exp.html b/hpc_index_exp.html index 47f9905..f7add01 100644 --- a/hpc_index_exp.html +++ b/hpc_index_exp.html @@ -50,7 +50,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 33%5/15
5%1/20
40%133/325
  module reanimate-0.4.3.0-inplace/Reanimate.Scene -30%40/130
60%15/25
36%545/1483
+27%40/144
55%15/27
32%545/1694
  module reanimate-0.4.3.0-inplace/Geom2D.CubicBezier.Linear 20%20/99
5%2/36
28%102/356
@@ -125,5 +125,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 0%0/1
0%0/4
0%0/61
  Program Coverage Total -31%248/800
15%131/828
29%4682/15607
+30%248/814
15%131/830
29%4682/15818
diff --git a/hpc_index_fun.html b/hpc_index_fun.html index 0beadcc..5bbe190 100644 --- a/hpc_index_fun.html +++ b/hpc_index_fun.html @@ -65,7 +65,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 33%1/3
0%0/14
21%28/128
  module reanimate-0.4.3.0-inplace/Reanimate.Scene -30%40/130
60%15/25
36%545/1483
+27%40/144
55%15/27
32%545/1694
  module reanimate-0.4.3.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
@@ -125,5 +125,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 0%0/1
0%0/4
0%0/61
  Program Coverage Total -31%248/800
15%131/828
29%4682/15607
+30%248/814
15%131/830
29%4682/15818
diff --git a/playground/snippets.js b/playground/snippets.js index 394f7dc..8f4b533 100644 --- a/playground/snippets.js +++ b/playground/snippets.js @@ -2,11 +2,11 @@ const snippets = [{"title": "Hello World","url": "https://reanimate.clozecards.c ,{"title": "Composition","url": "https://reanimate.clozecards.com/ECv3cbsbuMV/150.svg","code": "animation :: Animation\nanimation = docEnv $ sceneAnimation $ do\n play $ drawBox `parA` drawCircle\n & label \"parA\"\n play $ drawBox `seqA` drawCircle\n & label \"seqA\"\n play $ drawBox `andThen` drawCircle\n & label \"andThen\"\n\nlabel txt = addStatic $\n withFillOpacity 1 $ withStrokeWidth 0 $\n withFillColor \"black\" $\n translate screenLeft (screenBottom+0.2) $\n latex txt\n"} ,{"title": "Color Maps","url": "https://reanimate.clozecards.com/Ezuf27J2YrF/60.svg","code": "animation :: Animation\nanimation = docEnv $ sceneAnimation $ do\n play $ staticFrame 1 (showColorMap parula)\n & label \"Parula\"\n play $ staticFrame 1 (showColorMap viridis)\n & label \"Viridis\"\n play $ staticFrame 1 (showColorMap turbo)\n & label \"Turbo\"\n play $ staticFrame 1 (showColorMap greyscale)\n & label \"Greyscale\"\n\nlabel txt = overlay $\n withFillOpacity 1 $ withStrokeWidth 0 $\n withFillColor \"white\" $\n translate screenLeft (screenBottom+0.2) $\n latex txt\n\noverlay svg ani = ani `parA` staticFrame (duration ani) svg\n"} ,{"title": "Try it live","url": "https://reanimate.clozecards.com/OwjMi4FCJ4Z/90.svg","code": "background = \"lightblue\"\n\nshape :: SVG\nshape = mkCircle 4\n--shape = mkRect 6 6\n--shape = mkLine (screenLeft, screenBottom) (screenRight, screenTop)\n\nanimation :: Animation\nanimation = docEnv $\n addStatic (mkBackground background) $\n playThenReverseA $\n signalA (curveS 2) $\n setDuration 3 $ animate $ \\t ->\n partialSvg t $ pathify shape\n"} - ,{"title": "Basic Objects","url": "https://reanimate.clozecards.com/O0105YfECEH/90.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n sceneAnimation $ do\n circ <- newObject $ Circle 3\n oModify circ $\n oContext .~ withFillColor \"pink\"\n box <- newObject $ Rectangle 5 5\n oModify box $\n oContext .~ withFillColor \"lightblue\"\n \n oGrow circ 1; wait 1\n oTransform circ box 1; wait 1\n oFadeOut box 1; wait 1\n"} + ,{"title": "Basic Objects","url": "https://reanimate.clozecards.com/LvoPSTEzZlg/90.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n sceneAnimation $ do\n circ <- newObject $ Circle 3\n oModify circ $\n oContext .~ withFillColor \"pink\"\n box <- newObject $ Rectangle 5 5\n oModify box $\n oContext .~ withFillColor \"lightblue\"\n \n oShowWith circ oGrow; wait 1\n oTransform circ box 1; wait 1\n oHideWith box oFadeOut; wait 1\n"} ,{"title": "LaTeX","url": "https://reanimate.clozecards.com/PXPuugoHzrR/181.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n sceneAnimation $ do\n drawLatex \"e^{i\\\\pi}+1=0\"\n drawLatex \"\\\\sum_{k=1}^\\\\infty {1 \\\\over k^2} = {\\\\pi^2 \\\\over 6}\"\n drawLatex \"\\\\sum_{k=1}^\\\\infty\"\n wait 1\n\ndrawLatex txt = do\n -- Draw outline\n fork $ do\n play $ animate $ \\t ->\n withFillOpacity 0 $\n partialSvg t svg\n -- Fade outline\n play $ animate $ \\t ->\n withFillOpacity 0 $\n withStrokeWidth (defaultStrokeWidth*(1-t)) $\n svg\n wait 0.7\n -- Fill in letters\n play $ animate $ \\t ->\n withFillOpacity t $ withStrokeWidth 0 $\n svg\n -- Hold static image and then fade out\n play $ staticFrame 2 (withStrokeWidth 0 svg)\n & applyE (overEnding 0.3 fadeOutE)\n where\n svg = scale 2 $ center $ latexAlign txt\n"} ,{"title": "Easing Functions","url": "https://reanimate.clozecards.com/P4F3jzh2Mcj/45.svg","code": "animation :: Animation\nanimation = docEnv $ pauseAtEnd 1 $ sceneAnimation $ do\n showEasing 0 \"curveS\" (curveS 2)\n showEasing 1 \"bellS\" (bellS 2)\n showEasing 2 \"constantS\" (constantS 0.7)\n showEasing 3 \"oscillateS\" oscillateS\n showEasing 4 \"powerS\" (powerS 2)\n showEasing 5 \"reverseS\" reverseS\n showEasing 6 \"id\" id\n\nshowEasing nth txt fn = do\n let yOffset | even nth = 0\n | odd nth = -1\n xOffset = -6 + fromIntegral nth*2\n newSpriteSVG_ $\n \ttranslate xOffset yOffset $\n label txt\n fork $ play $ mapA (translate xOffset 0) $\n mapA (rotate 90) $\n mapA (scale (screenHeight/screenWidth * 0.6)) $\n signalA fn drawProgress\n\nlabel txt =\n translate 0 (-2.5) $\n scale 0.7 $\n center $\n withStrokeWidth 0 $\n withFillOpacity 1 $\n svg\n where\n svg = latex txt\n"} ,{"title": "Easing Graphs","url": "https://reanimate.clozecards.com/FEyCDsj0V82/255.svg","code": "colorPalette = parula -- try: viridis, sinebow, turbo, cividis\nfns =\n [(\"curveS\", curveS 2)\n ,(\"bellS\", bellS 2)\n ,(\"constantS\", constantS 0.7)\n ,(\"oscillateS\", oscillateS)\n ,(\"powerS\", powerS 2)\n ,(\"reverseS\", reverseS)\n ,(\"id\", id)\n ]\n\nanimation :: Animation\nanimation = docEnv $ pauseAtEnd 1 $ sceneAnimation $ do\n newSpriteSVG_ $ mkBackground \"white\"\n play $ signalA (curveS 2) $ animate $ \\t -> partialSvg t grid\n newSpriteSVG_ grid\n wait 1\n flip mapM_ (zip [0..] fns) $ \\(nth, (txt, fn)) -> do\n let color = promotePixel $ colorPalette (nth / fromIntegral (length fns-1))\n showEasing nth txt fn color\n {- showEasing 3 \"oscillateS\" oscillateS\n showEasing 4 \"powerS\" (powerS 2)\n showEasing 5 \"reverseS\" reverseS\n showEasing 6 \"id\" id -}\n\ngridOffset = -2\ngridHeight = 5\ngridWidth = 8\n\ngrid :: SVG\ngrid = translate gridOffset 0 $\n withStrokeWidth defaultStrokeWidth $\n withStrokeColor \"grey\" $ mkGroup\n [ mkPath $ concat\n [[ SVG.MoveTo SVG.OriginAbsolute [V2 (-gridWidth/2) (gridHeight/2-n)]\n ,SVG.HorizontalTo SVG.OriginRelative [gridWidth] ]\n | n <- [1..gridHeight-1]\n ]\n , mkPath \n [ SVG.MoveTo SVG.OriginAbsolute [V2 (-gridWidth/2) (gridHeight/2)]\n , SVG.VerticalTo SVG.OriginRelative [-gridHeight]\n , SVG.HorizontalTo SVG.OriginRelative [gridWidth]\n , SVG.VerticalTo SVG.OriginRelative [gridHeight]\n , SVG.EndPath\n ]\n ]\n\nshowEasing nth txt fn color = do\n let steps = 100\n slope = withStrokeColorPixel color $\n translate gridOffset 0 $ mkLinePath\n [ ((x/steps-0.5)*gridWidth, (y-0.5)*gridHeight)\n | x <- [0..steps]\n , let y = fn (x/steps) ]\n s <- newSpriteSVG $\n withFillColorPixel color $\n translate (gridWidth/2+gridOffset+0.5) (gridHeight/2-nth) $\n label txt\n spriteE s $ overBeginning 0.2 fadeInE\n play $ animate $ \\t -> partialSvg t slope\n newSpriteSVG_ slope\n wait 1\n \nlabel txt = withStrokeColor \"black\" $\n withStrokeWidth (defaultStrokeWidth*2) $\n withFillOpacity 1 $\n latex txt\n"} - ,{"title": "Object Positions","url": "https://reanimate.clozecards.com/OdYISph5tKE/195.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n sceneAnimation $ do\n -- Configure objects\n txt <- newText \"Center\"\n top <- newText \"Top\"\n oModifyS top $ \n oTopY .= screenTop\n topR <- newText \"Top right\"\n oModifyS topR $ do\n oTopY .= screenTop\n oRightX .= screenRight\n botR <- newText \"Bottom right\"\n oModifyS botR $ do\n oTranslate .= (0, screenBottom+0.5)\n oRightX .= screenRight\n botL <- newText \"Bottom left\"\n oModifyS botL $ do\n oTranslate .= (0, screenBottom+0.5)\n oLeftX .= screenLeft\n topL <- newText \"Top left\"\n oModifyS topL $ do\n oTopY .= screenTop\n oLeftX .= screenLeft\n -- Show objects\n oShow txt\n wait 1\n switchTo txt top\n switchTo top topR\n switchTo topR botR\n switchTo botR botL\n switchTo botL topL\n switchTo topL txt\n\nswitchTo src dst = do\n fork $ oFadeOut src 1\n oModify dst $ oOpacity .~ 1\n oFadeIn dst 1\n wait 1\n\nnewText txt =\n newObject $ scale 1.5 $ centerX $ latex txt\n"} + ,{"title": "Object Positions","url": "https://reanimate.clozecards.com/Mf4zcImo+I7/195.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n sceneAnimation $ do\n -- Configure objects\n txt <- newText \"Center\"\n top <- newText \"Top\"\n oModifyS top $ \n oTopY .= screenTop\n topR <- newText \"Top right\"\n oModifyS topR $ do\n oTopY .= screenTop\n oRightX .= screenRight\n botR <- newText \"Bottom right\"\n oModifyS botR $ do\n oTranslate .= (0, screenBottom+0.5)\n oRightX .= screenRight\n botL <- newText \"Bottom left\"\n oModifyS botL $ do\n oTranslate .= (0, screenBottom+0.5)\n oLeftX .= screenLeft\n topL <- newText \"Top left\"\n oModifyS topL $ do\n oTopY .= screenTop\n oLeftX .= screenLeft\n -- Show objects\n oShow txt\n wait 1\n switchTo txt top\n switchTo top topR\n switchTo topR botR\n switchTo botR botL\n switchTo botL topL\n switchTo topL txt\n\nswitchTo src dst = do\n fork $ oHideWith src oFadeOut\n oShowWith dst oFadeIn\n wait 1\n\nnewText txt =\n newObject $ scale 1.5 $ centerX $ latex txt\n"} ,{"title": "Camera","url": "https://reanimate.clozecards.com/Hcx00P+aeph/150.svg","code": "animation :: Animation\nanimation = docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do\n cam <- newObject Camera\n\n txt <- newObject $ center $ latex \"Fixed (non-cam)\"\n oModifyS txt $ do\n oTopY .= screenTop \n oZIndex .= 2\n\n circle <- newObject $ withFillColor \"blue\" $ mkCircle 1\n cameraAttach cam circle\n circleRight <- oRead circle oRightX\n\n box <- newObject $ withFillColor \"green\" $ mkRect 2 2\n cameraAttach cam box\n oModify box $ oLeftX .~ circleRight\n boxCenter <- oRead box oCenterXY\n\n small <- newObject $ center $ latex \"This text is very small\"\n cameraAttach cam small\n oModifyS small $ do\n oCenterXY .= boxCenter\n oScale .= 0.1\n \n oShow txt\n oShow small\n oShow circle\n oShow box\n\n wait 1\n\n cameraFocus cam boxCenter\n waitOn $ do\n fork $ cameraPan cam 3 boxCenter\n fork $ cameraZoom cam 3 15\n \n wait 2\n cameraZoom cam 3 1\n cameraPan cam 1 (0,0)\n"} ]; -const playgroundVersion = "2020-09-01 (77975)"; +const playgroundVersion = "2020-09-01 (755fb)"; diff --git a/reanimate-0.4.3.0-inplace/Reanimate.Scene.hs.html b/reanimate-0.4.3.0-inplace/Reanimate.Scene.hs.html index 0232687..1e3981b 100644 --- a/reanimate-0.4.3.0-inplace/Reanimate.Scene.hs.html +++ b/reanimate-0.4.3.0-inplace/Reanimate.Scene.hs.html @@ -126,1123 +126,1217 @@ span.spaces { background: white } 107 , oGrow 108 , oShrink 109 , oTransform - 110 - 111 -- ** Pre-defined objects - 112 , Circle(..) - 113 , circleRadius - 114 , Rectangle(..) - 115 , rectWidth - 116 , rectHeight - 117 , Morph(..) - 118 , morphDelta - 119 , morphSrc - 120 , morphDst - 121 , Camera(..) - 122 , cameraAttach - 123 , cameraFocus - 124 , cameraSetZoom - 125 , cameraZoom - 126 , cameraSetPan - 127 , cameraPan - 128 - 129 -- * ST internals - 130 , liftST - 131 , transitionO - 132 , evalScene - 133 ) - 134 where - 135 - 136 import Control.Lens - 137 import Control.Monad (void) - 138 import Control.Monad.Fix - 139 import Control.Monad.ST - 140 import Control.Monad.State (execState, State) - 141 import Data.List - 142 import Data.STRef - 143 import Graphics.SvgTree (Tree (None)) - 144 import Reanimate.Animation - 145 import Reanimate.Ease (Signal, curveS, fromToS) - 146 import Reanimate.Effect - 147 import Reanimate.Svg.Constructors - 148 import Reanimate.Svg.BoundingBox - 149 import Reanimate.Transition - 150 import Reanimate.Morph.Common (morph) - 151 import Reanimate.Morph.Linear (linear) - 152 - 153 -- | The ZIndex property specifies the stack order of sprites and animations. Elements - 154 -- with a higher ZIndex will be drawn on top of elements with a lower index. - 155 type ZIndex = Int - 156 - 157 - 158 -- (seq duration, par duration) - 159 -- [(Time, Animation, ZIndex)] - 160 -- Map Time [(Animation, ZIndex)] - 161 type Gen s = ST s (Duration -> Time -> (SVG, ZIndex)) - 162 -- | A 'Scene' represents a sequence of animations and variables - 163 -- that change over time. - 164 newtype Scene s a = M { unM :: Time -> ST s (a, Duration, Duration, [Gen s]) } - 165 - 166 instance Functor (Scene s) where - 167 fmap f action = M $ \t -> do - 168 (a, d1, d2, gens) <- unM action t - 169 return (f a, d1, d2, gens) - 170 - 171 instance Applicative (Scene s) where - 172 pure a = M $ \_ -> return (a, 0, 0, []) - 173 f <*> g = M $ \t -> do - 174 (f', s1, p1, gen1) <- unM f t - 175 (g', s2, p2, gen2) <- unM g (t + s1) - 176 return (f' g', s1 + s2, max p1 (s1 + p2), gen1 ++ gen2) - 177 - 178 instance Monad (Scene s) where - 179 return = pure - 180 f >>= g = M $ \t -> do - 181 (a, s1, p1, gen1) <- unM f t - 182 (b, s2, p2, gen2) <- unM (g a) (t + s1) - 183 return (b, s1 + s2, max p1 (s1 + p2), gen1 ++ gen2) - 184 - 185 instance MonadFix (Scene s) where - 186 mfix fn = M $ \t -> mfix (\v -> let (a, _s, _p, _gens) = v in unM (fn a) t) - 187 - 188 -- | Lift an ST action into the Scene monad. - 189 liftST :: ST s a -> Scene s a - 190 liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, []) - 191 - 192 -- | Evaluate the value of a scene. - 193 evalScene :: (forall s . Scene s a) -> a - 194 evalScene action = runST $ do - 195 (val, _, _ , _) <- unM action 0 - 196 return val - 197 - 198 -- | Render a 'Scene' to an 'Animation'. - 199 scene :: (forall s . Scene s a) -> Animation - 200 scene = sceneAnimation - 201 - 202 -- | Render a 'Scene' to an 'Animation'. - 203 sceneAnimation :: (forall s . Scene s a) -> Animation - 204 sceneAnimation action = runST - 205 (do - 206 (_, s, p, gens) <- unM action 0 - 207 let dur = max s p - 208 genFns <- sequence gens - 209 return $ mkAnimation - 210 dur - 211 (\t -> mkGroup $ map fst $ sortOn - 212 snd - 213 [ spriteRender dur (t * dur) | spriteRender <- genFns ] - 214 ) - 215 ) - 216 - 217 -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before - 218 -- all forked actions have completed. - 219 -- - 220 -- Example: - 221 -- - 222 -- @ - 223 -- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox' - 224 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' - 225 -- @ - 226 -- - 227 -- <<docs/gifs/doc_fork.gif>> - 228 fork :: Scene s a -> Scene s a - 229 fork (M action) = M $ \t -> do - 230 (a, s, p, gens) <- action t - 231 return (a, 0, max s p, gens) + 110 , oShowWith + 111 , oHideWith + 112 , Origin + 113 , oScaleIn + 114 , oScaleIn' + 115 , oScaleOut + 116 , oScaleOut' + 117 , oSim + 118 , oStagger + 119 , oStaggerRev + 120 , oStagger' + 121 , oStaggerRev' + 122 , oDraw + 123 -- , oBalloon + 124 + 125 -- ** Pre-defined objects + 126 , Circle(..) + 127 , circleRadius + 128 , Rectangle(..) + 129 , rectWidth + 130 , rectHeight + 131 , Morph(..) + 132 , morphDelta + 133 , morphSrc + 134 , morphDst + 135 , Camera(..) + 136 , cameraAttach + 137 , cameraFocus + 138 , cameraSetZoom + 139 , cameraZoom + 140 , cameraSetPan + 141 , cameraPan + 142 + 143 -- * ST internals + 144 , liftST + 145 , transitionO + 146 , evalScene + 147 ) + 148 where + 149 + 150 import Control.Lens + 151 import Control.Monad (forM_, void) + 152 import Control.Monad.Fix + 153 import Control.Monad.ST + 154 import Control.Monad.State (State, execState) + 155 import Data.List + 156 import Data.Monoid + 157 import Data.STRef + 158 import Graphics.SvgTree (Number (..), Tree (None), strokeWidth, toUserUnit) + 159 import Reanimate.Animation + 160 import Reanimate.Constants + 161 import Reanimate.Ease (Signal, curveS, fromToS) + 162 import Reanimate.Effect + 163 import Reanimate.Math.Balloon + 164 import Reanimate.Morph.Common (morph) + 165 import Reanimate.Morph.Linear (linear) + 166 import Reanimate.Svg + 167 import Reanimate.Transition + 168 + 169 -- | The ZIndex property specifies the stack order of sprites and animations. Elements + 170 -- with a higher ZIndex will be drawn on top of elements with a lower index. + 171 type ZIndex = Int + 172 + 173 + 174 -- (seq duration, par duration) + 175 -- [(Time, Animation, ZIndex)] + 176 -- Map Time [(Animation, ZIndex)] + 177 type Gen s = ST s (Duration -> Time -> (SVG, ZIndex)) + 178 -- | A 'Scene' represents a sequence of animations and variables + 179 -- that change over time. + 180 newtype Scene s a = M { unM :: Time -> ST s (a, Duration, Duration, [Gen s]) } + 181 + 182 instance Functor (Scene s) where + 183 fmap f action = M $ \t -> do + 184 (a, d1, d2, gens) <- unM action t + 185 return (f a, d1, d2, gens) + 186 + 187 instance Applicative (Scene s) where + 188 pure a = M $ \_ -> return (a, 0, 0, []) + 189 f <*> g = M $ \t -> do + 190 (f', s1, p1, gen1) <- unM f t + 191 (g', s2, p2, gen2) <- unM g (t + s1) + 192 return (f' g', s1 + s2, max p1 (s1 + p2), gen1 ++ gen2) + 193 + 194 instance Monad (Scene s) where + 195 return = pure + 196 f >>= g = M $ \t -> do + 197 (a, s1, p1, gen1) <- unM f t + 198 (b, s2, p2, gen2) <- unM (g a) (t + s1) + 199 return (b, s1 + s2, max p1 (s1 + p2), gen1 ++ gen2) + 200 + 201 instance MonadFix (Scene s) where + 202 mfix fn = M $ \t -> mfix (\v -> let (a, _s, _p, _gens) = v in unM (fn a) t) + 203 + 204 -- | Lift an ST action into the Scene monad. + 205 liftST :: ST s a -> Scene s a + 206 liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, []) + 207 + 208 -- | Evaluate the value of a scene. + 209 evalScene :: (forall s . Scene s a) -> a + 210 evalScene action = runST $ do + 211 (val, _, _ , _) <- unM action 0 + 212 return val + 213 + 214 -- | Render a 'Scene' to an 'Animation'. + 215 scene :: (forall s . Scene s a) -> Animation + 216 scene = sceneAnimation + 217 + 218 -- | Render a 'Scene' to an 'Animation'. + 219 sceneAnimation :: (forall s . Scene s a) -> Animation + 220 sceneAnimation action = runST + 221 (do + 222 (_, s, p, gens) <- unM action 0 + 223 let dur = max s p + 224 genFns <- sequence gens + 225 return $ mkAnimation + 226 dur + 227 (\t -> mkGroup $ map fst $ sortOn + 228 snd + 229 [ spriteRender dur (t * dur) | spriteRender <- genFns ] + 230 ) + 231 ) 232 - 233 -- | Play an animation once and then remove it. This advances the clock by the duration of the - 234 -- animation. + 233 -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before + 234 -- all forked actions have completed. 235 -- 236 -- Example: 237 -- 238 -- @ - 239 -- do 'play' 'Reanimate.Builtin.Documentation.drawBox' + 239 -- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox' 240 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' 241 -- @ 242 -- - 243 -- <<docs/gifs/doc_play.gif>> - 244 play :: Animation -> Scene s () - 245 play ani = newSpriteA ani >>= destroySprite - 246 - 247 -- | Query the current clock timestamp. - 248 -- - 249 -- Example: - 250 -- - 251 -- @ - 252 -- do now \<- 'play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow' - 253 -- 'play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $ - 254 -- 'mkText' $ "Now=" <> T.pack (show now) - 255 -- @ - 256 -- - 257 -- <<docs/gifs/doc_queryNow.gif>> - 258 queryNow :: Scene s Time - 259 queryNow = M $ \t -> return (t, 0, 0, []) - 260 - 261 -- | Advance the clock by a given number of seconds. - 262 -- - 263 -- Example: + 243 -- <<docs/gifs/doc_fork.gif>> + 244 fork :: Scene s a -> Scene s a + 245 fork (M action) = M $ \t -> do + 246 (a, s, p, gens) <- action t + 247 return (a, 0, max s p, gens) + 248 + 249 -- | Play an animation once and then remove it. This advances the clock by the duration of the + 250 -- animation. + 251 -- + 252 -- Example: + 253 -- + 254 -- @ + 255 -- do 'play' 'Reanimate.Builtin.Documentation.drawBox' + 256 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' + 257 -- @ + 258 -- + 259 -- <<docs/gifs/doc_play.gif>> + 260 play :: Animation -> Scene s () + 261 play ani = newSpriteA ani >>= destroySprite + 262 + 263 -- | Query the current clock timestamp. 264 -- - 265 -- @ - 266 -- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox' - 267 -- 'wait' 1 - 268 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' - 269 -- @ - 270 -- - 271 -- <<docs/gifs/doc_wait.gif>> - 272 wait :: Duration -> Scene s () - 273 wait d = M $ \_ -> return ((), d, 0, []) - 274 - 275 -- | Wait until the clock is equal to the given timestamp. - 276 waitUntil :: Time -> Scene s () - 277 waitUntil tNew = do - 278 now <- queryNow - 279 wait (max 0 (tNew - now)) - 280 - 281 -- | Wait until all forked and sequential animations have finished. - 282 -- - 283 -- Example: - 284 -- + 265 -- Example: + 266 -- + 267 -- @ + 268 -- do now \<- 'play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow' + 269 -- 'play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $ + 270 -- 'mkText' $ "Now=" <> T.pack (show now) + 271 -- @ + 272 -- + 273 -- <<docs/gifs/doc_queryNow.gif>> + 274 queryNow :: Scene s Time + 275 queryNow = M $ \t -> return (t, 0, 0, []) + 276 + 277 -- | Advance the clock by a given number of seconds. + 278 -- + 279 -- Example: + 280 -- + 281 -- @ + 282 -- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox' + 283 -- 'wait' 1 + 284 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' 285 -- @ - 286 -- do 'waitOn' $ 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox' - 287 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' - 288 -- @ - 289 -- - 290 -- <<docs/gifs/doc_waitOn.gif>> - 291 waitOn :: Scene s a -> Scene s a - 292 waitOn (M action) = M $ \t -> do - 293 (a, s, p, gens) <- action t - 294 return (a, max s p, 0, gens) - 295 - 296 -- | Change the ZIndex of a scene. - 297 adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a - 298 adjustZ fn (M action) = M $ \t -> do - 299 (a, s, p, gens) <- action t - 300 return (a, s, p, map genFn gens) - 301 where - 302 genFn gen = do - 303 frameGen <- gen - 304 return $ \d t -> let (svg, z) = frameGen d t in (svg, fn z) - 305 - 306 -- | Query the duration of a scene. - 307 withSceneDuration :: Scene s () -> Scene s Duration - 308 withSceneDuration s = do - 309 t1 <- queryNow - 310 s - 311 t2 <- queryNow - 312 return (t2 - t1) - 313 - 314 addGen :: Gen s -> Scene s () - 315 addGen gen = M $ \_ -> return ((), 0, 0, [gen]) - 316 - 317 -- | Time dependent variable. - 318 newtype Var s a = Var (STRef s (Time -> a)) - 319 - 320 -- | Create a new variable with a default value. - 321 -- Variables always have a defined value even if they are read at a timestamp that is - 322 -- earlier than when the variable was created. For example: - 323 -- - 324 -- @ - 325 -- do v \<- 'fork' ('wait' 10 \>\> 'newVar' 0) -- Create a variable at timestamp '10'. - 326 -- 'readVar' v -- Read the variable at timestamp '0'. - 327 -- -- The value of the variable will be '0'. - 328 -- @ - 329 newVar :: a -> Scene s (Var s a) - 330 newVar def = Var <$> liftST (newSTRef (const def)) - 331 - 332 -- | Read the value of a variable at the current timestamp. - 333 readVar :: Var s a -> Scene s a - 334 readVar (Var ref) = liftST (readSTRef ref) <*> queryNow + 286 -- + 287 -- <<docs/gifs/doc_wait.gif>> + 288 wait :: Duration -> Scene s () + 289 wait d = M $ \_ -> return ((), d, 0, []) + 290 + 291 -- | Wait until the clock is equal to the given timestamp. + 292 waitUntil :: Time -> Scene s () + 293 waitUntil tNew = do + 294 now <- queryNow + 295 wait (max 0 (tNew - now)) + 296 + 297 -- | Wait until all forked and sequential animations have finished. + 298 -- + 299 -- Example: + 300 -- + 301 -- @ + 302 -- do 'waitOn' $ 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox' + 303 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' + 304 -- @ + 305 -- + 306 -- <<docs/gifs/doc_waitOn.gif>> + 307 waitOn :: Scene s a -> Scene s a + 308 waitOn (M action) = M $ \t -> do + 309 (a, s, p, gens) <- action t + 310 return (a, max s p, 0, gens) + 311 + 312 -- | Change the ZIndex of a scene. + 313 adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a + 314 adjustZ fn (M action) = M $ \t -> do + 315 (a, s, p, gens) <- action t + 316 return (a, s, p, map genFn gens) + 317 where + 318 genFn gen = do + 319 frameGen <- gen + 320 return $ \d t -> let (svg, z) = frameGen d t in (svg, fn z) + 321 + 322 -- | Query the duration of a scene. + 323 withSceneDuration :: Scene s () -> Scene s Duration + 324 withSceneDuration s = do + 325 t1 <- queryNow + 326 s + 327 t2 <- queryNow + 328 return (t2 - t1) + 329 + 330 addGen :: Gen s -> Scene s () + 331 addGen gen = M $ \_ -> return ((), 0, 0, [gen]) + 332 + 333 -- | Time dependent variable. + 334 newtype Var s a = Var (STRef s (Time -> a)) 335 - 336 -- | Write the value of a variable at the current timestamp. - 337 -- - 338 -- Example: + 336 -- | Create a new variable with a default value. + 337 -- Variables always have a defined value even if they are read at a timestamp that is + 338 -- earlier than when the variable was created. For example: 339 -- 340 -- @ - 341 -- do v \<- 'newVar' 0 - 342 -- 'newSprite' $ 'mkCircle' \<$\> 'unVar' v - 343 -- 'writeVar' v 1; 'wait' 1 - 344 -- 'writeVar' v 2; 'wait' 1 - 345 -- 'writeVar' v 3; 'wait' 1 - 346 -- @ - 347 -- - 348 -- <<docs/gifs/doc_writeVar.gif>> - 349 writeVar :: Var s a -> a -> Scene s () - 350 writeVar var val = modifyVar var (const val) + 341 -- do v \<- 'fork' ('wait' 10 \>\> 'newVar' 0) -- Create a variable at timestamp '10'. + 342 -- 'readVar' v -- Read the variable at timestamp '0'. + 343 -- -- The value of the variable will be '0'. + 344 -- @ + 345 newVar :: a -> Scene s (Var s a) + 346 newVar def = Var <$> liftST (newSTRef (const def)) + 347 + 348 -- | Read the value of a variable at the current timestamp. + 349 readVar :: Var s a -> Scene s a + 350 readVar (Var ref) = liftST (readSTRef ref) <*> queryNow 351 - 352 -- | Modify the value of a variable at the current timestamp and all future timestamps. - 353 modifyVar :: Var s a -> (a -> a) -> Scene s () - 354 modifyVar (Var ref) fn = do - 355 now <- queryNow - 356 liftST $ modifySTRef ref $ \prev t -> if t < now then prev t else fn (prev t) - 357 - 358 -- | Modify a variable between @now@ and @now+duration@. - 359 -- Note: The modification function is invoked for past timestamps (with a time value of 0) and - 360 -- for timestamps after @now+duration@ (with a time value of 1). See 'tweenVarUnclamped'. - 361 tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s () - 362 tweenVar (Var ref) dur fn = do - 363 now <- queryNow - 364 liftST $ modifySTRef ref $ \prev t -> - 365 if t < now - 366 then prev t - 367 else fn (prev t) (max 0 (min dur $ t - now) / dur) - 368 wait dur - 369 - 370 -- | Modify a variable between @now@ and @now+duration@. - 371 -- Note: The modification function is invoked for past timestamps (with a negative time value) and - 372 -- for timestamps after @now+duration@ (with a time value greater than 1). - 373 tweenVarUnclamped :: Var s a -> Duration -> (a -> Time -> a) -> Scene s () - 374 tweenVarUnclamped (Var ref) dur fn = do - 375 now <- queryNow - 376 liftST $ modifySTRef ref $ \prev t -> fn (prev t) ((t - now) / dur) - 377 wait dur - 378 - 379 -- | Create and render a variable. The rendering will be born at the current timestamp - 380 -- and will persist until the end of the scene. - 381 -- - 382 -- Example: - 383 -- - 384 -- @ - 385 -- do var \<- 'simpleVar' 'mkCircle' 0 - 386 -- 'tweenVar' var 2 $ \val -> 'fromToS' val ('Reanimate.Constants.screenHeight'/2) - 387 -- @ - 388 -- - 389 -- <<docs/gifs/doc_simpleVar.gif>> - 390 simpleVar :: (a -> SVG) -> a -> Scene s (Var s a) - 391 simpleVar render def = do - 392 v <- newVar def - 393 _ <- newSprite $ render <$> unVar v - 394 return v - 395 - 396 -- | Helper function for filtering variables. - 397 findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a) - 398 findVar _cond [] = error "Variable not found." - 399 findVar cond (v : vs) = do - 400 val <- readVar v - 401 if cond val then return v else findVar cond vs - 402 - 403 -- | Sprites are animations with a given time of birth as well as a time of death. - 404 -- They can be controlled using variables, tweening, and effects. - 405 data Sprite s = Sprite Time (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex)))) - 406 - 407 -- | Sprite frame generator. Generates frames over time in a stateful environment. - 408 newtype Frame s a = Frame { unFrame :: ST s (Time -> Duration -> Time -> a) } - 409 - 410 instance Functor (Frame s) where - 411 fmap fn (Frame gen) = Frame $ do - 412 m <- gen - 413 return (\real_t d t -> fn $ m real_t d t) - 414 - 415 instance Applicative (Frame s) where - 416 pure v = Frame $ return (\_ _ _ -> v) - 417 Frame f <*> Frame g = Frame $ do - 418 m1 <- f - 419 m2 <- g - 420 return $ \real_t d t -> m1 real_t d t (m2 real_t d t) - 421 - 422 -- | Dereference a variable as a Sprite frame. - 423 -- - 424 -- Example: - 425 -- - 426 -- @ - 427 -- do v \<- 'newVar' 0 - 428 -- 'newSprite' $ 'mkCircle' \<$\> 'unVar' v - 429 -- 'tweenVar' v 1 $ \val -> 'fromToS' val 3 - 430 -- 'tweenVar' v 1 $ \val -> 'fromToS' val 0 - 431 -- @ - 432 -- - 433 -- <<docs/gifs/doc_unVar.gif>> - 434 unVar :: Var s a -> Frame s a - 435 unVar (Var ref) = Frame $ do - 436 fn <- readSTRef ref - 437 return $ \real_t _d _t -> fn real_t - 438 - 439 - 440 -- | Dereference seconds since sprite birth. - 441 spriteT :: Frame s Time - 442 spriteT = Frame $ return (\_real_t _d t -> t) - 443 - 444 -- | Dereference duration of the current sprite. - 445 spriteDuration :: Frame s Duration - 446 spriteDuration = Frame $ return (\_real_t d _t -> d) - 447 - 448 -- | Create new sprite defined by a frame generator. Unless otherwise specified using - 449 -- 'destroySprite', the sprite will die at the end of the scene. - 450 -- - 451 -- Example: - 452 -- - 453 -- @ - 454 -- do 'newSprite' $ 'mkCircle' \<$\> 'spriteT' -- Circle sprite where radius=time. - 455 -- 'wait' 2 - 456 -- @ - 457 -- - 458 -- <<docs/gifs/doc_newSprite.gif>> - 459 newSprite :: Frame s SVG -> Scene s (Sprite s) - 460 newSprite render = do - 461 now <- queryNow - 462 ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0)) - 463 addGen $ do - 464 fn <- unFrame render - 465 (spriteDur, spriteEffectGen) <- readSTRef ref - 466 spriteEffect <- spriteEffectGen - 467 return $ \d absT -> - 468 let relD = (if spriteDur < 0 then d else spriteDur) - now - 469 relT = absT - now - 470 -- Sprite is live [now;duration[ - 471 -- If we're at the end of a scene, sprites - 472 -- are live: [now;duration] - 473 -- This behavior is difficult to get right. See the 'bug_*' examples for - 474 -- automated tests. - 475 inTimeSlice = relT >= 0 && relT < relD - 476 isLastFrame = d==absT && relT == relD - 477 in if inTimeSlice || isLastFrame - 478 then spriteEffect relD relT (fn absT relD relT) - 479 else (None, 0) - 480 return $ Sprite now ref - 481 - 482 -- | Create new sprite defined by a frame generator. The sprite will die at - 483 -- the end of the scene. - 484 newSprite_ :: Frame s SVG -> Scene s () - 485 newSprite_ = void . newSprite - 486 - 487 -- | Create a new sprite from an animation. This advances the clock by the - 488 -- duration of the animation. Unless otherwise specified using - 489 -- 'destroySprite', the sprite will die at the end of the scene. - 490 -- - 491 -- Note: If the scene doesn't end immediately after the duration of the - 492 -- animation, the animation will be stretched to match the lifetime of the - 493 -- sprite. See 'newSpriteA'' and 'play'. - 494 -- - 495 -- Example: - 496 -- - 497 -- @ - 498 -- do 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' - 499 -- 'play' 'Reanimate.Builtin.Documentation.drawBox' - 500 -- 'play' $ 'reverseA' 'Reanimate.Builtin.Documentation.drawBox' - 501 -- @ - 502 -- - 503 -- <<docs/gifs/doc_newSpriteA.gif>> - 504 newSpriteA :: Animation -> Scene s (Sprite s) - 505 newSpriteA = newSpriteA' SyncStretch - 506 - 507 -- | Create a new sprite from an animation and specify the synchronization policy. This advances - 508 -- the clock by the duration of the animation. - 509 -- - 510 -- Example: - 511 -- - 512 -- @ - 513 -- do 'fork' $ 'newSpriteA'' 'SyncFreeze' 'Reanimate.Builtin.Documentation.drawCircle' - 514 -- 'play' 'Reanimate.Builtin.Documentation.drawBox' - 515 -- 'play' $ 'reverseA' 'Reanimate.Builtin.Documentation.drawBox' - 516 -- @ - 517 -- - 518 -- <<docs/gifs/doc_newSpriteA'.gif>> - 519 newSpriteA' :: Sync -> Animation -> Scene s (Sprite s) - 520 newSpriteA' sync animation = - 521 newSprite (getAnimationFrame sync animation <$> spriteT <*> spriteDuration) - 522 <* wait (duration animation) - 523 - 524 -- | Create a sprite from a static SVG image. + 352 -- | Write the value of a variable at the current timestamp. + 353 -- + 354 -- Example: + 355 -- + 356 -- @ + 357 -- do v \<- 'newVar' 0 + 358 -- 'newSprite' $ 'mkCircle' \<$\> 'unVar' v + 359 -- 'writeVar' v 1; 'wait' 1 + 360 -- 'writeVar' v 2; 'wait' 1 + 361 -- 'writeVar' v 3; 'wait' 1 + 362 -- @ + 363 -- + 364 -- <<docs/gifs/doc_writeVar.gif>> + 365 writeVar :: Var s a -> a -> Scene s () + 366 writeVar var val = modifyVar var (const val) + 367 + 368 -- | Modify the value of a variable at the current timestamp and all future timestamps. + 369 modifyVar :: Var s a -> (a -> a) -> Scene s () + 370 modifyVar (Var ref) fn = do + 371 now <- queryNow + 372 liftST $ modifySTRef ref $ \prev t -> if t < now then prev t else fn (prev t) + 373 + 374 -- | Modify a variable between @now@ and @now+duration@. + 375 -- Note: The modification function is invoked for past timestamps (with a time value of 0) and + 376 -- for timestamps after @now+duration@ (with a time value of 1). See 'tweenVarUnclamped'. + 377 tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s () + 378 tweenVar (Var ref) dur fn = do + 379 now <- queryNow + 380 liftST $ modifySTRef ref $ \prev t -> + 381 if t < now + 382 then prev t + 383 else fn (prev t) (max 0 (min dur $ t - now) / dur) + 384 wait dur + 385 + 386 -- | Modify a variable between @now@ and @now+duration@. + 387 -- Note: The modification function is invoked for past timestamps (with a negative time value) and + 388 -- for timestamps after @now+duration@ (with a time value greater than 1). + 389 tweenVarUnclamped :: Var s a -> Duration -> (a -> Time -> a) -> Scene s () + 390 tweenVarUnclamped (Var ref) dur fn = do + 391 now <- queryNow + 392 liftST $ modifySTRef ref $ \prev t -> fn (prev t) ((t - now) / dur) + 393 wait dur + 394 + 395 -- | Create and render a variable. The rendering will be born at the current timestamp + 396 -- and will persist until the end of the scene. + 397 -- + 398 -- Example: + 399 -- + 400 -- @ + 401 -- do var \<- 'simpleVar' 'mkCircle' 0 + 402 -- 'tweenVar' var 2 $ \val -> 'fromToS' val ('Reanimate.Constants.screenHeight'/2) + 403 -- @ + 404 -- + 405 -- <<docs/gifs/doc_simpleVar.gif>> + 406 simpleVar :: (a -> SVG) -> a -> Scene s (Var s a) + 407 simpleVar render def = do + 408 v <- newVar def + 409 _ <- newSprite $ render <$> unVar v + 410 return v + 411 + 412 -- | Helper function for filtering variables. + 413 findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a) + 414 findVar _cond [] = error "Variable not found." + 415 findVar cond (v : vs) = do + 416 val <- readVar v + 417 if cond val then return v else findVar cond vs + 418 + 419 -- | Sprites are animations with a given time of birth as well as a time of death. + 420 -- They can be controlled using variables, tweening, and effects. + 421 data Sprite s = Sprite Time (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex)))) + 422 + 423 -- | Sprite frame generator. Generates frames over time in a stateful environment. + 424 newtype Frame s a = Frame { unFrame :: ST s (Time -> Duration -> Time -> a) } + 425 + 426 instance Functor (Frame s) where + 427 fmap fn (Frame gen) = Frame $ do + 428 m <- gen + 429 return (\real_t d t -> fn $ m real_t d t) + 430 + 431 instance Applicative (Frame s) where + 432 pure v = Frame $ return (\_ _ _ -> v) + 433 Frame f <*> Frame g = Frame $ do + 434 m1 <- f + 435 m2 <- g + 436 return $ \real_t d t -> m1 real_t d t (m2 real_t d t) + 437 + 438 -- | Dereference a variable as a Sprite frame. + 439 -- + 440 -- Example: + 441 -- + 442 -- @ + 443 -- do v \<- 'newVar' 0 + 444 -- 'newSprite' $ 'mkCircle' \<$\> 'unVar' v + 445 -- 'tweenVar' v 1 $ \val -> 'fromToS' val 3 + 446 -- 'tweenVar' v 1 $ \val -> 'fromToS' val 0 + 447 -- @ + 448 -- + 449 -- <<docs/gifs/doc_unVar.gif>> + 450 unVar :: Var s a -> Frame s a + 451 unVar (Var ref) = Frame $ do + 452 fn <- readSTRef ref + 453 return $ \real_t _d _t -> fn real_t + 454 + 455 + 456 -- | Dereference seconds since sprite birth. + 457 spriteT :: Frame s Time + 458 spriteT = Frame $ return (\_real_t _d t -> t) + 459 + 460 -- | Dereference duration of the current sprite. + 461 spriteDuration :: Frame s Duration + 462 spriteDuration = Frame $ return (\_real_t d _t -> d) + 463 + 464 -- | Create new sprite defined by a frame generator. Unless otherwise specified using + 465 -- 'destroySprite', the sprite will die at the end of the scene. + 466 -- + 467 -- Example: + 468 -- + 469 -- @ + 470 -- do 'newSprite' $ 'mkCircle' \<$\> 'spriteT' -- Circle sprite where radius=time. + 471 -- 'wait' 2 + 472 -- @ + 473 -- + 474 -- <<docs/gifs/doc_newSprite.gif>> + 475 newSprite :: Frame s SVG -> Scene s (Sprite s) + 476 newSprite render = do + 477 now <- queryNow + 478 ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0)) + 479 addGen $ do + 480 fn <- unFrame render + 481 (spriteDur, spriteEffectGen) <- readSTRef ref + 482 spriteEffect <- spriteEffectGen + 483 return $ \d absT -> + 484 let relD = (if spriteDur < 0 then d else spriteDur) - now + 485 relT = absT - now + 486 -- Sprite is live [now;duration[ + 487 -- If we're at the end of a scene, sprites + 488 -- are live: [now;duration] + 489 -- This behavior is difficult to get right. See the 'bug_*' examples for + 490 -- automated tests. + 491 inTimeSlice = relT >= 0 && relT < relD + 492 isLastFrame = d==absT && relT == relD + 493 in if inTimeSlice || isLastFrame + 494 then spriteEffect relD relT (fn absT relD relT) + 495 else (None, 0) + 496 return $ Sprite now ref + 497 + 498 -- | Create new sprite defined by a frame generator. The sprite will die at + 499 -- the end of the scene. + 500 newSprite_ :: Frame s SVG -> Scene s () + 501 newSprite_ = void . newSprite + 502 + 503 -- | Create a new sprite from an animation. This advances the clock by the + 504 -- duration of the animation. Unless otherwise specified using + 505 -- 'destroySprite', the sprite will die at the end of the scene. + 506 -- + 507 -- Note: If the scene doesn't end immediately after the duration of the + 508 -- animation, the animation will be stretched to match the lifetime of the + 509 -- sprite. See 'newSpriteA'' and 'play'. + 510 -- + 511 -- Example: + 512 -- + 513 -- @ + 514 -- do 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' + 515 -- 'play' 'Reanimate.Builtin.Documentation.drawBox' + 516 -- 'play' $ 'reverseA' 'Reanimate.Builtin.Documentation.drawBox' + 517 -- @ + 518 -- + 519 -- <<docs/gifs/doc_newSpriteA.gif>> + 520 newSpriteA :: Animation -> Scene s (Sprite s) + 521 newSpriteA = newSpriteA' SyncStretch + 522 + 523 -- | Create a new sprite from an animation and specify the synchronization policy. This advances + 524 -- the clock by the duration of the animation. 525 -- 526 -- Example: 527 -- 528 -- @ - 529 -- do 'newSpriteSVG' $ 'mkBackground' "lightblue" - 530 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' - 531 -- @ - 532 -- - 533 -- <<docs/gifs/doc_newSpriteSVG.gif>> - 534 newSpriteSVG :: SVG -> Scene s (Sprite s) - 535 newSpriteSVG = newSprite . pure - 536 - 537 -- | Create a permanent sprite from a static SVG image. Same as `newSpriteSVG` - 538 -- but the sprite isn't returned and thus cannot be destroyed. - 539 newSpriteSVG_ :: SVG -> Scene s () - 540 newSpriteSVG_ = void . newSpriteSVG - 541 - 542 -- | Change the rendering of a sprite using data from a variable. If data from several variables - 543 -- is needed, use a frame generator instead. - 544 -- - 545 -- Example: - 546 -- + 529 -- do 'fork' $ 'newSpriteA'' 'SyncFreeze' 'Reanimate.Builtin.Documentation.drawCircle' + 530 -- 'play' 'Reanimate.Builtin.Documentation.drawBox' + 531 -- 'play' $ 'reverseA' 'Reanimate.Builtin.Documentation.drawBox' + 532 -- @ + 533 -- + 534 -- <<docs/gifs/doc_newSpriteA'.gif>> + 535 newSpriteA' :: Sync -> Animation -> Scene s (Sprite s) + 536 newSpriteA' sync animation = + 537 newSprite (getAnimationFrame sync animation <$> spriteT <*> spriteDuration) + 538 <* wait (duration animation) + 539 + 540 -- | Create a sprite from a static SVG image. + 541 -- + 542 -- Example: + 543 -- + 544 -- @ + 545 -- do 'newSpriteSVG' $ 'mkBackground' "lightblue" + 546 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle' 547 -- @ - 548 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox' - 549 -- v \<- 'newVar' 0 - 550 -- 'applyVar' v s 'rotate' - 551 -- 'tweenVar' v 2 $ \val -> 'fromToS' val 90 - 552 -- @ - 553 -- - 554 -- <<docs/gifs/doc_applyVar.gif>> - 555 applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s () - 556 applyVar var sprite fn = spriteModify sprite $ do - 557 varFn <- unVar var - 558 return $ \(svg, zindex) -> (fn varFn svg, zindex) - 559 - 560 -- | Destroy a sprite, preventing it from being rendered in the future of the scene. - 561 -- If 'destroySprite' is invoked multiple times, the earliest time-of-death is used. + 548 -- + 549 -- <<docs/gifs/doc_newSpriteSVG.gif>> + 550 newSpriteSVG :: SVG -> Scene s (Sprite s) + 551 newSpriteSVG = newSprite . pure + 552 + 553 -- | Create a permanent sprite from a static SVG image. Same as `newSpriteSVG` + 554 -- but the sprite isn't returned and thus cannot be destroyed. + 555 newSpriteSVG_ :: SVG -> Scene s () + 556 newSpriteSVG_ = void . newSpriteSVG + 557 + 558 -- | Change the rendering of a sprite using data from a variable. If data from several variables + 559 -- is needed, use a frame generator instead. + 560 -- + 561 -- Example: 562 -- - 563 -- Example: - 564 -- - 565 -- @ - 566 -- do s <- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'mkCircle' 1 - 567 -- 'fork' $ 'wait' 1 \>\> 'destroySprite' s - 568 -- 'play' 'Reanimate.Builtin.Documentation.drawBox' - 569 -- @ - 570 -- - 571 -- <<docs/gifs/doc_destroySprite.gif>> - 572 destroySprite :: Sprite s -> Scene s () - 573 destroySprite (Sprite _ ref) = do - 574 now <- queryNow - 575 liftST $ modifySTRef ref $ \(ttl, render) -> - 576 (if ttl < 0 then now else min ttl now, render) - 577 - 578 -- | Low-level frame modifier. - 579 spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s () - 580 spriteModify (Sprite born ref) modFn = liftST $ modifySTRef ref $ \(ttl, renderGen) -> - 581 ( ttl - 582 , do - 583 render <- renderGen - 584 modRender <- unFrame modFn - 585 return $ \relD relT -> - 586 let absT = relT + born in modRender absT relD relT . render relD relT - 587 ) - 588 - 589 -- | Map the SVG output of a sprite. - 590 -- - 591 -- Example: - 592 -- - 593 -- @ - 594 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' - 595 -- 'wait' 1 - 596 -- 'spriteMap' s 'flipYAxis' - 597 -- @ - 598 -- - 599 -- <<docs/gifs/doc_spriteMap.gif>> - 600 spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s () - 601 spriteMap sprite@(Sprite born _) fn = do - 602 now <- queryNow - 603 let tDelta = now - born - 604 spriteModify sprite $ do - 605 t <- spriteT - 606 return $ \(svg, zindex) -> (if (t - tDelta) < 0 then svg else fn svg, zindex) - 607 - 608 -- | Modify the output of a sprite between @now@ and @now+duration@. - 609 -- - 610 -- Example: - 611 -- - 612 -- @ - 613 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' - 614 -- 'spriteTween' s 1 $ \val -> 'translate' ('Reanimate.Constants.screenWidth'*0.3*val) 0 - 615 -- @ - 616 -- - 617 -- <<docs/gifs/doc_spriteTween.gif>> - 618 spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s () - 619 spriteTween sprite@(Sprite born _) dur fn = do - 620 now <- queryNow - 621 let tDelta = now - born - 622 spriteModify sprite $ do - 623 t <- spriteT - 624 return $ \(svg, zindex) -> (fn (clamp 0 1 $ (t - tDelta) / dur) svg, zindex) - 625 wait dur - 626 where - 627 clamp a b v | v < a = a - 628 | v > b = b - 629 | otherwise = v - 630 - 631 -- | Create a new variable and apply it to a sprite. + 563 -- @ + 564 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox' + 565 -- v \<- 'newVar' 0 + 566 -- 'applyVar' v s 'rotate' + 567 -- 'tweenVar' v 2 $ \val -> 'fromToS' val 90 + 568 -- @ + 569 -- + 570 -- <<docs/gifs/doc_applyVar.gif>> + 571 applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s () + 572 applyVar var sprite fn = spriteModify sprite $ do + 573 varFn <- unVar var + 574 return $ \(svg, zindex) -> (fn varFn svg, zindex) + 575 + 576 -- | Destroy a sprite, preventing it from being rendered in the future of the scene. + 577 -- If 'destroySprite' is invoked multiple times, the earliest time-of-death is used. + 578 -- + 579 -- Example: + 580 -- + 581 -- @ + 582 -- do s <- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'mkCircle' 1 + 583 -- 'fork' $ 'wait' 1 \>\> 'destroySprite' s + 584 -- 'play' 'Reanimate.Builtin.Documentation.drawBox' + 585 -- @ + 586 -- + 587 -- <<docs/gifs/doc_destroySprite.gif>> + 588 destroySprite :: Sprite s -> Scene s () + 589 destroySprite (Sprite _ ref) = do + 590 now <- queryNow + 591 liftST $ modifySTRef ref $ \(ttl, render) -> + 592 (if ttl < 0 then now else min ttl now, render) + 593 + 594 -- | Low-level frame modifier. + 595 spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s () + 596 spriteModify (Sprite born ref) modFn = liftST $ modifySTRef ref $ \(ttl, renderGen) -> + 597 ( ttl + 598 , do + 599 render <- renderGen + 600 modRender <- unFrame modFn + 601 return $ \relD relT -> + 602 let absT = relT + born in modRender absT relD relT . render relD relT + 603 ) + 604 + 605 -- | Map the SVG output of a sprite. + 606 -- + 607 -- Example: + 608 -- + 609 -- @ + 610 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' + 611 -- 'wait' 1 + 612 -- 'spriteMap' s 'flipYAxis' + 613 -- @ + 614 -- + 615 -- <<docs/gifs/doc_spriteMap.gif>> + 616 spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s () + 617 spriteMap sprite@(Sprite born _) fn = do + 618 now <- queryNow + 619 let tDelta = now - born + 620 spriteModify sprite $ do + 621 t <- spriteT + 622 return $ \(svg, zindex) -> (if (t - tDelta) < 0 then svg else fn svg, zindex) + 623 + 624 -- | Modify the output of a sprite between @now@ and @now+duration@. + 625 -- + 626 -- Example: + 627 -- + 628 -- @ + 629 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' + 630 -- 'spriteTween' s 1 $ \val -> 'translate' ('Reanimate.Constants.screenWidth'*0.3*val) 0 + 631 -- @ 632 -- - 633 -- Example: - 634 -- - 635 -- @ - 636 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox' - 637 -- v \<- 'spriteVar' s 0 'rotate' - 638 -- 'tweenVar' v 2 $ \val -> 'fromToS' val 90 - 639 -- @ - 640 -- - 641 -- <<docs/gifs/doc_spriteVar.gif>> - 642 spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a) - 643 spriteVar sprite def fn = do - 644 v <- newVar def - 645 applyVar v sprite fn - 646 return v - 647 - 648 -- | Apply an effect to a sprite. - 649 -- - 650 -- Example: - 651 -- - 652 -- @ - 653 -- do s <- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' - 654 -- 'spriteE' s $ 'overBeginning' 1 'fadeInE' - 655 -- 'spriteE' s $ 'overEnding' 0.5 'fadeOutE' - 656 -- @ - 657 -- - 658 -- <<docs/gifs/doc_spriteE.gif>> - 659 spriteE :: Sprite s -> Effect -> Scene s () - 660 spriteE (Sprite born ref) effect = do - 661 now <- queryNow - 662 liftST $ modifySTRef ref $ \(ttl, renderGen) -> - 663 ( ttl - 664 , do - 665 render <- renderGen - 666 return $ \d t svg -> - 667 let (svg', z) = render d t svg - 668 in (delayE (max 0 $ now - born) effect d t svg', z) - 669 ) - 670 - 671 -- | Set new ZIndex of a sprite. - 672 -- - 673 -- Example: - 674 -- - 675 -- @ - 676 -- do s1 \<- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'withFillColor' "blue" $ 'mkCircle' 3 - 677 -- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'withFillColor' "red" $ 'mkRect' 8 3 - 678 -- 'wait' 1 - 679 -- 'spriteZ' s1 1 - 680 -- 'wait' 1 - 681 -- @ - 682 -- - 683 -- <<docs/gifs/doc_spriteZ.gif>> - 684 spriteZ :: Sprite s -> ZIndex -> Scene s () - 685 spriteZ (Sprite born ref) zindex = do - 686 now <- queryNow - 687 liftST $ modifySTRef ref $ \(ttl, renderGen) -> - 688 ( ttl - 689 , do - 690 render <- renderGen - 691 return $ \d t svg -> - 692 let (svg', z) = render d t svg in (svg', if t < now - born then z else zindex) - 693 ) - 694 - 695 -- | Destroy all local sprites at the end of a scene. - 696 -- - 697 -- Example: + 633 -- <<docs/gifs/doc_spriteTween.gif>> + 634 spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s () + 635 spriteTween sprite@(Sprite born _) dur fn = do + 636 now <- queryNow + 637 let tDelta = now - born + 638 spriteModify sprite $ do + 639 t <- spriteT + 640 return $ \(svg, zindex) -> (fn (clamp 0 1 $ (t - tDelta) / dur) svg, zindex) + 641 wait dur + 642 where + 643 clamp a b v | v < a = a + 644 | v > b = b + 645 | otherwise = v + 646 + 647 -- | Create a new variable and apply it to a sprite. + 648 -- + 649 -- Example: + 650 -- + 651 -- @ + 652 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox' + 653 -- v \<- 'spriteVar' s 0 'rotate' + 654 -- 'tweenVar' v 2 $ \val -> 'fromToS' val 90 + 655 -- @ + 656 -- + 657 -- <<docs/gifs/doc_spriteVar.gif>> + 658 spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a) + 659 spriteVar sprite def fn = do + 660 v <- newVar def + 661 applyVar v sprite fn + 662 return v + 663 + 664 -- | Apply an effect to a sprite. + 665 -- + 666 -- Example: + 667 -- + 668 -- @ + 669 -- do s <- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' + 670 -- 'spriteE' s $ 'overBeginning' 1 'fadeInE' + 671 -- 'spriteE' s $ 'overEnding' 0.5 'fadeOutE' + 672 -- @ + 673 -- + 674 -- <<docs/gifs/doc_spriteE.gif>> + 675 spriteE :: Sprite s -> Effect -> Scene s () + 676 spriteE (Sprite born ref) effect = do + 677 now <- queryNow + 678 liftST $ modifySTRef ref $ \(ttl, renderGen) -> + 679 ( ttl + 680 , do + 681 render <- renderGen + 682 return $ \d t svg -> + 683 let (svg', z) = render d t svg + 684 in (delayE (max 0 $ now - born) effect d t svg', z) + 685 ) + 686 + 687 -- | Set new ZIndex of a sprite. + 688 -- + 689 -- Example: + 690 -- + 691 -- @ + 692 -- do s1 \<- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'withFillColor' "blue" $ 'mkCircle' 3 + 693 -- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'withFillColor' "red" $ 'mkRect' 8 3 + 694 -- 'wait' 1 + 695 -- 'spriteZ' s1 1 + 696 -- 'wait' 1 + 697 -- @ 698 -- - 699 -- @ - 700 -- do -- the rect lives through the entire 3s animation - 701 -- 'newSpriteSVG_' $ 'translate' (-3) 0 $ 'mkRect' 4 4 - 702 -- 'wait' 1 - 703 -- 'spriteScope' $ do - 704 -- -- the circle only lives for 1 second. - 705 -- local \<- 'newSpriteSVG' $ 'translate' 3 0 $ 'mkCircle' 2 - 706 -- 'spriteE' local $ 'overBeginning' 0.3 'fadeInE' - 707 -- 'spriteE' local $ 'overEnding' 0.3 'fadeOutE' - 708 -- 'wait' 1 - 709 -- 'wait' 1 - 710 -- @ - 711 -- - 712 -- <<docs/gifs/doc_spriteScope.gif>> - 713 spriteScope :: Scene s a -> Scene s a - 714 spriteScope (M action) = M $ \t -> do - 715 (a, s, p, gens) <- action t - 716 return (a, s, p, map (genFn (t+max s p)) gens) - 717 where - 718 genFn maxT gen = do - 719 frameGen <- gen - 720 return $ \_ t -> - 721 if t < maxT - 722 then frameGen maxT t - 723 else (None, 0) - 724 - 725 asAnimation :: (forall s'. Scene s' a) -> Scene s Animation - 726 asAnimation s = do - 727 now <- queryNow - 728 return $ dropA now (sceneAnimation (wait now >> s)) - 729 - 730 -- | Apply a transformation with a given overlap. This makes sure - 731 -- to keep timestamps intact such that events can still be timed - 732 -- by transcripts. - 733 transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s () - 734 transitionO t o a b = do - 735 aA <- asAnimation a - 736 bA <- fork $ do - 737 wait (duration aA - o) - 738 asAnimation b - 739 play $ overlapT o t aA bA + 699 -- <<docs/gifs/doc_spriteZ.gif>> + 700 spriteZ :: Sprite s -> ZIndex -> Scene s () + 701 spriteZ (Sprite born ref) zindex = do + 702 now <- queryNow + 703 liftST $ modifySTRef ref $ \(ttl, renderGen) -> + 704 ( ttl + 705 , do + 706 render <- renderGen + 707 return $ \d t svg -> + 708 let (svg', z) = render d t svg in (svg', if t < now - born then z else zindex) + 709 ) + 710 + 711 -- | Destroy all local sprites at the end of a scene. + 712 -- + 713 -- Example: + 714 -- + 715 -- @ + 716 -- do -- the rect lives through the entire 3s animation + 717 -- 'newSpriteSVG_' $ 'translate' (-3) 0 $ 'mkRect' 4 4 + 718 -- 'wait' 1 + 719 -- 'spriteScope' $ do + 720 -- -- the circle only lives for 1 second. + 721 -- local \<- 'newSpriteSVG' $ 'translate' 3 0 $ 'mkCircle' 2 + 722 -- 'spriteE' local $ 'overBeginning' 0.3 'fadeInE' + 723 -- 'spriteE' local $ 'overEnding' 0.3 'fadeOutE' + 724 -- 'wait' 1 + 725 -- 'wait' 1 + 726 -- @ + 727 -- + 728 -- <<docs/gifs/doc_spriteScope.gif>> + 729 spriteScope :: Scene s a -> Scene s a + 730 spriteScope (M action) = M $ \t -> do + 731 (a, s, p, gens) <- action t + 732 return (a, s, p, map (genFn (t+max s p)) gens) + 733 where + 734 genFn maxT gen = do + 735 frameGen <- gen + 736 return $ \_ t -> + 737 if t < maxT + 738 then frameGen maxT t + 739 else (None, 0) 740 - 741 - 742 - 743 - 744 ------------------------------------------------------- - 745 -- Objects - 746 - 747 -- | Objects can be any Haskell structure as long as it can be rendered to SVG. - 748 class Renderable a where - 749 toSVG :: a -> SVG - 750 - 751 instance Renderable Tree where - 752 toSVG = id - 753 - 754 -- | Objects are SVG nodes (represented as Haskell values) with - 755 -- identity, location, and several other properties that can - 756 -- change over time. - 757 data Object s a = Object - 758 { objectSprite :: Sprite s - 759 , objectData :: Var s (ObjectData a) - 760 } - 761 - 762 -- | Container for object properties. - 763 data ObjectData a = ObjectData - 764 { _oTranslate :: (Double, Double) - 765 , _oValueRef :: a - 766 , _oSVG :: SVG - 767 , _oContext :: SVG -> SVG - 768 , _oMargin :: (Double, Double, Double, Double) - 769 -- ^ Top, right, bottom, left - 770 , _oBB :: (Double,Double,Double,Double) - 771 , _oOpacity :: Double - 772 , _oShown :: Bool - 773 , _oZIndex :: Int - 774 , _oEasing :: Signal - 775 , _oScale :: Double - 776 , _oScaleOrigin :: (Double, Double) - 777 } - 778 - 779 -- Basic lenses - 780 - 781 -- FIXME: Maybe 'position' is a better name. - 782 -- | Object position. Default: \<0,0\> - 783 oTranslate :: Lens' (ObjectData a) (Double, Double) - 784 oTranslate = lens _oTranslate $ \obj val -> obj { _oTranslate = val } - 785 - 786 -- | Rendered SVG node of an object. Does not include context - 787 -- or object properties. Read-only. - 788 oSVG :: Getter (ObjectData a) SVG - 789 oSVG = to _oSVG - 790 - 791 -- | Custom render context. Is applied to the object for every - 792 -- frame that it is shown. - 793 oContext :: Lens' (ObjectData a) (SVG -> SVG) - 794 oContext = lens _oContext $ \obj val -> obj { _oContext = val } - 795 - 796 -- | Object margins (top, right, bottom, left) in local units. - 797 oMargin :: Lens' (ObjectData a) (Double, Double, Double, Double) - 798 oMargin = lens _oMargin $ \obj val -> obj { _oMargin = val } - 799 - 800 -- | Object bounding-box (minimal X-coordinate, minimal Y-coordinate, - 801 -- width, height). Uses `Reanimate.Svg.BoundingBox.boundingBox` - 802 -- and has the same limitations. - 803 oBB :: Getter (ObjectData a) (Double, Double, Double, Double) - 804 oBB = to _oBB - 805 - 806 -- | Object opacity. Default: 1 - 807 oOpacity :: Lens' (ObjectData a) Double - 808 oOpacity = lens _oOpacity $ \obj val -> obj { _oOpacity = val } - 809 - 810 -- | Toggle for whether or not the object should be rendered. - 811 -- Default: False - 812 oShown :: Lens' (ObjectData a) Bool - 813 oShown = lens _oShown $ \obj val -> obj { _oShown = val } - 814 - 815 -- | Object's z-index. - 816 oZIndex :: Lens' (ObjectData a) Int - 817 oZIndex = lens _oZIndex $ \obj val -> obj { _oZIndex = val } - 818 - 819 -- | Easing function used when modifying object properties. - 820 -- Default: @'Reanimate.Ease.curveS' 2@ - 821 oEasing :: Lens' (ObjectData a) Signal - 822 oEasing = lens _oEasing $ \obj val -> obj { _oEasing = val } - 823 - 824 -- | Object's scale. Default: 1 - 825 oScale :: Lens' (ObjectData a) Double - 826 oScale = lens _oScale $ \obj val -> obj { _oScale = val } - 827 - 828 -- | Origin point for scaling. Default: \<0,0\> - 829 oScaleOrigin :: Lens' (ObjectData a) (Double, Double) - 830 oScaleOrigin = lens _oScaleOrigin $ \obj val -> obj { _oScaleOrigin = val } - 831 - 832 -- Smart lenses - 833 - 834 -- | Lens for the source value contained in an object. - 835 oValue :: Renderable a => Lens' (ObjectData a) a - 836 oValue = lens _oValueRef $ \obj newVal -> - 837 let svg = toSVG newVal - 838 in obj - 839 { _oValueRef = newVal - 840 , _oSVG = svg - 841 , _oBB = boundingBox svg } - 842 - 843 -- | Derived location of the top-most point of an object + margin. - 844 oTopY :: Lens' (ObjectData a) Double - 845 oTopY = lens getter setter - 846 where - 847 getter obj = - 848 let top = obj ^. oMarginTop - 849 miny = obj ^. oBBMinY - 850 h = obj ^. oBBHeight - 851 dy = obj ^. oTranslate . _2 - 852 in dy+miny+h+top - 853 setter obj val = - 854 obj & (oTranslate . _2) +~ val-getter obj - 855 - 856 -- | Derived location of the bottom-most point of an object + margin. - 857 oBottomY :: Lens' (ObjectData a) Double - 858 oBottomY = lens getter setter - 859 where - 860 getter obj = - 861 let bot = obj ^. oMarginBottom - 862 miny = obj ^. oBBMinY - 863 dy = obj ^. oTranslate . _2 - 864 in dy+miny-bot - 865 setter obj val = - 866 obj & (oTranslate . _2) +~ val-getter obj - 867 - 868 -- | Derived location of the left-most point of an object + margin. - 869 oLeftX :: Lens' (ObjectData a) Double - 870 oLeftX = lens getter setter - 871 where - 872 getter obj = - 873 let left = obj ^. oMarginLeft - 874 minx = obj ^. oBBMinX - 875 dx = obj ^. oTranslate . _1 - 876 in dx+minx-left - 877 setter obj val = - 878 obj & (oTranslate . _1) +~ val-getter obj - 879 - 880 -- | Derived location of the right-most point of an object + margin. - 881 oRightX :: Lens' (ObjectData a) Double - 882 oRightX = lens getter setter - 883 where - 884 getter obj = - 885 let right = obj ^. oMarginRight - 886 minx = obj ^. oBBMinX - 887 w = obj ^. oBBWidth - 888 dx = obj ^. oTranslate . _1 - 889 in dx+minx+w+right - 890 setter obj val = - 891 obj & (oTranslate . _1) +~ val-getter obj - 892 - 893 -- | Derived location of an object's center point. - 894 oCenterXY :: Lens' (ObjectData a) (Double, Double) - 895 oCenterXY = lens getter setter - 896 where - 897 getter obj = - 898 let minx = obj ^. oBBMinX - 899 miny = obj ^. oBBMinY - 900 w = obj ^. oBBWidth - 901 h = obj ^. oBBHeight - 902 (dx,dy) = obj ^. oTranslate - 903 in (dx+minx+w/2, dy+miny+h/2) - 904 setter obj (dx, dy) = - 905 let (x,y) = getter obj in - 906 obj & (oTranslate . _1) +~ dx-x - 907 & (oTranslate . _2) +~ dy-y + 741 asAnimation :: (forall s'. Scene s' a) -> Scene s Animation + 742 asAnimation s = do + 743 now <- queryNow + 744 return $ dropA now (sceneAnimation (wait now >> s)) + 745 + 746 -- | Apply a transformation with a given overlap. This makes sure + 747 -- to keep timestamps intact such that events can still be timed + 748 -- by transcripts. + 749 transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s () + 750 transitionO t o a b = do + 751 aA <- asAnimation a + 752 bA <- fork $ do + 753 wait (duration aA - o) + 754 asAnimation b + 755 play $ overlapT o t aA bA + 756 + 757 + 758 + 759 + 760 ------------------------------------------------------- + 761 -- Objects + 762 + 763 -- | Objects can be any Haskell structure as long as it can be rendered to SVG. + 764 class Renderable a where + 765 toSVG :: a -> SVG + 766 + 767 instance Renderable Tree where + 768 toSVG = id + 769 + 770 -- | Objects are SVG nodes (represented as Haskell values) with + 771 -- identity, location, and several other properties that can + 772 -- change over time. + 773 data Object s a = Object + 774 { objectSprite :: Sprite s + 775 , objectData :: Var s (ObjectData a) + 776 } + 777 + 778 -- | Container for object properties. + 779 data ObjectData a = ObjectData + 780 { _oTranslate :: (Double, Double) + 781 , _oValueRef :: a + 782 , _oSVG :: SVG + 783 , _oContext :: SVG -> SVG + 784 , _oMargin :: (Double, Double, Double, Double) + 785 -- ^ Top, right, bottom, left + 786 , _oBB :: (Double,Double,Double,Double) + 787 , _oOpacity :: Double + 788 , _oShown :: Bool + 789 , _oZIndex :: Int + 790 , _oEasing :: Signal + 791 , _oScale :: Double + 792 , _oScaleOrigin :: (Double, Double) + 793 } + 794 + 795 -- Basic lenses + 796 + 797 -- FIXME: Maybe 'position' is a better name. + 798 -- | Object position. Default: \<0,0\> + 799 oTranslate :: Lens' (ObjectData a) (Double, Double) + 800 oTranslate = lens _oTranslate $ \obj val -> obj { _oTranslate = val } + 801 + 802 -- | Rendered SVG node of an object. Does not include context + 803 -- or object properties. Read-only. + 804 oSVG :: Getter (ObjectData a) SVG + 805 oSVG = to _oSVG + 806 + 807 -- | Custom render context. Is applied to the object for every + 808 -- frame that it is shown. + 809 oContext :: Lens' (ObjectData a) (SVG -> SVG) + 810 oContext = lens _oContext $ \obj val -> obj { _oContext = val } + 811 + 812 -- | Object margins (top, right, bottom, left) in local units. + 813 oMargin :: Lens' (ObjectData a) (Double, Double, Double, Double) + 814 oMargin = lens _oMargin $ \obj val -> obj { _oMargin = val } + 815 + 816 -- | Object bounding-box (minimal X-coordinate, minimal Y-coordinate, + 817 -- width, height). Uses `Reanimate.Svg.BoundingBox.boundingBox` + 818 -- and has the same limitations. + 819 oBB :: Getter (ObjectData a) (Double, Double, Double, Double) + 820 oBB = to _oBB + 821 + 822 -- | Object opacity. Default: 1 + 823 oOpacity :: Lens' (ObjectData a) Double + 824 oOpacity = lens _oOpacity $ \obj val -> obj { _oOpacity = val } + 825 + 826 -- | Toggle for whether or not the object should be rendered. + 827 -- Default: False + 828 oShown :: Lens' (ObjectData a) Bool + 829 oShown = lens _oShown $ \obj val -> obj { _oShown = val } + 830 + 831 -- | Object's z-index. + 832 oZIndex :: Lens' (ObjectData a) Int + 833 oZIndex = lens _oZIndex $ \obj val -> obj { _oZIndex = val } + 834 + 835 -- | Easing function used when modifying object properties. + 836 -- Default: @'Reanimate.Ease.curveS' 2@ + 837 oEasing :: Lens' (ObjectData a) Signal + 838 oEasing = lens _oEasing $ \obj val -> obj { _oEasing = val } + 839 + 840 -- | Object's scale. Default: 1 + 841 oScale :: Lens' (ObjectData a) Double + 842 oScale = lens _oScale $ \obj val -> obj { _oScale = val } + 843 + 844 -- | Origin point for scaling. Default: \<0,0\> + 845 oScaleOrigin :: Lens' (ObjectData a) (Double, Double) + 846 oScaleOrigin = lens _oScaleOrigin $ \obj val -> obj { _oScaleOrigin = val } + 847 + 848 -- Smart lenses + 849 + 850 -- | Lens for the source value contained in an object. + 851 oValue :: Renderable a => Lens' (ObjectData a) a + 852 oValue = lens _oValueRef $ \obj newVal -> + 853 let svg = toSVG newVal + 854 in obj + 855 { _oValueRef = newVal + 856 , _oSVG = svg + 857 , _oBB = boundingBox svg } + 858 + 859 -- | Derived location of the top-most point of an object + margin. + 860 oTopY :: Lens' (ObjectData a) Double + 861 oTopY = lens getter setter + 862 where + 863 getter obj = + 864 let top = obj ^. oMarginTop + 865 miny = obj ^. oBBMinY + 866 h = obj ^. oBBHeight + 867 dy = obj ^. oTranslate . _2 + 868 in dy+miny+h+top + 869 setter obj val = + 870 obj & (oTranslate . _2) +~ val-getter obj + 871 + 872 -- | Derived location of the bottom-most point of an object + margin. + 873 oBottomY :: Lens' (ObjectData a) Double + 874 oBottomY = lens getter setter + 875 where + 876 getter obj = + 877 let bot = obj ^. oMarginBottom + 878 miny = obj ^. oBBMinY + 879 dy = obj ^. oTranslate . _2 + 880 in dy+miny-bot + 881 setter obj val = + 882 obj & (oTranslate . _2) +~ val-getter obj + 883 + 884 -- | Derived location of the left-most point of an object + margin. + 885 oLeftX :: Lens' (ObjectData a) Double + 886 oLeftX = lens getter setter + 887 where + 888 getter obj = + 889 let left = obj ^. oMarginLeft + 890 minx = obj ^. oBBMinX + 891 dx = obj ^. oTranslate . _1 + 892 in dx+minx-left + 893 setter obj val = + 894 obj & (oTranslate . _1) +~ val-getter obj + 895 + 896 -- | Derived location of the right-most point of an object + margin. + 897 oRightX :: Lens' (ObjectData a) Double + 898 oRightX = lens getter setter + 899 where + 900 getter obj = + 901 let right = obj ^. oMarginRight + 902 minx = obj ^. oBBMinX + 903 w = obj ^. oBBWidth + 904 dx = obj ^. oTranslate . _1 + 905 in dx+minx+w+right + 906 setter obj val = + 907 obj & (oTranslate . _1) +~ val-getter obj 908 - 909 -- | Object's top margin. - 910 oMarginTop :: Lens' (ObjectData a) Double - 911 oMarginTop = oMargin . _1 - 912 - 913 -- | Object's right margin. - 914 oMarginRight :: Lens' (ObjectData a) Double - 915 oMarginRight = oMargin . _2 - 916 - 917 -- | Object's bottom margin. - 918 oMarginBottom :: Lens' (ObjectData a) Double - 919 oMarginBottom = oMargin . _3 - 920 - 921 -- | Object's left margin. - 922 oMarginLeft :: Lens' (ObjectData a) Double - 923 oMarginLeft = oMargin . _4 + 909 -- | Derived location of an object's center point. + 910 oCenterXY :: Lens' (ObjectData a) (Double, Double) + 911 oCenterXY = lens getter setter + 912 where + 913 getter obj = + 914 let minx = obj ^. oBBMinX + 915 miny = obj ^. oBBMinY + 916 w = obj ^. oBBWidth + 917 h = obj ^. oBBHeight + 918 (dx,dy) = obj ^. oTranslate + 919 in (dx+minx+w/2, dy+miny+h/2) + 920 setter obj (dx, dy) = + 921 let (x,y) = getter obj in + 922 obj & (oTranslate . _1) +~ dx-x + 923 & (oTranslate . _2) +~ dy-y 924 - 925 -- | Object's minimal X-coordinate.. - 926 oBBMinX :: Getter (ObjectData a) Double - 927 oBBMinX = oBB . _1 + 925 -- | Object's top margin. + 926 oMarginTop :: Lens' (ObjectData a) Double + 927 oMarginTop = oMargin . _1 928 - 929 -- | Object's minimal Y-coordinate.. - 930 oBBMinY :: Getter (ObjectData a) Double - 931 oBBMinY = oBB . _2 + 929 -- | Object's right margin. + 930 oMarginRight :: Lens' (ObjectData a) Double + 931 oMarginRight = oMargin . _2 932 - 933 -- | Object's width without margin. - 934 oBBWidth :: Getter (ObjectData a) Double - 935 oBBWidth = oBB . _3 + 933 -- | Object's bottom margin. + 934 oMarginBottom :: Lens' (ObjectData a) Double + 935 oMarginBottom = oMargin . _3 936 - 937 -- | Object's height without margin. - 938 oBBHeight :: Getter (ObjectData a) Double - 939 oBBHeight = oBB . _4 + 937 -- | Object's left margin. + 938 oMarginLeft :: Lens' (ObjectData a) Double + 939 oMarginLeft = oMargin . _4 940 - 941 ------------------------------------------------------------------------------- - 942 -- Object modifiers - 943 - 944 -- | Modify object properties. - 945 oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s () - 946 oModify o fn = modifyVar (objectData o) fn - 947 - 948 -- | Modify object properties using a stateful API. - 949 oModifyS :: Object s a -> (State (ObjectData a) b) -> Scene s () - 950 oModifyS o fn = oModify o (execState fn) - 951 - 952 -- | Query object property. - 953 oRead :: Object s a -> Getting b (ObjectData a) b -> Scene s b - 954 oRead o l = view l <$> readVar (objectData o) - 955 - 956 -- | Modify object properties over a set duration. - 957 oTween :: Object s a -> Duration -> (Double -> ObjectData a -> ObjectData a) -> Scene s () - 958 oTween o d fn = do - 959 -- Read 'easing' var here instead of taking it from 'v'. - 960 -- This allows different easing functions even at the same timestamp. - 961 ease <- oRead o oEasing - 962 tweenVar (objectData o) d (\v t -> fn (ease t) v) + 941 -- | Object's minimal X-coordinate.. + 942 oBBMinX :: Getter (ObjectData a) Double + 943 oBBMinX = oBB . _1 + 944 + 945 -- | Object's minimal Y-coordinate.. + 946 oBBMinY :: Getter (ObjectData a) Double + 947 oBBMinY = oBB . _2 + 948 + 949 -- | Object's width without margin. + 950 oBBWidth :: Getter (ObjectData a) Double + 951 oBBWidth = oBB . _3 + 952 + 953 -- | Object's height without margin. + 954 oBBHeight :: Getter (ObjectData a) Double + 955 oBBHeight = oBB . _4 + 956 + 957 ------------------------------------------------------------------------------- + 958 -- Object modifiers + 959 + 960 -- | Modify object properties. + 961 oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s () + 962 oModify o fn = modifyVar (objectData o) fn 963 - 964 -- | Modify object properties over a set duration using a stateful API. - 965 oTweenS :: Object s a -> Duration -> (Double -> State (ObjectData a) b) -> Scene s () - 966 oTweenS o d fn = oTween o d (\t -> execState (fn t)) + 964 -- | Modify object properties using a stateful API. + 965 oModifyS :: Object s a -> (State (ObjectData a) b) -> Scene s () + 966 oModifyS o fn = oModify o (execState fn) 967 - 968 -- | Modify object value over a set duration. This is a convenience function - 969 -- for modifying `oValue`. - 970 oTweenV :: Renderable a => Object s a -> Duration -> (Double -> a -> a) -> Scene s () - 971 oTweenV o d fn = oTween o d (\t -> oValue %~ fn t) - 972 - 973 -- | Modify object value over a set duration using a stateful API. This is a - 974 -- convenience function for modifying `oValue`. - 975 oTweenVS :: Renderable a => Object s a -> Duration -> (Double -> State a b) -> Scene s () - 976 oTweenVS o d fn = oTween o d (\t -> oValue %~ execState (fn t)) - 977 - 978 -- | Create new object. - 979 oNew :: Renderable a => a -> Scene s (Object s a) - 980 oNew = newObject - 981 - 982 -- | Create new object. - 983 newObject :: Renderable a => a -> Scene s (Object s a) - 984 newObject val = do - 985 ref <- newVar ObjectData - 986 { _oTranslate = (0,0) - 987 , _oValueRef = val - 988 , _oSVG = svg - 989 , _oContext = id - 990 , _oMargin = (0.5,0.5,0.5,0.5) - 991 , _oBB = boundingBox svg - 992 , _oOpacity = 1 - 993 , _oShown = False - 994 , _oZIndex = 1 - 995 , _oEasing = curveS 2 - 996 , _oScale = 1 - 997 , _oScaleOrigin = (0,0) - 998 } - 999 sprite <- newSprite $ do - 1000 ~ObjectData{..} <- unVar ref - 1001 pure $ - 1002 if _oShown - 1003 then - 1004 uncurry translate _oTranslate $ - 1005 uncurry translate (_oScaleOrigin & both %~ negate) $ - 1006 scale _oScale $ - 1007 uncurry translate _oScaleOrigin $ - 1008 withGroupOpacity _oOpacity $ - 1009 _oContext _oSVG - 1010 else None - 1011 spriteModify sprite $ do - 1012 ~ObjectData{_oZIndex=z} <- unVar ref - 1013 pure $ \(img,_) -> (img,z) - 1014 return Object - 1015 { objectSprite = sprite - 1016 , objectData = ref } - 1017 where - 1018 svg = toSVG val - 1019 - 1020 ------------------------------------------------------------------------------- - 1021 -- Graphical transformations - 1022 - 1023 -- | Instantly show object. - 1024 oShow :: Object s a -> Scene s () - 1025 oShow o = oModify o $ oShown .~ True - 1026 - 1027 -- | Instantly hide object. - 1028 oHide :: Object s a -> Scene s () - 1029 oHide o = oModify o $ oShown .~ False - 1030 - 1031 -- | Fade in object over a set duration. - 1032 oFadeIn :: Object s a -> Duration -> Scene s () - 1033 oFadeIn o d = do - 1034 oModify o $ - 1035 oShown .~ True - 1036 oTweenS o d $ \t -> - 1037 oOpacity *= t + 968 -- | Query object property. + 969 oRead :: Object s a -> Getting b (ObjectData a) b -> Scene s b + 970 oRead o l = view l <$> readVar (objectData o) + 971 + 972 -- | Modify object properties over a set duration. + 973 oTween :: Object s a -> Duration -> (Double -> ObjectData a -> ObjectData a) -> Scene s () + 974 oTween o d fn = do + 975 -- Read 'easing' var here instead of taking it from 'v'. + 976 -- This allows different easing functions even at the same timestamp. + 977 ease <- oRead o oEasing + 978 tweenVar (objectData o) d (\v t -> fn (ease t) v) + 979 + 980 -- | Modify object properties over a set duration using a stateful API. + 981 oTweenS :: Object s a -> Duration -> (Double -> State (ObjectData a) b) -> Scene s () + 982 oTweenS o d fn = oTween o d (\t -> execState (fn t)) + 983 + 984 -- | Modify object value over a set duration. This is a convenience function + 985 -- for modifying `oValue`. + 986 oTweenV :: Renderable a => Object s a -> Duration -> (Double -> a -> a) -> Scene s () + 987 oTweenV o d fn = oTween o d (\t -> oValue %~ fn t) + 988 + 989 -- | Modify object value over a set duration using a stateful API. This is a + 990 -- convenience function for modifying `oValue`. + 991 oTweenVS :: Renderable a => Object s a -> Duration -> (Double -> State a b) -> Scene s () + 992 oTweenVS o d fn = oTween o d (\t -> oValue %~ execState (fn t)) + 993 + 994 -- | Create new object. + 995 oNew :: Renderable a => a -> Scene s (Object s a) + 996 oNew = newObject + 997 + 998 -- | Create new object. + 999 newObject :: Renderable a => a -> Scene s (Object s a) + 1000 newObject val = do + 1001 ref <- newVar ObjectData + 1002 { _oTranslate = (0,0) + 1003 , _oValueRef = val + 1004 , _oSVG = svg + 1005 , _oContext = id + 1006 , _oMargin = (0.5,0.5,0.5,0.5) + 1007 , _oBB = boundingBox svg + 1008 , _oOpacity = 1 + 1009 , _oShown = False + 1010 , _oZIndex = 1 + 1011 , _oEasing = curveS 2 + 1012 , _oScale = 1 + 1013 , _oScaleOrigin = (0,0) + 1014 } + 1015 sprite <- newSprite $ do + 1016 ~ObjectData{..} <- unVar ref + 1017 pure $ + 1018 if _oShown + 1019 then + 1020 uncurry translate _oTranslate $ + 1021 uncurry translate (_oScaleOrigin & both %~ negate) $ + 1022 scale _oScale $ + 1023 uncurry translate _oScaleOrigin $ + 1024 withGroupOpacity _oOpacity $ + 1025 _oContext _oSVG + 1026 else None + 1027 spriteModify sprite $ do + 1028 ~ObjectData{_oZIndex=z} <- unVar ref + 1029 pure $ \(img,_) -> (img,z) + 1030 return Object + 1031 { objectSprite = sprite + 1032 , objectData = ref } + 1033 where + 1034 svg = toSVG val + 1035 + 1036 ------------------------------------------------------------------------------- + 1037 -- Graphical transformations 1038 - 1039 -- | Fade out object over a set duration. - 1040 oFadeOut :: Object s a -> Duration -> Scene s () - 1041 oFadeOut o d = do - 1042 oModify o $ - 1043 oShown .~ True - 1044 oTweenS o d $ \t -> - 1045 oOpacity *= 1-t + 1039 -- | Instantly show object. + 1040 oShow :: Object s a -> Scene s () + 1041 oShow o = oModify o $ oShown .~ True + 1042 + 1043 -- | Instantly hide object. + 1044 oHide :: Object s a -> Scene s () + 1045 oHide o = oModify o $ oShown .~ False 1046 - 1047 -- | Scale in object over a set duration. - 1048 oGrow :: Object s a -> Duration -> Scene s () - 1049 oGrow o d = do - 1050 oModify o $ - 1051 oShown .~ True - 1052 oTweenS o d $ \t -> - 1053 oScale *= t - 1054 - 1055 -- | Scale out object over a set duration. - 1056 oShrink :: Object s a -> Duration -> Scene s () - 1057 oShrink o d = - 1058 oTweenS o d $ \t -> - 1059 oScale *= 1-t - 1060 - 1061 -- FIXME: Also transform attributes: 'opacity', 'scale', 'scaleOrigin'. - 1062 -- | Morph source object into target object over a set duration. - 1063 oTransform :: Object s a -> Object s b -> Duration -> Scene s () - 1064 oTransform src dst d = do - 1065 srcSvg <- oRead src oSVG - 1066 srcCtx <- oRead src oContext - 1067 srcEase <- oRead src oEasing - 1068 srcLoc <- oRead src oTranslate - 1069 oModify src $ oShown .~ False - 1070 - 1071 dstSvg <- oRead dst oSVG - 1072 dstCtx <- oRead dst oContext - 1073 dstLoc <- oRead dst oTranslate - 1074 - 1075 m <- newObject $ Morph 0 (srcCtx srcSvg) (dstCtx dstSvg) - 1076 oModifyS m $ do - 1077 oShown .= True - 1078 oEasing .= srcEase - 1079 oTranslate .= srcLoc - 1080 fork $ oTween m d $ \t -> oTranslate %~ moveTo t dstLoc - 1081 oTweenV m d $ \t -> morphDelta .~ t - 1082 oModify m $ oShown .~ False - 1083 oModify dst $ oShown .~ True - 1084 where - 1085 moveTo t (dstX, dstY) (srcX, srcY) = - 1086 (fromToS srcX dstX t, fromToS srcY dstY t) - 1087 - 1088 - 1089 ------------------------------------------------------------------------------- - 1090 -- Built-in objects - 1091 - 1092 -- | Basic object mapping to \<circle\/\> in SVG. - 1093 newtype Circle = Circle {_circleRadius :: Double} - 1094 - 1095 -- | Circle radius in local units. - 1096 circleRadius :: Lens' Circle Double - 1097 circleRadius = iso _circleRadius Circle - 1098 - 1099 instance Renderable Circle where - 1100 toSVG (Circle r) = mkCircle r + 1047 oShowWith :: Object s a -> (SVG -> Animation) -> Scene s () + 1048 oShowWith o fn = do + 1049 oModify o $ oShown .~ True + 1050 initSVG <- oRead o oSVG + 1051 let ani = fn initSVG + 1052 oTween o (duration ani) $ \t obj -> + 1053 obj{ _oSVG = getAnimationFrame SyncStretch ani t 1 } + 1054 oModify o $ \obj -> obj { _oSVG = initSVG } + 1055 + 1056 oHideWith :: Object s a -> (SVG -> Animation) -> Scene s () + 1057 oHideWith o fn = do + 1058 initSVG <- oRead o oSVG + 1059 let ani = fn initSVG + 1060 oTween o (duration ani) $ \t obj -> + 1061 obj{ _oSVG = getAnimationFrame SyncStretch ani t 1 } + 1062 oModify o $ \obj -> obj { _oSVG = initSVG } + 1063 oModify o $ oShown .~ False + 1064 + 1065 -- | Fade in object over a set duration. + 1066 oFadeIn :: SVG -> Animation + 1067 oFadeIn svg = animate $ \t -> withGroupOpacity t svg + 1068 + 1069 -- | Fade out object over a set duration. + 1070 oFadeOut :: SVG -> Animation + 1071 oFadeOut = reverseA . oFadeIn + 1072 + 1073 -- | Scale in object over a set duration. + 1074 oGrow :: SVG -> Animation + 1075 oGrow svg = animate $ \t -> scale t svg + 1076 + 1077 -- | Scale out object over a set duration. + 1078 oShrink :: SVG -> Animation + 1079 oShrink = reverseA . oGrow + 1080 + 1081 type Origin = (Double, Double) + 1082 + 1083 svgOrigin :: SVG -> Origin -> (Double, Double) + 1084 svgOrigin svg (originX, originY) = + 1085 case boundingBox svg of + 1086 (polyX, polyY, polyWidth, polyHeight) -> + 1087 ( polyX + polyWidth * originX + 1088 , polyY + polyHeight * originY) + 1089 + 1090 oScaleIn :: SVG -> Animation + 1091 oScaleIn = oScaleIn' (curveS 2) (0.5,1) + 1092 + 1093 oScaleIn' :: Signal -> Origin -> SVG -> Animation + 1094 oScaleIn' easing origin = oStagger' 0.05 $ \svg -> + 1095 let (cx, cy) = svgOrigin svg origin + 1096 in signalA easing $ mkAnimation 0.3 $ \t -> + 1097 translate cx cy $ + 1098 scale t $ + 1099 translate (-cx) (-cy) $ + 1100 svg 1101 - 1102 -- | Basic object mapping to \<rect\/\> in SVG. - 1103 data Rectangle = Rectangle { _rectWidth :: Double, _rectHeight :: Double } + 1102 oScaleOut :: SVG -> Animation + 1103 oScaleOut = reverseA . oStaggerRev' 0.05 (oScaleIn' (curveS 2) (0.5,0)) 1104 - 1105 -- | Rectangle width in local units. - 1106 rectWidth :: Lens' Rectangle Double - 1107 rectWidth = lens _rectWidth $ \obj val -> obj{_rectWidth=val} - 1108 - 1109 -- | Rectangle height in local units. - 1110 rectHeight :: Lens' Rectangle Double - 1111 rectHeight = lens _rectHeight $ \obj val -> obj{_rectHeight=val} - 1112 - 1113 instance Renderable Rectangle where - 1114 toSVG (Rectangle w h) = mkRect w h + 1105 oScaleOut' :: Signal -> Origin -> SVG -> Animation + 1106 oScaleOut' easing origin = reverseA . oStaggerRev' 0.05 (oScaleIn' easing origin) + 1107 + 1108 oSim :: (SVG -> Animation) -> SVG -> Animation + 1109 oSim = oStagger' 0 + 1110 + 1111 -- oSim (oStagger fn) = oSim fn + 1112 -- oStagger (oStagger fn) = oStagger fn + 1113 oStagger :: (SVG -> Animation) -> SVG -> Animation + 1114 oStagger = oStagger' 0.2 1115 - 1116 -- | Object representing an interpolation between SVG nodes. - 1117 data Morph = Morph { _morphDelta :: Double, _morphSrc :: SVG, _morphDst :: SVG } + 1116 oStaggerRev :: (SVG -> Animation) -> SVG -> Animation + 1117 oStaggerRev = oStaggerRev' 0.2 1118 - 1119 -- | Control variable for the interpolation. A value of 0 gives the - 1120 -- source SVG and 1 gives the target svg. - 1121 morphDelta :: Lens' Morph Double - 1122 morphDelta = lens _morphDelta $ \obj val -> obj{_morphDelta = val} - 1123 - 1124 -- | Source shape. - 1125 morphSrc :: Lens' Morph SVG - 1126 morphSrc = lens _morphSrc $ \obj val -> obj{_morphSrc = val} - 1127 - 1128 -- | Target shape. - 1129 morphDst :: Lens' Morph SVG - 1130 morphDst = lens _morphDst $ \obj val -> obj{_morphDst = val} - 1131 - 1132 instance Renderable Morph where - 1133 toSVG (Morph t src dst) = morph linear src dst t - 1134 - 1135 -- | Cameras can take control of objects and manipulate them - 1136 -- with convenient pan and zoom operations. - 1137 data Camera = Camera - 1138 instance Renderable Camera where - 1139 toSVG Camera = None - 1140 - 1141 -- | Connect an object to a camera such that - 1142 -- camera settings (position, zoom, and rotation) is - 1143 -- applied to the object. - 1144 -- - 1145 -- Example - 1146 -- - 1147 -- @ - 1148 -- do cam \<- 'newObject' 'Camera' - 1149 -- circ \<- 'newObject' $ 'Circle' 2 - 1150 -- 'oModifyS' circ $ - 1151 -- 'oContext' .= 'withFillOpacity' 1 . 'withFillColor' "blue" - 1152 -- 'oShow' circ - 1153 -- 'cameraAttach' cam circ - 1154 -- 'cameraZoom' cam 1 2 - 1155 -- 'cameraZoom' cam 1 1 - 1156 -- @ - 1157 -- - 1158 -- <<docs/gifs/doc_cameraAttach.gif>> - 1159 cameraAttach :: Object s Camera -> Object s a -> Scene s () - 1160 cameraAttach cam obj = - 1161 spriteModify (objectSprite obj) $ do - 1162 camData <- unVar (objectData cam) - 1163 return $ \(svg,zindex) -> - 1164 let (x,y) = camData^.oTranslate - 1165 ctx = - 1166 translate (-x) (-y) . - 1167 uncurry translate (camData^.oScaleOrigin) . - 1168 scale (camData^.oScale) . - 1169 uncurry translate (camData^.oScaleOrigin & both %~ negate) - 1170 in (ctx svg, zindex) - 1171 - 1172 -- | - 1173 -- - 1174 -- Example - 1175 -- - 1176 -- @ - 1177 -- do cam \<- 'newObject' 'Camera' - 1178 -- circ \<- 'newObject' $ 'Circle' 2; 'oShow' circ - 1179 -- 'oModify' circ $ 'oTranslate' .~ (-3,0) - 1180 -- box \<- 'newObject' $ 'Rectangle' 4 4; 'oShow' box - 1181 -- 'oModify' box $ 'oTranslate' .~ (3,0) - 1182 -- 'cameraAttach' cam circ - 1183 -- 'cameraAttach' cam box - 1184 -- 'cameraFocus' cam (-3,0) - 1185 -- 'cameraZoom' cam 2 2 -- Zoom in - 1186 -- 'cameraZoom' cam 2 1 -- Zoom out - 1187 -- 'cameraFocus' cam (3,0) - 1188 -- 'cameraZoom' cam 2 2 -- Zoom in - 1189 -- 'cameraZoom' cam 2 1 -- Zoom out - 1190 -- @ - 1191 -- - 1192 -- <<docs/gifs/doc_cameraFocus.gif>> - 1193 cameraFocus :: Object s Camera -> (Double, Double) -> Scene s () - 1194 cameraFocus cam (x,y) = do - 1195 (ox, oy) <- oRead cam oScaleOrigin - 1196 (tx, ty) <- oRead cam oTranslate - 1197 s <- oRead cam oScale - 1198 let newLocation = (x-((x-ox)*s+ox-tx), y-((y-oy)*s+oy-ty)) - 1199 oModifyS cam $ do - 1200 oTranslate .= newLocation - 1201 oScaleOrigin .= (x,y) + 1119 oStagger' :: Duration -> (SVG -> Animation) -> SVG -> Animation + 1120 oStagger' staggerDelay fn svg = scene $ + 1121 forM_ (svgGlyphs svg) $ \(ctx, _attr, node) -> do + 1122 void $ fork $ newSpriteA' SyncFreeze (fn $ ctx node) + 1123 wait staggerDelay + 1124 + 1125 oStaggerRev' :: Duration -> (SVG -> Animation) -> SVG -> Animation + 1126 oStaggerRev' staggerDelay fn svg = scene $ + 1127 forM_ (reverse $ svgGlyphs svg) $ \(ctx, _attr, node) -> do + 1128 void $ fork $ newSpriteA' SyncFreeze (fn $ ctx node) + 1129 wait staggerDelay + 1130 + 1131 oDraw :: SVG -> Animation + 1132 oDraw = oStagger $ \svg -> scene $ do + 1133 forM_ (svgGlyphs $ pathify svg) $ \(ctx, attr, node) -> do + 1134 let sWidth = + 1135 case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of + 1136 Just (Num d) -> max defaultStrokeWidth d + 1137 _ -> defaultStrokeWidth + 1138 -- wait 1 + 1139 play $ + 1140 mapA ctx $ + 1141 applyE (overEnding fillDur $ fadeLineOutE sWidth) $ + 1142 animate $ \t -> withStrokeWidth sWidth $ + 1143 mkGroup + 1144 [withFillOpacity 0 $ partialSvg t node] + 1145 wait (-fillDur) + 1146 newSpriteA' SyncFreeze $ mkAnimation fillDur $ \t -> + 1147 withGroupOpacity t $ + 1148 mkGroup [ ctx node ] + 1149 where + 1150 fillDur = 0.3 + 1151 + 1152 _oBalloon :: SVG -> Animation + 1153 _oBalloon = animate . balloon + 1154 + 1155 -- FIXME: Also transform attributes: 'opacity', 'scale', 'scaleOrigin'. + 1156 -- | Morph source object into target object over a set duration. + 1157 oTransform :: Object s a -> Object s b -> Duration -> Scene s () + 1158 oTransform src dst d = do + 1159 srcSvg <- oRead src oSVG + 1160 srcCtx <- oRead src oContext + 1161 srcEase <- oRead src oEasing + 1162 srcLoc <- oRead src oTranslate + 1163 oModify src $ oShown .~ False + 1164 + 1165 dstSvg <- oRead dst oSVG + 1166 dstCtx <- oRead dst oContext + 1167 dstLoc <- oRead dst oTranslate + 1168 + 1169 m <- newObject $ Morph 0 (srcCtx srcSvg) (dstCtx dstSvg) + 1170 oModifyS m $ do + 1171 oShown .= True + 1172 oEasing .= srcEase + 1173 oTranslate .= srcLoc + 1174 fork $ oTween m d $ \t -> oTranslate %~ moveTo t dstLoc + 1175 oTweenV m d $ \t -> morphDelta .~ t + 1176 oModify m $ oShown .~ False + 1177 oModify dst $ oShown .~ True + 1178 where + 1179 moveTo t (dstX, dstY) (srcX, srcY) = + 1180 (fromToS srcX dstX t, fromToS srcY dstY t) + 1181 + 1182 + 1183 ------------------------------------------------------------------------------- + 1184 -- Built-in objects + 1185 + 1186 -- | Basic object mapping to \<circle\/\> in SVG. + 1187 newtype Circle = Circle {_circleRadius :: Double} + 1188 + 1189 -- | Circle radius in local units. + 1190 circleRadius :: Lens' Circle Double + 1191 circleRadius = iso _circleRadius Circle + 1192 + 1193 instance Renderable Circle where + 1194 toSVG (Circle r) = mkCircle r + 1195 + 1196 -- | Basic object mapping to \<rect\/\> in SVG. + 1197 data Rectangle = Rectangle { _rectWidth :: Double, _rectHeight :: Double } + 1198 + 1199 -- | Rectangle width in local units. + 1200 rectWidth :: Lens' Rectangle Double + 1201 rectWidth = lens _rectWidth $ \obj val -> obj{_rectWidth=val} 1202 - 1203 -- | Instantaneously set camera zoom level. - 1204 cameraSetZoom :: Object s Camera -> Double -> Scene s () - 1205 cameraSetZoom cam s = - 1206 oModifyS cam $ - 1207 oScale .= s - 1208 - 1209 -- | Change camera zoom level over a set duration. - 1210 cameraZoom :: Object s Camera -> Duration -> Double -> Scene s () - 1211 cameraZoom cam d s = - 1212 oTweenS cam d $ \t -> - 1213 oScale %= \v -> fromToS v s t - 1214 - 1215 -- | Instantaneously set camera location. - 1216 cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s () - 1217 cameraSetPan cam location = - 1218 oModifyS cam $ do - 1219 oTranslate .= location - 1220 - 1221 -- | Change camera location over a set duration. - 1222 cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s () - 1223 cameraPan cam d (x,y) = - 1224 oTweenS cam d $ \t -> do - 1225 oTranslate._1 %= \v -> fromToS v x t - 1226 oTranslate._2 %= \v -> fromToS v y t + 1203 -- | Rectangle height in local units. + 1204 rectHeight :: Lens' Rectangle Double + 1205 rectHeight = lens _rectHeight $ \obj val -> obj{_rectHeight=val} + 1206 + 1207 instance Renderable Rectangle where + 1208 toSVG (Rectangle w h) = mkRect w h + 1209 + 1210 -- | Object representing an interpolation between SVG nodes. + 1211 data Morph = Morph { _morphDelta :: Double, _morphSrc :: SVG, _morphDst :: SVG } + 1212 + 1213 -- | Control variable for the interpolation. A value of 0 gives the + 1214 -- source SVG and 1 gives the target svg. + 1215 morphDelta :: Lens' Morph Double + 1216 morphDelta = lens _morphDelta $ \obj val -> obj{_morphDelta = val} + 1217 + 1218 -- | Source shape. + 1219 morphSrc :: Lens' Morph SVG + 1220 morphSrc = lens _morphSrc $ \obj val -> obj{_morphSrc = val} + 1221 + 1222 -- | Target shape. + 1223 morphDst :: Lens' Morph SVG + 1224 morphDst = lens _morphDst $ \obj val -> obj{_morphDst = val} + 1225 + 1226 instance Renderable Morph where + 1227 toSVG (Morph t src dst) = morph linear src dst t + 1228 + 1229 -- | Cameras can take control of objects and manipulate them + 1230 -- with convenient pan and zoom operations. + 1231 data Camera = Camera + 1232 instance Renderable Camera where + 1233 toSVG Camera = None + 1234 + 1235 -- | Connect an object to a camera such that + 1236 -- camera settings (position, zoom, and rotation) is + 1237 -- applied to the object. + 1238 -- + 1239 -- Example + 1240 -- + 1241 -- @ + 1242 -- do cam \<- 'newObject' 'Camera' + 1243 -- circ \<- 'newObject' $ 'Circle' 2 + 1244 -- 'oModifyS' circ $ + 1245 -- 'oContext' .= 'withFillOpacity' 1 . 'withFillColor' "blue" + 1246 -- 'oShow' circ + 1247 -- 'cameraAttach' cam circ + 1248 -- 'cameraZoom' cam 1 2 + 1249 -- 'cameraZoom' cam 1 1 + 1250 -- @ + 1251 -- + 1252 -- <<docs/gifs/doc_cameraAttach.gif>> + 1253 cameraAttach :: Object s Camera -> Object s a -> Scene s () + 1254 cameraAttach cam obj = + 1255 spriteModify (objectSprite obj) $ do + 1256 camData <- unVar (objectData cam) + 1257 return $ \(svg,zindex) -> + 1258 let (x,y) = camData^.oTranslate + 1259 ctx = + 1260 translate (-x) (-y) . + 1261 uncurry translate (camData^.oScaleOrigin) . + 1262 scale (camData^.oScale) . + 1263 uncurry translate (camData^.oScaleOrigin & both %~ negate) + 1264 in (ctx svg, zindex) + 1265 + 1266 -- | + 1267 -- + 1268 -- Example + 1269 -- + 1270 -- @ + 1271 -- do cam \<- 'newObject' 'Camera' + 1272 -- circ \<- 'newObject' $ 'Circle' 2; 'oShow' circ + 1273 -- 'oModify' circ $ 'oTranslate' .~ (-3,0) + 1274 -- box \<- 'newObject' $ 'Rectangle' 4 4; 'oShow' box + 1275 -- 'oModify' box $ 'oTranslate' .~ (3,0) + 1276 -- 'cameraAttach' cam circ + 1277 -- 'cameraAttach' cam box + 1278 -- 'cameraFocus' cam (-3,0) + 1279 -- 'cameraZoom' cam 2 2 -- Zoom in + 1280 -- 'cameraZoom' cam 2 1 -- Zoom out + 1281 -- 'cameraFocus' cam (3,0) + 1282 -- 'cameraZoom' cam 2 2 -- Zoom in + 1283 -- 'cameraZoom' cam 2 1 -- Zoom out + 1284 -- @ + 1285 -- + 1286 -- <<docs/gifs/doc_cameraFocus.gif>> + 1287 cameraFocus :: Object s Camera -> (Double, Double) -> Scene s () + 1288 cameraFocus cam (x,y) = do + 1289 (ox, oy) <- oRead cam oScaleOrigin + 1290 (tx, ty) <- oRead cam oTranslate + 1291 s <- oRead cam oScale + 1292 let newLocation = (x-((x-ox)*s+ox-tx), y-((y-oy)*s+oy-ty)) + 1293 oModifyS cam $ do + 1294 oTranslate .= newLocation + 1295 oScaleOrigin .= (x,y) + 1296 + 1297 -- | Instantaneously set camera zoom level. + 1298 cameraSetZoom :: Object s Camera -> Double -> Scene s () + 1299 cameraSetZoom cam s = + 1300 oModifyS cam $ + 1301 oScale .= s + 1302 + 1303 -- | Change camera zoom level over a set duration. + 1304 cameraZoom :: Object s Camera -> Duration -> Double -> Scene s () + 1305 cameraZoom cam d s = + 1306 oTweenS cam d $ \t -> + 1307 oScale %= \v -> fromToS v s t + 1308 + 1309 -- | Instantaneously set camera location. + 1310 cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s () + 1311 cameraSetPan cam location = + 1312 oModifyS cam $ do + 1313 oTranslate .= location + 1314 + 1315 -- | Change camera location over a set duration. + 1316 cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s () + 1317 cameraPan cam d (x,y) = + 1318 oTweenS cam d $ \t -> do + 1319 oTranslate._1 %= \v -> fromToS v x t + 1320 oTranslate._2 %= \v -> fromToS v y t diff --git a/reanimate-0.4.3.0-inplace/Reanimate.Svg.hs.html b/reanimate-0.4.3.0-inplace/Reanimate.Svg.hs.html index ee69f97..757b006 100644 --- a/reanimate-0.4.3.0-inplace/Reanimate.Svg.hs.html +++ b/reanimate-0.4.3.0-inplace/Reanimate.Svg.hs.html @@ -53,7 +53,7 @@ span.spaces { background: white } 34 -- width is affected by directly applying scaling. 35 -- 36 -- @lowerTransformations (scale 2 (mkCircle 1)) = mkCircle 2@ - 37 lowerTransformations :: Tree -> Tree + 37 lowerTransformations :: SVG -> SVG 38 lowerTransformations = worker False Transform.identity 39 where 40 updLineCmd m cmd = @@ -89,7 +89,7 @@ span.spaces { background: white } 70 _ -> worker True m (pathify t) 71 72 -- | Remove all @id@ attributes. - 73 lowerIds :: Tree -> Tree + 73 lowerIds :: SVG -> SVG 74 lowerIds = mapTree worker 75 where 76 worker t@GroupTree{} = t & attrId .~ Nothing @@ -97,7 +97,7 @@ span.spaces { background: white } 78 worker t = t 79 80 -- | Optimize SVG tree without affecting how it is rendered. - 81 simplify :: Tree -> Tree + 81 simplify :: SVG -> SVG 82 simplify root = 83 case worker root of 84 [] -> None @@ -129,7 +129,7 @@ span.spaces { background: white } 110 -- @removeGroups (withFillColor "blue" $ mkGroup [mkCircle 1, mkRect 1 1]) 111 -- = [ withFillColor "blue" $ mkCircle 1 112 -- , withFillColor "blue" $ mkRect 1 1 ]@ - 113 removeGroups :: Tree -> [Tree] + 113 removeGroups :: SVG -> [SVG] 114 removeGroups = worker defaultSvg 115 where 116 worker _attr None = [] @@ -152,7 +152,7 @@ span.spaces { background: white } 133 dropNulls t = [t] 134 135 -- | Extract all path commands from a node (and its children) and concatenate them. - 136 extractPath :: Tree -> [PathCommand] + 136 extractPath :: SVG -> [PathCommand] 137 extractPath = worker . simplify . lowerTransformations . pathify 138 where 139 worker (GroupTree g) = concatMap worker (g^.groupChildren) @@ -163,7 +163,7 @@ span.spaces { background: white } 144 -- 145 -- @withSubglyphs [0,2] (scale 2) (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2]) 146 -- = mkGroup [scale 2 (mkCircle 1), mkRect 2, scale 2 (mkEllipse 1 2)]@ - 147 withSubglyphs :: [Int] -> (Tree -> Tree) -> Tree -> Tree + 147 withSubglyphs :: [Int] -> (SVG -> SVG) -> SVG -> SVG 148 withSubglyphs target fn = \t -> evalState (worker t) 0 149 where 150 worker :: Tree -> State Int Tree @@ -191,18 +191,18 @@ span.spaces { background: white } 172 -- 173 -- @splitGlyphs [0,2] (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2]) 174 -- = ([mkRect 2], [mkCircle 1, mkEllipse 1 2])@ - 175 splitGlyphs :: [Int] -> Tree -> (Tree, Tree) + 175 splitGlyphs :: [Int] -> SVG -> (SVG, SVG) 176 splitGlyphs target = \t -> 177 let (_, l, r) = execState (worker id t) (0, [], []) 178 in (mkGroup l, mkGroup r) 179 where - 180 handleGlyph :: Tree -> State (Int, [Tree], [Tree]) () + 180 handleGlyph :: SVG -> State (Int, [SVG], [SVG]) () 181 handleGlyph t = do 182 (n, l, r) <- get 183 if n `elem` target 184 then put (n+1, l, t:r) 185 else put (n+1, t:l, r) - 186 worker :: (Tree -> Tree) -> Tree -> State (Int, [Tree], [Tree]) () + 186 worker :: (SVG -> SVG) -> SVG -> State (Int, [SVG], [SVG]) () 187 worker acc t = 188 case t of 189 GroupTree g -> do @@ -232,7 +232,7 @@ span.spaces { background: white } 213 , (\svg -> <g transform="translate(10,10)"><g transform="scale(0.5)">svg</g></g>, <rect/>)] 214 -} 215 -- | Split symbols and include their context and drawing attributes. - 216 svgGlyphs :: Tree -> [(Tree -> Tree, DrawAttributes, Tree)] + 216 svgGlyphs :: SVG -> [(SVG -> SVG, DrawAttributes, SVG)] 217 svgGlyphs = worker id defaultSvg 218 where 219 worker acc attr = @@ -262,7 +262,7 @@ span.spaces { background: white } 243 244 <<docs/gifs/doc_pathify.gif>> 245 -} - 246 pathify :: Tree -> Tree + 246 pathify :: SVG -> SVG 247 pathify = mapTree worker 248 where 249 worker =