reanimate 0.5.0.1 → 1.0.0.0

raw patch · 69 files changed

+544/−407 lines, 69 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−1
• docs/gifs/doc_oGrow.gif binary
• docs/gifs/doc_oHideWith.gif binary
• examples/bug_play1.hs +1/−1
• examples/bug_play2.hs +1/−1
• examples/bug_play3.hs +1/−1
• examples/bug_quad.hs +1/−1
• examples/demo_stars.hs +1/−1
• examples/doc_applyVar.hs +1/−1
• examples/doc_cameraAttach.hs +1/−1
• examples/doc_cameraFocus.hs +6/−5
• examples/doc_destroySprite.hs +1/−1
• examples/doc_fork.hs +1/−1
• examples/doc_newSprite.hs +1/−1
• examples/doc_newSpriteA'.hs +1/−1
• examples/doc_newSpriteA.hs +1/−1
• examples/doc_newSpriteSVG.hs +1/−1
• examples/doc_oDraw.hs +0/−2
• examples/doc_oGrow.hs +15/−0
• examples/doc_play.hs +1/−1
• examples/doc_queryNow.hs +1/−1
• examples/doc_simpleVar.hs +1/−1
• examples/doc_spriteE.hs +1/−1
• examples/doc_spriteMap.hs +1/−1
• examples/doc_spriteScope.hs +1/−1
• examples/doc_spriteTween.hs +1/−1
• examples/doc_spriteVar.hs +1/−1
• examples/doc_spriteZ.hs +1/−1
• examples/doc_unVar.hs +1/−1
• examples/doc_wait.hs +1/−1
• examples/doc_waitOn.hs +1/−1
• examples/doc_writeVar.hs +1/−1
• examples/fe_bleed.hs +1/−1
• examples/fe_morph.hs +1/−1
• examples/intro_canvas.hs +1/−1
• examples/intro_canvas_square.hs +1/−1
• examples/knock_knock.hs +1/−1
• examples/latex_wheel.hs +1/−1
• examples/morphology_closest.hs +1/−1
• examples/morphology_color.hs +1/−1
• examples/morphology_intro.hs +1/−1
• examples/morphology_linear.hs +1/−1
• examples/morphology_object_correspondence.hs +1/−1
• examples/morphology_point_correspondence.hs +1/−1
• examples/morphology_rotational.hs +1/−1
• examples/morphology_rotational_intro.hs +1/−1
• examples/scene_camera.hs +3/−94
• examples/tut_eq_final.hs +114/−0
• examples/tut_glue_blender.hs +3/−3
• examples/tut_glue_fourier.hs +1/−1
• examples/tut_glue_keyframe.hs +1/−1
• examples/tut_glue_latex.hs +2/−2
• examples/tut_glue_potrace.hs +1/−1
• examples/tut_glue_povray.hs +3/−3
• examples/tut_glue_povray_ortho.hs +3/−3
• examples/voice_advanced.hs +1/−1
• examples/voice_fake.hs +1/−1
• examples/voice_transcript.hs +1/−1
• examples/voice_triggers.hs +1/−1
• reanimate.cabal +1/−1
• src/Reanimate.hs +1/−1
• src/Reanimate/GeoProjection.hs +5/−5
• src/Reanimate/Render.hs +1/−1
• src/Reanimate/Scene.hs +7/−11
• src/Reanimate/Scene/Core.hs +10/−13
• src/Reanimate/Scene/Object.hs +114/−33
• src/Reanimate/Scene/Sprite.hs +27/−27
• src/Reanimate/Scene/Var.hs +5/−6
• src/Reanimate/Svg/LineCommand.hs +162/−149

@@ -6,6 +6,20 @@ project adheres to the [Haskell Package Versioning Policy (PVP)](https://pvp.haskell.org) +## 1.0.0.0 -- 2020-09-20++### Changed++ * Objects: Use Linear.V2 instead of tuples.+ * Reanimate.Scene.sceneAnimation -> Reanimate.Scene.scene++### Other/Non-visible++ * Improved object documentation.+ * CI stability improvements.+ * Add interactive tutorial.+ * Minor playground improvements.+ ## 0.5.0.0 -- 2020-09-09  ### Added@@ -14,7 +28,7 @@  ### Changed -* Improve efficiency of time variables (thanks to ).+* Improve efficiency of time variables (thanks to Shaurya Gupta). * Major refactoring of SVG interface. * Haddock improvements. * Improve consistency of object bounding-box calculations.

binary file changed (absent → 68106 bytes)

binary file changed (absent → 53397 bytes)

@@ -6,6 +6,6 @@  -- This should give circle. main :: IO ()-main = reanimate $ signalA (constantS 0) $ sceneAnimation $ do+main = reanimate $ signalA (constantS 0) $ scene $ do   play $ animate $ const $ mkCircle 1   play $ animate $ const $ mkRect 1 1

@@ -6,6 +6,6 @@  -- This should give rect. main :: IO ()-main = reanimate $ signalA (constantS 0.5) $ sceneAnimation $ do+main = reanimate $ signalA (constantS 0.5) $ scene $ do   play $ animate $ const $ mkCircle 1   play $ animate $ const $ mkRect 1 1

@@ -6,6 +6,6 @@  -- This should give rect. main :: IO ()-main = reanimate $ signalA (constantS 1) $ sceneAnimation $ do+main = reanimate $ signalA (constantS 1) $ scene $ do   play $ animate $ const $ mkCircle 1   play $ animate $ const $ mkRect 1 1

@@ -8,7 +8,7 @@ import Reanimate.Morph.Linear  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do     play $ animate $ \t -> morph rawLinear src dst t   where     src = mkPathString "M 0 0 q 1 1, 2 0 z"

@@ -23,7 +23,7 @@ import qualified Data.Vector                   as V  main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do   newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor   play $ trails 0.05 starAnimation 

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   s <- fork $ newSpriteA drawBox   v <- newVar 0   applyVar v s rotate

@@ -8,7 +8,7 @@ import Control.Lens  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   cam <- newObject Camera   circ <- newObject $ Circle 2   oModifyS circ $

@@ -6,20 +6,21 @@ import Reanimate.Builtin.Documentation import Reanimate.Scene import Control.Lens+import Linear.V2  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   cam <- newObject Camera   circ <- newObject $ Circle 2; oShow circ-  oModify circ $ oTranslate .~ (-3,0)+  oModify circ $ oTranslate .~ V2 (-3) 0   box <- newObject $ Rectangle 4 4; oShow box-  oModify box $ oTranslate .~ (3,0)+  oModify box $ oTranslate .~ V2 3 0    cameraAttach cam circ   cameraAttach cam box-  cameraFocus cam (-3,0)+  cameraFocus cam (V2 (-3) 0)   cameraZoom cam 2 2   cameraZoom cam 2 1-  cameraFocus cam (3,0)+  cameraFocus cam (V2 3 0)   cameraZoom cam 2 2   cameraZoom cam 2 1

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   s <- newSpriteSVG $ withFillOpacity 1 $ mkCircle 1   fork $ wait 1 >> destroySprite s   play drawBox

@@ -6,6 +6,6 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   fork $ play drawBox   play drawCircle

@@ -6,6 +6,6 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   _ <- newSprite $ mkCircle <$> spriteT -- Circle sprite where radius=time.   wait 2

@@ -7,7 +7,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   _ <- fork $ newSpriteA' SyncFreeze drawCircle   play drawBox   play $ reverseA drawBox

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   _ <- fork $ newSpriteA drawCircle   play drawBox   play $ reverseA drawBox

@@ -6,6 +6,6 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   _ <- newSpriteSVG $ mkBackground "lightblue"   play drawCircle

@@ -9,8 +9,6 @@ import Control.Lens  main :: IO ()--- main = reanimate $ docEnv $ oDraw $---   withFillOpacity 1 $ withStrokeWidth (defaultStrokeWidth*0) $ center $ scale 2 $ latex "oDraw" main = reanimate $ docEnv $ scene $ do   txt <- oNew $ withStrokeWidth 0 $ withFillOpacity 1 $     center $ scale 4 $ latex "oDraw"

@@ -0,0 +1,15 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+{-# LANGUAGE OverloadedStrings #-}+module Main(main) where++import Reanimate+import Reanimate.Scene+import Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ scene $ do+  txt <- oNew $ withStrokeWidth 0 $ withFillOpacity 1 $+    center $ scale 3 $ latex "oGrow"+  oShowWith txt oGrow+  wait 1; oHideWith txt oFadeOut

@@ -6,6 +6,6 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   play drawBox   play drawCircle

@@ -8,7 +8,7 @@ import qualified Data.Text as T  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do     now <- play drawCircle *> queryNow     play $ staticFrame 1 $ scale 2 $ withStrokeWidth 0.05 $       mkText $ "Now=" <> T.pack (show now)

@@ -6,6 +6,6 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   var <- simpleVar mkCircle 0   tweenVar var 2 $ \val -> fromToS val (screenHeight/2)

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   s <- fork $ newSpriteA drawCircle   spriteE s $ overBeginning 1 fadeInE   spriteE s $ overEnding 0.5 fadeOutE

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   s <- fork $ newSpriteA drawCircle   wait 1   spriteMap s flipYAxis

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   -- the rect lives through the entire 3s animation   newSpriteSVG_ $ translate (-3) 0 $ mkRect 4 4   wait 1

@@ -6,6 +6,6 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   s <- fork $ newSpriteA drawCircle   spriteTween s 1 $ \val -> translate (screenWidth*0.3*val) 0

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   s <- fork $ newSpriteA drawBox   v <- spriteVar s 0 rotate   tweenVar v 2 $ \val -> fromToS val 90

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   s1 <- newSpriteSVG $ withFillOpacity 1 $ withFillColor "blue" $ mkCircle 3   _ <- newSpriteSVG $ withFillOpacity 1 $ withFillColor "red" $ mkRect 8 3   wait 1

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   v <- newVar 0   _ <- newSprite $ mkCircle <$> unVar v   tweenVar v 1 $ \val -> fromToS val 3

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   fork $ play drawBox   wait 1   play drawCircle

@@ -6,6 +6,6 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   waitOn $ fork $ play drawBox   play drawCircle

@@ -6,7 +6,7 @@ import Reanimate.Builtin.Documentation  main :: IO ()-main = reanimate $ docEnv $ sceneAnimation $ do+main = reanimate $ docEnv $ scene $ do   v <- newVar 0   _ <- newSprite $ mkCircle <$> unVar v   writeVar v 1; wait 1

@@ -61,7 +61,7 @@   scaleToHeight screenHeight $ center $ unpackImage githubIcon  main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do     newSpriteSVG_ $ mkBackground "white"     -- newSpriteSVG_ $     --   mkClipPath "clip" $

@@ -22,7 +22,7 @@ import           Reanimate  main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do     newSpriteSVG_ $ mkBackground "white"     let circles =           [ (900, 0.3)

@@ -18,7 +18,7 @@ import           Text.Printf  main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do   newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor   newSpriteSVG_ static   dotPath  <- newVar (QuadBezier (V2 0 0) (V2 0 0) (V2 0 0))

@@ -22,7 +22,7 @@ newHeight = 8  main :: IO ()-main = reanimate $ mapA squareViewBox $ sceneAnimation $ do+main = reanimate $ mapA squareViewBox $ scene $ do   newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor   newSpriteSVG_ static   dotPath  <- newVar (QuadBezier (V2 0 0) (V2 0 0) (V2 0 0))

@@ -12,7 +12,7 @@ import           Reanimate.Scene  main :: IO ()-main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do+main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ scene $ do   line1 <- newLaTeX ["$>$ ", "knock!", " ", "knock!"]   oModifyMany line1 $     oTopY .~ screenTop

@@ -15,7 +15,7 @@     bg = animate $ const $ mkBackground "black"  mainScene :: Animation-mainScene = sceneAnimation $ mdo+mainScene = scene $ mdo     play $ drawCircle       & setDuration drawCircleT       & applyE (constE $ scaleXY (-1) 1)

@@ -23,7 +23,7 @@   mapA (withStrokeColor "black") $   mapA (withStrokeLineJoin JoinRound) $   mapA (withFillOpacity 1) $-    sceneAnimation $ do+    scene $ do       _ <- newSpriteSVG $         withStrokeWidth 0 $ translate (-4) 4 $         center $ latex "no-op"

@@ -19,7 +19,7 @@   setDuration 5 $   mapA (withStrokeWidth 0) $   mapA (withFillOpacity 1) $-    sceneAnimation $ do+    scene $ do       doMorph yellow blue       doMorph blue yellow   where

@@ -19,7 +19,7 @@   mapA (withStrokeWidth 0) $   mapA (withStrokeColor "black") $   mapA (withFillOpacity 1) $-    sceneAnimation $ do+    scene $ do       play $ step stage1 stage2       play $ step stage2 stage3       play $ step stage3 stage4

@@ -22,7 +22,7 @@   mapA (withStrokeColor "black") $   mapA (withStrokeLineJoin JoinRound) $   mapA (withFillOpacity 1) $-    sceneAnimation $+    scene $       showPair (stages ++ take 1 stages)   where     showPair (from:to:rest) =

@@ -19,7 +19,7 @@   mapA (withStrokeWidth 0) $   mapA (withStrokeColor "black") $   mapA (withFillOpacity 1) $-    sceneAnimation $ do+    scene $ do       let showLabel label = do             fork $ play $ staticFrame 4 (center $ latex label)               & mapA (translate 0 4)

@@ -26,7 +26,7 @@   mapA (withStrokeWidth 0) $   mapA (withStrokeColor "black") $   mapA (withFillOpacity 1) $-    sceneAnimation $ do+    scene $ do       let pl1 = translate (-4) 0 $ mkGroup             [ lowerTransformations $ scale 3 $ withFillOpacity 1 $               withStrokeColor "black" $

@@ -24,7 +24,7 @@   mapA (withStrokeColor "black") $   mapA (withStrokeLineJoin JoinRound) $   mapA (withFillOpacity 1) $-    sceneAnimation $ do+    scene $ do       _ <- newSpriteSVG $         withStrokeWidth 0 $ translate (-3) 4 $         center $ latex "linear"

@@ -43,7 +43,7 @@   mapA (withStrokeColor "black") $   mapA (withStrokeLineJoin JoinRound) $   mapA (withFillOpacity 1) $-    sceneAnimation $ do+    scene $ do       _ <- newSpriteSVG $         withStrokeWidth 0 $ translate (-4) 4 $         center $ latex "linear"

@@ -7,101 +7,10 @@ import Reanimate.Builtin.Documentation import Reanimate.Scene import Control.Lens+import Linear.V2  main :: IO ()-{--main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do-  cam <- newObject Camera--  newSpriteSVG_ $ withStrokeWidth (defaultStrokeWidth*0.5) $ mkGroup-    [ mkLine (0, screenBottom) (0, screenTop)-    , mkLine (screenLeft, 0) (screenRight, 0)-    ]--  box <- newObject $ Rectangle 1 1-  cameraAttach cam box-  oModify box $ oContext .~ withFillColor "green"-  oModify box $ oMargin .~ (0,0,0,0)-  oModify box $ oLeftX .~ 0-  oModify box $ oBottomY .~ 0-  oModify box $ oContext .~ withStrokeWidth 0--  box2 <- newObject $ Rectangle 1 1-  cameraAttach cam box2-  oModify box2 $ oContext .~ withFillColor "blue"-  oModify box2 $ oMargin .~ (0,0,0,0)-  oModify box2 $ oCenterXY .~ (-2,2)-  oModify box2 $ oContext .~ withStrokeWidth 0--  dot <- newObject $ Circle 0.05-  cameraAttach cam dot-  oModify dot $ oContext .~ withFillColor "red"-  oModify dot $ oMargin .~ (0,0,0,0)-  oModify dot $ oCenterXY .~ (0.5,0.5)-  oModify dot $ oContext .~ withStrokeWidth 0--  dot2 <- newObject $ Circle 0.05-  cameraAttach cam dot2-  oModify dot2 $ oContext .~ withFillColor "red"-  oModify dot2 $ oMargin .~ (0,0,0,0)-  oModify dot2 $ oCenterXY .~ (-2,2)-  oModify dot2 $ oContext .~ withStrokeWidth 0-  -  oShow box-  oShow box2-  oShow dot-  oShow dot2--  wait 1--  cameraSetFocus cam (0.5, 0.5)-  waitOn $ do-    fork $ cameraPan cam 1 (0.5, 0.5)-    fork $ cameraZoom cam 1 2-  wait 1-  cameraSetFocus cam (-2,2)-  cameraZoom cam 0.5 1.5-  cameraZoom cam 0.5 2-  wait 1-  -- cameraSetFocus cam (-0.5,0.5)-  waitOn $ do-    fork $ cameraPan cam 1 (-2, 2)-    fork $ cameraZoom cam 1 0.5-  -- oTweenS cam 2 $ \t -> do-  --   oScale %= \v -> fromToS v 3 t-  -  -- cameraSetFocus cam (0.5,0.5)-  -  -- oTweenS cam 1 $ \t -> do-  --   oScale %= \v -> fromToS v 1 t-  -- wait 4-  -- oTweenS cam 2 $ \t -> do-  --   oScaleOrigin .= (fromToS 0.5 (-2) t, fromToS 0.5 2 t)-  --   oScale .= fromToS 2 1 t-  --   oTranslate . _1 %= \v -> fromToS v (-2) t-  --   oTranslate . _2 %= \v -> fromToS v 2 t-  {--    Origin: (-2,2)-    Translate: (3, -1)-    New origin: (0.5, 0.5)--    (0.5, 0.5)-    (0.5+2, 0.5-2)-    (2.5, -1.5)      origin move-    (2.5*3, -1.5*3)-    (7.5, -4.5)      scale-    (7.5-2, -4.5+2)-    (5.5, -2.5)      origin move back-    (5.5-3, -2.5+1)-    (2.5, -1.5)      translate--    (0.5-2.5, 0.5-(-1.5))-    (-2, 2)-  -}--  wait 1--}-main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do+main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ scene $ do   cam <- newObject Camera    txt <- newObject $ center $ latex "Fixed (non-cam)"@@ -141,4 +50,4 @@   waitOn $ do     fork $ cameraZoom cam 3 1   waitOn $ do-    fork $ cameraPan cam 1 (0,0)+    fork $ cameraPan cam 1 (V2 0 0)

@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Lens+import Control.Monad+import Reanimate+import Reanimate.Scene++main :: IO ()+main = reanimate animation++animation :: Animation+animation = env $+  scene $ do+    symbols <-+      mapM+        oNew+        [symb_e, symb_eq, symb_m, symb_c2]+    mapM_ oShow symbols+    wait 1++    forM_ (zip symbols yPositions) $+      \(obj, yPos) -> do+        fork $+          oTweenS obj 1 $ \t -> do+            oScale %= \origin -> fromToS origin scaleFactor t+            oLeftX %= \origin -> fromToS origin screenLeft t+            oCenterY %= \origin -> fromToS origin yPos t+        wait 0.3++    wait 1++    ls <- mapM oNew [energy, equals, mass, speedOfLight]++    -- Maybe show lines with the same center as the symbols.+    -- Then show how to align the baselines.+    forM_ (zip ls yPositions) $+      \(obj, nth) -> do+        --bot <- oRead (symbols!!nth) oBottomY+        --margin <- oRead (symbols!!nth) oMarginBottom+        oModifyS obj $ do+          oLeftX .= -4+          --oTranslateY .= bot+margin+          oCenterY .= nth+        oShowWith obj oDraw++    wait 2++    forM_ ls $ \obj ->+      fork $ oHideWith obj oFadeOut++    forM_ (reverse symbols) $ \obj -> do+      fork $+        oTweenS obj 1 $ \t -> do+          oScale %= \origin -> fromToS origin 1 t+          (oTranslate . _1) %= \pos -> fromToS pos 0 t+          (oTranslate . _2) %= \pos -> fromToS pos 0 t+      wait 0.3+    wait 2++scaleFactor :: Double+scaleFactor = 0.7++symb_e :: SVG+symb_e = snd $ splitGlyphs [0] svg++symb_eq :: SVG+symb_eq = snd $ splitGlyphs [1] svg++symb_m :: SVG+symb_m = snd $ splitGlyphs [2] svg++symb_c2 :: SVG+symb_c2 = snd $ splitGlyphs [3, 4] svg++svg :: SVG+svg =+  scale 3 $+    center $+      latexAlign "E = mc^2"++energy :: SVG+energy =+  scale 1.5 $+    centerX $+      latex "Energy"++equals :: SVG+equals =+  scale 1.5 $+    centerX $+      latex "equals"++mass :: SVG+mass =+  scale 1.5 $+    centerX $+      latex "mass times"++speedOfLight :: SVG+speedOfLight =+  scale 1.5 $+    centerX $+      latex "speed of light$^2$"++yPositions :: [Double]+yPositions = [3, 1, -1, -3]++env :: Animation -> Animation+env =+  addStatic (mkBackground "lightblue")+    . mapA (withStrokeWidth defaultStrokeWidth)+    . mapA (withStrokeColor "black")

@@ -22,7 +22,7 @@ -- spritePercent = (/) <$> spriteT <*> spriteDur  main :: IO ()-main = seq texture $ reanimate $ pauseAtEnd 1 $ addStatic bg $ sceneAnimation $ do+main = seq texture $ reanimate $ pauseAtEnd 1 $ addStatic bg $ scene $ do     bend <- newVar 0     trans <- newVar 0     rotX <- newVar 0@@ -200,7 +200,7 @@   latexExample :: Animation-latexExample = sceneAnimation $ do+latexExample = scene $ do     -- Draw equation     play $ drawAnimation strokedSvg     sprites <- forM glyphs $ \(fn, _, elt) ->@@ -250,7 +250,7 @@ drawAnimation = drawAnimation' Nothing 0.5 0.3  drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation-drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do+drawAnimation' mbSeed fillDur step svg = scene $ do   forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do     let sWidth =           case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of

@@ -12,7 +12,7 @@  -- layer 3 main :: IO ()-main = reanimate $ setDuration 30 $ sceneAnimation $ do+main = reanimate $ setDuration 30 $ scene $ do     _ <- newSpriteSVG $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)     play $ fourierA (fromToS 0 5)      -- Rotate 15 times       & setDuration 50

@@ -21,7 +21,7 @@     bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)  mainScene :: Animation-mainScene = sceneAnimation $ mdo+mainScene = scene $ mdo     play $ drawCircle       & setDuration drawCircleT       & applyE (constE flipXAxis)

@@ -22,7 +22,7 @@     bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)  latexExample :: Animation-latexExample = sceneAnimation $ do+latexExample = scene $ do     -- Draw equation     play $ drawAnimation strokedSvg     sprites <- forM glyphs $ \(fn, _, elt) ->@@ -72,7 +72,7 @@ drawAnimation = drawAnimation' Nothing 0.5 0.3  drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation-drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do+drawAnimation' mbSeed fillDur step svg = scene $ do   forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do     let sWidth =           case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of

@@ -15,7 +15,7 @@ import           NeatInterpolation  main :: IO ()-main = reanimate $ parA bg $ sceneAnimation $ do+main = reanimate $ parA bg $ scene $ do     play $ mkAnimation drawDuration $ \t -> partialSvg t (wireframe (-45) 220)     xRot <- newVar (-45)     yRot <- newVar 220

@@ -23,7 +23,7 @@   main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do     newSpriteSVG $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF     zPos <- newVar 0     xRot <- newVar 0@@ -93,7 +93,7 @@   latexExample :: Animation-latexExample = sceneAnimation $ do+latexExample = scene $ do     -- Draw equation     play $ drawAnimation strokedSvg     sprites <- forM glyphs $ \(fn, _, elt) ->@@ -143,7 +143,7 @@ drawAnimation = drawAnimation' Nothing 0.5 0.3  drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation-drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do+drawAnimation' mbSeed fillDur step svg = scene $ do   forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do     let sWidth =           case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of

@@ -23,7 +23,7 @@   main :: IO ()-main = reanimate $ parA bg $ sceneAnimation $ do+main = reanimate $ parA bg $ scene $ do     xRot <- newVar (-30)     yRot <- newVar 180     zRot <- newVar 0@@ -131,7 +131,7 @@   latexExample :: Animation-latexExample = sceneAnimation $ do+latexExample = scene $ do     -- Draw equation     play $ drawAnimation strokedSvg     sprites <- forM glyphs $ \(fn, _, elt) ->@@ -181,7 +181,7 @@ drawAnimation = drawAnimation' Nothing 0.5 0.3  drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation-drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do+drawAnimation' mbSeed fillDur step svg = scene $ do   forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do     let sWidth =           case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of

@@ -19,7 +19,7 @@ transcript = loadTranscript "voice_advanced.txt"  main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do   bg <- newSpriteSVG $ mkBackgroundPixel rtfdBackgroundColor   spriteZ bg (-100)   newSpriteSVG_ $ mkGroup

@@ -21,7 +21,7 @@     \during development"  main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do   newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor   waitOn $ forM_ (splitTranscript transcript) $ \(svg, tword) -> do     highlighted <- newVar 0

@@ -15,7 +15,7 @@ transcript = loadTranscript "voice_transcript.txt"  main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do   newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor   waitOn $ forM_ (splitTranscript transcript) $ \(svg, tword) -> fork $ do     let render v = centerUsing (latex $ transcriptText transcript) $ masked

@@ -20,7 +20,7 @@   translate (-4) 0 . centerUsing (latex $ transcriptText transcript)  main :: IO ()-main = reanimate $ sceneAnimation $ do+main = reanimate $ scene $ do   newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor   waitOn $ forM_ (splitTranscript transcript) $ \(svg, tword) -> do     let render v = transformer $ masked (wordKey tword)

@@ -3,7 +3,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                reanimate-version:             0.5.0.1+version:             1.0.0.0 -- synopsis: -- description: license:             PublicDomain

@@ -77,7 +77,7 @@     -- ** Scenes     Scene   , ZIndex-  , sceneAnimation    -- :: (forall s. Scene s a) -> Animation+  , scene             -- :: (forall s. Scene s a) -> Animation   , play              -- :: Animation -> Scene s ()   , fork              -- :: Scene s a -> Scene s a   , queryNow          -- :: Scene s Time

@@ -376,7 +376,7 @@   where     forward (LonLat lam phi) =       XYCoord ((lam+pi)/tau)-        (min 1 $ max 0 $ ((log(tan(pi/4+phi/2))) + pi)/tau)+        (min 1 $ max 0 $ (log(tan(pi/4+phi/2)) + pi)/tau)     inverse (XYCoord x y) = LonLat xPi (atan (sinh yPi))       where         xPi = fromToS (-pi) pi x@@ -384,7 +384,7 @@  thetas :: V.Vector Double thetas = V.fromList $-  map (find_theta_fast . fromIndex) [0 .. granularity]+  map (findThetaFast . fromIndex) [0 .. granularity]  granularity :: Int granularity = 50000@@ -421,9 +421,9 @@         lam = pi*x/(2*sqrt2*cos theta)         phi = asin ((2*theta+sin(2*theta))/pi) -find_theta_fast :: Double -> Double-find_theta_fast !phi | abs phi == pi/2 = signum phi * halfPi-find_theta_fast (D# phi) = go phi+findThetaFast :: Double -> Double+findThetaFast !phi | abs phi == pi/2 = signum phi * halfPi+findThetaFast (D# phi) = go phi   where     !(D# pi#) = pi     go acc =

@@ -68,7 +68,7 @@         now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth         frame = frameAt (if frameCount <= 1 then 0 else now) ani         path = folder </> show nth <.> "svg"-        ~svg = renderSvg Nothing Nothing frame+        svg = renderSvg Nothing Nothing frame      idempotentFile path $       writeFile path svg

@@ -1,10 +1,3 @@-{-# LANGUAGE ApplicativeDo #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}- -- | -- Module      : Reanimate.Scene -- Copyright   : Written by David Himmelstrup@@ -19,7 +12,6 @@     Scene,     ZIndex,     scene, -- :: (forall s. Scene s a) -> Animation-    sceneAnimation, -- :: (forall s. Scene s a) -> Animation     play, -- :: Animation -> Scene s ()     fork, -- :: Scene s a -> Scene s a     queryNow, -- :: Scene s Time@@ -77,6 +69,8 @@      -- ** Object Properties     oTranslate,+    oTranslateX,+    oTranslateY,     oSVG,     oContext,     oMargin,@@ -100,29 +94,31 @@     oLeftX,     oRightX,     oCenterXY,+    oCenterX,+    oCenterY,     oValue,      -- ** Graphics object methods     oShow,     oHide,+    oShowWith,+    oHideWith,     oFadeIn,     oFadeOut,     oGrow,     oShrink,     oTransform,-    oShowWith,-    oHideWith,     Origin,     oScaleIn,     oScaleIn',     oScaleOut,     oScaleOut',+    oDraw,     oSim,     oStagger,     oStaggerRev,     oStagger',     oStaggerRev',-    oDraw,     -- , oBalloon      -- ** Pre-defined objects

@@ -43,6 +43,7 @@ instance MonadFix (Scene s) where   mfix fn = M $ \t -> mfix (\v -> let (a, _s, _p, _gens) = v in unM (fn a) t) +-- | Lift ST action into the Scene monad. liftST :: ST s a -> Scene s a liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, []) @@ -54,11 +55,7 @@  -- | Render a 'Scene' to an 'Animation'. scene :: (forall s. Scene s a) -> Animation-scene = sceneAnimation---- | Render a 'Scene' to an 'Animation'.-sceneAnimation :: (forall s. Scene s a) -> Animation-sceneAnimation action =+scene action =   runST     ( do         (_, s, p, gens) <- unM action 0@@ -82,8 +79,8 @@ --   Example: -- -- @--- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'---    'play' 'Reanimate.Builtin.Documentation.drawCircle'+-- do 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'+--    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle' -- @ -- --   <<docs/gifs/doc_fork.gif>>@@ -97,8 +94,8 @@ --   Example: -- -- @--- do now \<- 'play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow'---    'play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $+-- do now \<- 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow'+--    'Reanimate.Scene.play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $ --      'mkText' $ "Now=" <> T.pack (show now) -- @ --@@ -111,9 +108,9 @@ --   Example: -- -- @--- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'+-- do 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox' --    'wait' 1---    'play' 'Reanimate.Builtin.Documentation.drawCircle'+--    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle' -- @ -- --   <<docs/gifs/doc_wait.gif>>@@ -131,8 +128,8 @@ --   Example: -- -- @--- do 'waitOn' $ 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'---    'play' 'Reanimate.Builtin.Documentation.drawCircle'+-- do 'waitOn' $ 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'+--    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle' -- @ -- --   <<docs/gifs/doc_waitOn.gif>>

@@ -2,6 +2,8 @@ {-# LANGUAGE RecordWildCards #-} module Reanimate.Scene.Object where +import Linear.V2+import Linear.Vector import Control.Lens import Control.Monad (forM_, void) import Control.Monad.State (State, execState)@@ -46,7 +48,7 @@  -- | Container for object properties. data ObjectData a = ObjectData-  { _oTranslate :: (Double, Double),+  { _oTranslate :: V2 Double,     _oValueRef :: a,     _oSVG :: SVG,     _oContext :: SVG -> SVG,@@ -58,7 +60,7 @@     _oZIndex :: Int,     _oEasing :: Signal,     _oScale :: Double,-    _oScaleOrigin :: (Double, Double)+    _oScaleOrigin :: V2 Double   }  -- Basic lenses@@ -66,9 +68,17 @@ -- FIXME: Maybe 'position' is a better name.  -- | Object position. Default: \<0,0\>-oTranslate :: Lens' (ObjectData a) (Double, Double)+oTranslate :: Lens' (ObjectData a) (V2 Double) oTranslate = lens _oTranslate $ \obj val -> obj {_oTranslate = val} +-- | Object X position. Default: 0+oTranslateX :: Lens' (ObjectData a) Double+oTranslateX = oTranslate . _x++-- | Object Y position. Default: 0+oTranslateY :: Lens' (ObjectData a) Double+oTranslateY = oTranslate . _y+ -- | Rendered SVG node of an object. Does not include context --   or object properties. Read-only. oSVG :: Getter (ObjectData a) SVG@@ -112,7 +122,7 @@ oScale = lens _oScale $ \obj val -> oComputeBB obj {_oScale = val}  -- | Origin point for scaling. Default: \<0,0\>-oScaleOrigin :: Lens' (ObjectData a) (Double, Double)+oScaleOrigin :: Lens' (ObjectData a) (V2 Double) oScaleOrigin = lens _oScaleOrigin $ \obj val -> oComputeBB obj {_oScaleOrigin = val}  -- Smart lenses@@ -184,7 +194,7 @@       obj & (oTranslate . _1) +~ val - getter obj  -- | Derived location of an object's center point.-oCenterXY :: Lens' (ObjectData a) (Double, Double)+oCenterXY :: Lens' (ObjectData a) (V2 Double) oCenterXY = lens getter setter   where     getter obj =@@ -192,13 +202,21 @@           miny = obj ^. oBBMinY           w = obj ^. oBBWidth           h = obj ^. oBBHeight-          (dx, dy) = obj ^. oTranslate-       in (dx + minx + w / 2, dy + miny + h / 2)-    setter obj (dx, dy) =-      let (x, y) = getter obj+          V2 dx dy = obj ^. oTranslate+       in V2 (dx + minx + w / 2) (dy + miny + h / 2)+    setter obj (V2 dx dy) =+      let V2 x y = getter obj        in obj & (oTranslate . _1) +~ dx - x             & (oTranslate . _2) +~ dy - y +-- | Derived location of an object's center X value.+oCenterX :: Lens' (ObjectData a) Double+oCenterX = oCenterXY . _x++-- | Derived location of an object's center Y value.+oCenterY :: Lens' (ObjectData a) Double+oCenterY = oCenterXY . _y+ -- | Object's top margin. oMarginTop :: Lens' (ObjectData a) Double oMarginTop = oMargin . _1@@ -278,7 +296,7 @@   ref <-     newVar       ObjectData-        { _oTranslate = (0, 0),+        { _oTranslate = V2 0 0,           _oValueRef = val,           _oSVG = svg,           _oContext = id,@@ -289,14 +307,14 @@           _oZIndex = 1,           _oEasing = curveS 2,           _oScale = 1,-          _oScaleOrigin = (0, 0)+          _oScaleOrigin = V2 0 0         }   sprite <- newSprite $ do     ~obj@ObjectData {..} <- unVar ref     pure $       if _oShown         then-          uncurry translate _oTranslate $+          uncurryV2 translate _oTranslate $             oScaleApply obj $               withGroupOpacity _oOpacity $                 mkGroup [_oContext _oSVG]@@ -314,10 +332,13 @@  oScaleApply :: ObjectData a -> (SVG -> SVG) oScaleApply ObjectData {..} =-  uncurry translate (_oScaleOrigin & both %~ negate)+  uncurryV2 translate (negate _oScaleOrigin)     . scale _oScale-    . uncurry translate _oScaleOrigin+    . uncurryV2 translate _oScaleOrigin +uncurryV2 :: (a -> a -> b) -> V2 a -> b+uncurryV2 fn (V2 a b) = fn a b+ ------------------------------------------------------------------------------- -- Graphical transformations @@ -329,6 +350,10 @@ oHide :: Object s a -> Scene s () oHide o = oModify o $ oShown .~ False +-- | Show object with an animator function. The animator is responsible for+--   transitioning the object from invisible to having its final shape.+--   If this doesn't hold true for the animator function then the final+--   animation will be discontinuous. oShowWith :: Object s a -> (SVG -> Animation) -> Scene s () oShowWith o fn = do   oModify o $ oShown .~ True@@ -338,6 +363,10 @@     obj {_oSVG = getAnimationFrame SyncStretch ani t 1}   oModify o $ \obj -> obj {_oSVG = initSVG} +-- | Hide object with an animator function. The animator is responsible for+--   transitioning the object from visible to invisible.+--   If this doesn't hold true for the animator function then the final+--   animation will be discontinuous. oHideWith :: Object s a -> (SVG -> Animation) -> Scene s () oHideWith o fn = do   initSVG <- oRead o oSVG@@ -356,6 +385,17 @@ oFadeOut = reverseA . oFadeIn  -- | Scale in object over a set duration.+--+--   Example:+--+-- @+-- do txt <- 'oNew' $ 'withStrokeWidth' 0 $ 'withFillOpacity' 1 $+--      'center' $ 'scale' 3 $ 'Reanimate.LaTeX.latex' "oGrow"+--    'oShowWith' txt 'oGrow'+--    'wait' 1; 'oHideWith' txt 'oFadeOut'+-- @+--+--    <<docs/gifs/doc_oGrow.gif>> oGrow :: SVG -> Animation oGrow svg = animate $ \t -> scale t svg @@ -363,6 +403,7 @@ oShrink :: SVG -> Animation oShrink = reverseA . oGrow +-- | Relative coordinates for an SVG node. type Origin = (Double, Double)  svgOrigin :: SVG -> Origin -> (Double, Double)@@ -373,9 +414,22 @@         polyY + polyHeight * originY       ) +-- | Scale in children from left to right, with an origin at the top of each child.+--+--   Example:+--+-- @+-- do txt <- 'oNew' $ 'withStrokeWidth' 0 $ 'withFillOpacity' 1 $+--      'center' $ 'scale' 3 $ 'Reanimate.LaTeX.latex' "oScaleIn"+--    'oShowWith' txt $ 'adjustDuration' (*2) . 'oScaleIn'+--    'wait' 1; 'oHideWith' txt 'oFadeOut'+-- @+--+--   <<docs/gifs/doc_oScaleIn.gif>> oScaleIn :: SVG -> Animation oScaleIn = oScaleIn' (curveS 2) (0.5, 1) +-- | Like 'oScaleIn' but takes an easing function and an origin. oScaleIn' :: Signal -> Origin -> SVG -> Animation oScaleIn' easing origin = oStagger' 0.05 $ \svg ->   let (cx, cy) = svgOrigin svg origin@@ -388,35 +442,66 @@                 (- cy)                 svg +-- | Scale out children from left to right, with an origin at the bottom of each child.+--+--   Example:+--+-- @+-- do txt <- 'oNew' $ 'withStrokeWidth' 0 $ 'withFillOpacity' 1 $+--      'center' $ 'scale' 3 $ 'Reanimate.LaTeX.latex' "oScaleOut"+--    'oShowWith' txt 'oFadeIn'+--    'oHideWith' txt $ 'adjustDuration' (*2) . 'oScaleOut'+-- @+--+--   <<docs/gifs/doc_oScaleOut.gif>> oScaleOut :: SVG -> Animation oScaleOut = reverseA . oStaggerRev' 0.05 (oScaleIn' (curveS 2) (0.5, 0)) +-- | Like 'oScaleOut' but takes an easing function and an origin. oScaleOut' :: Signal -> Origin -> SVG -> Animation oScaleOut' easing origin = reverseA . oStaggerRev' 0.05 (oScaleIn' easing origin) +-- | Animate each child node in parallel. oSim :: (SVG -> Animation) -> SVG -> Animation oSim = oStagger' 0  -- oSim (oStagger fn) = oSim fn -- oStagger (oStagger fn) = oStagger fn+-- | Animate each child node in parallel, staggered by 0.2 seconds. oStagger :: (SVG -> Animation) -> SVG -> Animation oStagger = oStagger' 0.2 +-- | Animate each child node in parallel, staggered by 0.2 seconds and in reverse order. oStaggerRev :: (SVG -> Animation) -> SVG -> Animation oStaggerRev = oStaggerRev' 0.2 +-- | Animate each child node in parallel, staggered by a given duration. oStagger' :: Duration -> (SVG -> Animation) -> SVG -> Animation oStagger' staggerDelay fn svg = scene $   forM_ (svgGlyphs svg) $ \(ctx, _attr, node) -> do     void $ fork $ newSpriteA' SyncFreeze (fn $ ctx node)     wait staggerDelay +-- | Animate each child node in parallel, staggered by given duration and in reverse order. oStaggerRev' :: Duration -> (SVG -> Animation) -> SVG -> Animation oStaggerRev' staggerDelay fn svg = scene $   forM_ (reverse $ svgGlyphs svg) $ \(ctx, _attr, node) -> do     void $ fork $ newSpriteA' SyncFreeze (fn $ ctx node)     wait staggerDelay +-- | Render SVG by first drawing outlines and then filling shapes.+--+--   Example:+--+-- @+-- do txt <- 'oNew' $ 'withStrokeWidth' 0 $ 'withFillOpacity' 1 $+--      'center' $ 'scale' 4 $ 'Reanimate.LaTeX.latex' "oDraw"+--    'oModify' txt $ 'oEasing' .~ id+--    'oShowWith' txt 'oDraw'; 'wait' 1+--    'oHideWith' txt 'oFadeOut'+-- @+--+--   <<docs/gifs/doc_oDraw.gif>> oDraw :: SVG -> Animation oDraw = oStagger $ \svg -> scene $   forM_ (svgGlyphs $ pathify svg) $ \(ctx, attr, node) -> do@@ -463,13 +548,10 @@     oShown .= True     oEasing .= srcEase     oTranslate .= srcLoc-  fork $ oTween m d $ \t -> oTranslate %~ moveTo t dstLoc+  fork $ oTween m d $ \t -> oTranslate %~ lerp t dstLoc   oTweenV m d $ \t -> morphDelta .~ t   oModify m $ oShown .~ False   oModify dst $ oShown .~ True-  where-    moveTo t (dstX, dstY) (srcX, srcY) =-      (fromToS srcX dstX t, fromToS srcY dstY t)  ------------------------------------------------------------------------------- -- Built-in objects@@ -547,12 +629,12 @@   spriteModify (objectSprite obj) $ do     camData <- unVar (objectData cam)     return $ \(svg, zindex) ->-      let (x, y) = camData ^. oTranslate+      let V2 x y = camData ^. oTranslate           ctx =             translate (- x) (- y)-              . uncurry translate (camData ^. oScaleOrigin)+              . uncurryV2 translate (camData ^. oScaleOrigin)               . scale (camData ^. oScale)-              . uncurry translate (camData ^. oScaleOrigin & both %~ negate)+              . uncurryV2 translate (negate $ camData ^. oScaleOrigin)        in (ctx svg, zindex)  -- |@@ -576,15 +658,15 @@ -- @ -- --   <<docs/gifs/doc_cameraFocus.gif>>-cameraFocus :: Object s Camera -> (Double, Double) -> Scene s ()-cameraFocus cam (x, y) = do-  (ox, oy) <- oRead cam oScaleOrigin-  (tx, ty) <- oRead cam oTranslate+cameraFocus :: Object s Camera -> V2 Double -> Scene s ()+cameraFocus cam new = do+  origin <- oRead cam oScaleOrigin+  t <- oRead cam oTranslate   s <- oRead cam oScale-  let newLocation = (x - ((x - ox) * s + ox - tx), y - ((y - oy) * s + oy - ty))+  let newLocation = new - ((new - origin) ^* s + origin - t)   oModifyS cam $ do     oTranslate .= newLocation-    oScaleOrigin .= (x, y)+    oScaleOrigin .= new  -- | Instantaneously set camera zoom level. cameraSetZoom :: Object s Camera -> Double -> Scene s ()@@ -599,14 +681,13 @@     oScale %= \v -> fromToS v s t  -- | Instantaneously set camera location.-cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s ()+cameraSetPan :: Object s Camera -> V2 Double -> Scene s () cameraSetPan cam location =   oModifyS cam $     oTranslate .= location  -- | Change camera location over a set duration.-cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s ()-cameraPan cam d (x, y) =-  oTweenS cam d $ \t -> do-    oTranslate . _1 %= \v -> fromToS v x t-    oTranslate . _2 %= \v -> fromToS v y t+cameraPan :: Object s Camera -> Duration -> V2 Double -> Scene s ()+cameraPan cam d pos =+  oTweenS cam d $ \t ->+    oTranslate %= lerp t pos

@@ -29,7 +29,7 @@     fork,     liftST,     queryNow,-    sceneAnimation,+    scene,     wait,   ) import Reanimate.Scene.Var (unpackVar, Var (..), newVar, readVar)@@ -41,8 +41,8 @@ --   Example: -- -- @--- do var \<- 'simpleVar' 'mkCircle' 0---    'tweenVar' var 2 $ \\val -> 'fromToS' val ('Reanimate.Constants.screenHeight'/2)+-- do var \<- 'simpleVar' 'Reanimate.Svg.Constructors.mkCircle' 0+--    'Reanimate.Scene.tweenVar' var 2 $ \\val -> 'Reanimate.fromToS' val ('Reanimate.Constants.screenHeight'/2) -- @ -- --   <<docs/gifs/doc_simpleVar.gif>>@@ -98,9 +98,9 @@ -- -- @ -- do v \<- 'newVar' 0---    'newSprite' $ 'mkCircle' \<$\> 'unVar' v---    'tweenVar' v 1 $ \\val -> 'fromToS' val 3---    'tweenVar' v 1 $ \\val -> 'fromToS' val 0+--    'newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'unVar' v+--    'Reanimate.Scene.tweenVar' v 1 $ \\val -> 'Reanimate.fromToS' val 3+--    'Reanimate.Scene.tweenVar' v 1 $ \\val -> 'Reanimate.fromToS' val 0 -- @ -- --   <<docs/gifs/doc_unVar.gif>>@@ -123,7 +123,7 @@ --   Example: -- -- @--- do 'newSprite' $ 'mkCircle' \<$\> 'spriteT' -- Circle sprite where radius=time.+-- do 'newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'spriteT' -- Circle sprite where radius=time. --    'wait' 2 -- @ --@@ -169,7 +169,7 @@ -- @ -- do 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' --    'play' 'Reanimate.Builtin.Documentation.drawBox'---    'play' $ 'reverseA' 'Reanimate.Builtin.Documentation.drawBox'+--    'play' $ 'Reanimate.Animation.reverseA' 'Reanimate.Builtin.Documentation.drawBox' -- @ -- --   <<docs/gifs/doc_newSpriteA.gif>>@@ -182,9 +182,9 @@ --   Example: -- -- @--- do 'fork' $ 'newSpriteA'' 'SyncFreeze' 'Reanimate.Builtin.Documentation.drawCircle'+-- do 'fork' $ 'newSpriteA'' 'Reanimate.Animation.SyncFreeze' 'Reanimate.Builtin.Documentation.drawCircle' --    'play' 'Reanimate.Builtin.Documentation.drawBox'---    'play' $ 'reverseA' 'Reanimate.Builtin.Documentation.drawBox'+--    'play' $ 'Reanimate.Animation.reverseA' 'Reanimate.Builtin.Documentation.drawBox' -- @ -- --   <<docs/gifs/doc_newSpriteA'.gif>>@@ -198,7 +198,7 @@ --   Example: -- -- @--- do 'newSpriteSVG' $ 'mkBackground' "lightblue"+-- do 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.mkBackground' "lightblue" --    'play' 'Reanimate.Builtin.Documentation.drawCircle' -- @ --@@ -219,8 +219,8 @@ -- @ -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox' --    v \<- 'newVar' 0---    'applyVar' v s 'rotate'---    'tweenVar' v 2 $ \\val -> 'fromToS' val 90+--    'applyVar' v s 'Reanimate.Svg.Constructors.rotate'+--    'Reanimate.Scene.tweenVar' v 2 $ \\val -> 'Reanimate.fromToS' val 90 -- @ -- --   <<docs/gifs/doc_applyVar.gif>>@@ -235,7 +235,7 @@ --   Example: -- -- @--- do s <- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'mkCircle' 1+-- do s <- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.mkCircle' 1 --    'fork' $ 'wait' 1 \>\> 'destroySprite' s --    'play' 'Reanimate.Builtin.Documentation.drawBox' -- @@@ -267,7 +267,7 @@ -- @ -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle' --    'wait' 1---    'spriteMap' s 'flipYAxis'+--    'spriteMap' s 'Reanimate.Svg.Constructors.flipYAxis' -- @ -- --   <<docs/gifs/doc_spriteMap.gif>>@@ -285,7 +285,7 @@ -- -- @ -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'---    'spriteTween' s 1 $ \\val -> 'translate' ('Reanimate.Constants.screenWidth'*0.3*val) 0+--    'spriteTween' s 1 $ \\val -> 'Reanimate.Svg.Constructors.translate' ('Reanimate.Constants.screenWidth'*0.3*val) 0 -- @ -- --   <<docs/gifs/doc_spriteTween.gif>>@@ -309,8 +309,8 @@ -- -- @ -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox'---    v \<- 'spriteVar' s 0 'rotate'---    'tweenVar' v 2 $ \\val -> 'fromToS' val 90+--    v \<- 'spriteVar' s 0 'Reanimate.Svg.Constructors.rotate'+--    'Reanimate.Scene.tweenVar' v 2 $ \\val -> 'Reanimate.fromToS' val 90 -- @ -- --   <<docs/gifs/doc_spriteVar.gif>>@@ -326,8 +326,8 @@ -- -- @ -- do s <- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'---    'spriteE' s $ 'overBeginning' 1 'fadeInE'---    'spriteE' s $ 'overEnding' 0.5 'fadeOutE'+--    'spriteE' s $ 'Reanimate.Effect.overBeginning' 1 'Reanimate.Effect.fadeInE'+--    'spriteE' s $ 'Reanimate.Effect.overEnding' 0.5 'Reanimate.Effect.fadeOutE' -- @ -- --   <<docs/gifs/doc_spriteE.gif>>@@ -349,8 +349,8 @@ --   Example: -- -- @--- do s1 \<- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'withFillColor' "blue" $ 'mkCircle' 3---    'newSpriteSVG' $ 'withFillOpacity' 1 $ 'withFillColor' "red" $ 'mkRect' 8 3+-- do s1 \<- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.withFillColor' "blue" $ 'Reanimate.Svg.Constructors.mkCircle' 3+--    'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.withFillColor' "red" $ 'Reanimate.Svg.Constructors.mkRect' 8 3 --    'wait' 1 --    'spriteZ' s1 1 --    'wait' 1@@ -375,13 +375,13 @@ -- -- @ -- do -- the rect lives through the entire 3s animation---    'newSpriteSVG_' $ 'translate' (-3) 0 $ 'mkRect' 4 4+--    'newSpriteSVG_' $ 'Reanimate.Svg.Constructors.translate' (-3) 0 $ 'Reanimate.Svg.Constructors.mkRect' 4 4 --    'wait' 1 --    'spriteScope' $ do --      -- the circle only lives for 1 second.---      local \<- 'newSpriteSVG' $ 'translate' 3 0 $ 'mkCircle' 2---      'spriteE' local $ 'overBeginning' 0.3 'fadeInE'---      'spriteE' local $ 'overEnding' 0.3 'fadeOutE'+--      local \<- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.translate' 3 0 $ 'Reanimate.Svg.Constructors.mkCircle' 2+--      'spriteE' local $ 'Reanimate.Effect.overBeginning' 0.3 'Reanimate.Effect.fadeInE'+--      'spriteE' local $ 'Reanimate.Effect.overEnding' 0.3 'Reanimate.Effect.fadeOutE' --      'wait' 1 --    'wait' 1 -- @@@ -402,7 +402,7 @@ asAnimation :: (forall s'. Scene s' a) -> Scene s Animation asAnimation s = do   now <- queryNow-  return $ dropA now (sceneAnimation (wait now >> s))+  return $ dropA now (scene (wait now >> s))  -- | Apply a transformation with a given overlap. This makes sure --   to keep timestamps intact such that events can still be timed

@@ -5,7 +5,6 @@  import Control.Monad.ST (ST) import qualified Data.Map as M-import Data.Maybe (fromMaybe) import Data.STRef import Reanimate.Animation (Duration, Time) import Reanimate.Scene.Core (Scene, liftST, queryNow, wait)@@ -34,7 +33,7 @@ --   earlier than when the variable was created. For example: -- -- @--- do v \<- 'fork' ('wait' 10 \>\> 'newVar' 0) -- Create a variable at timestamp '10'.+-- do v \<- 'Reanimate.Scene.fork' ('wait' 10 \>\> 'newVar' 0) -- Create a variable at timestamp '10'. --    'readVar' v                       -- Read the variable at timestamp '0'. --                                    -- The value of the variable will be '0'. -- @@@ -54,7 +53,7 @@ -- -- @ -- do v \<- 'newVar' 0---    'newSprite' $ 'mkCircle' \<$\> 'unVar' v+--    'Reanimate.Scene.newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'Reanimate.Scene.unVar' v --    'writeVar' v 1; 'wait' 1 --    'writeVar' v 2; 'wait' 1 --    'writeVar' v 3; 'wait' 1@@ -129,7 +128,7 @@ elseVar var1 var2   | Just t <- evarLastTime var1 =     let afterTimeline = evarTimeline var1-        joinAt = fromMaybe t . fmap fst $ M.lookupMin afterTimeline+        joinAt = maybe t fst $ M.lookupMin afterTimeline         beforeTimeline = case keepBefore joinAt var2 of           x             | Just lastTime <- evarLastTime x, lastTime < joinAt -> M.insert lastTime (StaticValue $ evarLastValue x) $ evarTimeline x@@ -139,7 +138,7 @@  -- Restrict a var to a given time interval. keepInRange :: Maybe Time -> Maybe Time -> VarData a -> VarData a-keepInRange st nd = fromMaybe id (keepFrom <$> st) . fromMaybe id (keepBefore <$> nd)+keepInRange st nd = maybe id keepFrom st . maybe id keepBefore nd  -- Restrict a var to start at given timestamp. keepFrom :: Time -> VarData a -> VarData a@@ -167,4 +166,4 @@       lastTime = case lastModifier of         Just (t, TweenValue dur _) -> Just $ min nd (t + dur)         _ -> min nd <$> evarLastTime-   in VarData evarDefault timeline'' lastTime (fromMaybe evarDefault $ fmap (readVarData var) lastTime)+   in VarData evarDefault timeline'' lastTime (maybe evarDefault (readVarData var) lastTime)

@@ -1,30 +1,31 @@-{-|-Copyright   : Written by David Himmelstrup-License     : Unlicense-Maintainer  : lemmih@gmail.com-Stability   : experimental-Portability : POSIX--}+-- |+-- Copyright   : Written by David Himmelstrup+-- License     : Unlicense+-- Maintainer  : lemmih@gmail.com+-- Stability   : experimental+-- Portability : POSIX module Reanimate.Svg.LineCommand-  ( CmdM-  , LineCommand(..)-  , lineLength-  , toLineCommands-  , lineToPath-  , lineToPoints-  , partialSvg-  ) where+  ( CmdM,+    LineCommand (..),+    lineLength,+    toLineCommands,+    lineToPath,+    lineToPoints,+    partialSvg,+  )+where -import           Control.Lens              ((%~), (&), (.~))-import           Control.Monad.Fix-import           Control.Monad.State-import           Data.Functor-import qualified Data.Vector.Unboxed       as V+import Control.Lens ((%~), (&), (.~))+import Control.Monad.Fix+import Control.Monad.State+import Data.Functor+import Data.Maybe+import qualified Data.Vector.Unboxed as V import qualified Geom2D.CubicBezier.Linear as Bezier-import           Graphics.SvgTree-import           Linear.Metric-import           Linear.V2                 hiding (angle)-import           Linear.Vector+import Graphics.SvgTree+import Linear.Metric+import Linear.V2 hiding (angle)+import Linear.Vector  -- | Line command monad used for keeping track of the current location. type CmdM a = State RPoint a@@ -32,8 +33,8 @@ -- | Simplified version of a PathCommand where all points are absolute. data LineCommand   = LineMove RPoint-  -- | LineDraw RPoint-  | LineBezier [RPoint]+  | -- | LineDraw RPoint+    LineBezier [RPoint]   | LineEnd RPoint   deriving (Show) @@ -41,34 +42,34 @@ lineToPath :: [LineCommand] -> [PathCommand] lineToPath = map worker   where-    worker (LineMove p)         = MoveTo OriginAbsolute [p]+    worker (LineMove p) = MoveTo OriginAbsolute [p]     -- worker (LineDraw p)         = LineTo OriginAbsolute [p]-    worker (LineBezier [a,b,c]) = CurveTo OriginAbsolute [(a,b,c)]-    worker (LineBezier [a,b])   = QuadraticBezier OriginAbsolute [(a,b)]-    worker (LineBezier [a])     = LineTo OriginAbsolute [a]-    worker LineBezier{}         = error "Reanimate.Svg.lineToPath: invalid bezier curve"-    worker LineEnd{}            = EndPath+    worker (LineBezier [a, b, c]) = CurveTo OriginAbsolute [(a, b, c)]+    worker (LineBezier [a, b]) = QuadraticBezier OriginAbsolute [(a, b)]+    worker (LineBezier [a]) = LineTo OriginAbsolute [a]+    worker LineBezier {} = error "Reanimate.Svg.lineToPath: invalid bezier curve"+    worker LineEnd {} = EndPath  -- | Using @n@ control points, approximate the path of the curves. lineToPoints :: Int -> [LineCommand] -> [RPoint] lineToPoints nPoints cmds =-    map lineEnd lineSegments+  mapMaybe lineEnd lineSegments   where-    lineSegments = [ partialLine (fromIntegral n/ fromIntegral nPoints) cmds | n <- [0 .. nPoints-1] ]-    lineEnd [LineBezier pts] = last pts-    lineEnd (_:xs)           = lineEnd xs-    lineEnd _                = error "invalid line"+    lineSegments = [partialLine (fromIntegral n / fromIntegral nPoints) cmds | n <- [0 .. nPoints -1]]+    lineEnd [] = Nothing+    lineEnd [LineBezier pts] = Just (last pts)+    lineEnd (_ : xs) = lineEnd xs  partialLine :: Double -> [LineCommand] -> [LineCommand] partialLine alpha cmds = evalState (worker 0 cmds) zero   where     worker _d [] = pure []-    worker d (cmd:xs) = do+    worker d (cmd : xs) = do       from <- get       len <- lineLength cmd-      let frac = (targetLen-d) / len+      let frac = (targetLen - d) / len       if len == 0 || frac >= 1-        then (cmd:) <$> worker (d+len) xs+        then (cmd :) <$> worker (d + len) xs         else pure [adjustLineLength frac from cmd]     totalLen = evalState (sum <$> mapM lineLength cmds) zero     targetLen = totalLen * alpha@@ -76,51 +77,51 @@ adjustLineLength :: Double -> RPoint -> LineCommand -> LineCommand adjustLineLength alpha from cmd =   case cmd of-    LineBezier points -> LineBezier $ drop 1 $ partialBezierPoints (from:points) 0 alpha-    LineMove p        -> LineMove p+    LineBezier points -> LineBezier $ drop 1 $ partialBezierPoints (from : points) 0 alpha+    LineMove p -> LineMove p     -- LineDraw t -> LineDraw (lerp alpha t from)-    LineEnd p         -> LineBezier [lerp alpha p from]+    LineEnd p -> LineBezier [lerp alpha p from]  -- | Estimated length of all segments in a line. lineLength :: LineCommand -> CmdM Double lineLength cmd =   case cmd of-    LineMove to       -> 0 <$ put to+    LineMove to -> 0 <$ put to     -- Straight line:     LineBezier [dst] -> gets (distance dst) <* put dst     -- Some kind of curve:     LineBezier lst -> do       from <- get-      let bezier = rpointsToBezier (from:lst)+      let bezier = rpointsToBezier (from : lst)           tol = 0.0001       put (last lst)       pure $ Bezier.arcLength bezier 1 tol-    LineEnd to        -> gets (distance to) <* put to+    LineEnd to -> gets (distance to) <* put to  rpointsToBezier :: [RPoint] -> Bezier.CubicBezier Double rpointsToBezier lst =   case lst of-    [a,b]     -> Bezier.CubicBezier a a b b-    [a,b,c]   -> Bezier.quadToCubic (Bezier.QuadBezier a b c)-    [a,b,c,d] -> Bezier.CubicBezier a b c d-    _         -> error $ "rpointsToBezier: Invalid list of points: " ++ show lst+    [a, b] -> Bezier.CubicBezier a a b b+    [a, b, c] -> Bezier.quadToCubic (Bezier.QuadBezier a b c)+    [a, b, c, d] -> Bezier.CubicBezier a b c d+    _ -> error $ "rpointsToBezier: Invalid list of points: " ++ show lst  -- | Convert from path commands to line commands. toLineCommands :: [PathCommand] -> [LineCommand] toLineCommands ps = evalState (worker zero Nothing ps) zero   where     worker _startPos _mbPrevControlPt [] = pure []-    worker startPos mbPrevControlPt (cmd:cmds) = do+    worker startPos mbPrevControlPt (cmd : cmds) = do       lcmds <- toLineCommand startPos mbPrevControlPt cmd       let startPos' =             case lcmds of               [LineMove pos] -> pos-              _              -> startPos-      (lcmds++) <$> worker startPos' (cmdToControlPoint $ last lcmds) cmds+              _ -> startPos+      (lcmds ++) <$> worker startPos' (cmdToControlPoint $ last lcmds) cmds  cmdToControlPoint :: LineCommand -> Maybe RPoint cmdToControlPoint (LineBezier points) = Just (last (init points))-cmdToControlPoint _                   = Nothing+cmdToControlPoint _ = Nothing  mkStraightLine :: RPoint -> LineCommand mkStraightLine p = LineBezier [p]@@ -128,152 +129,164 @@ toLineCommand :: RPoint -> Maybe RPoint -> PathCommand -> CmdM [LineCommand] toLineCommand startPos mbPrevControlPt cmd =   case cmd of-    MoveTo OriginAbsolute []  -> pure []-    MoveTo OriginAbsolute lst -> put (last lst) *> gets (pure.LineMove)-    MoveTo OriginRelative lst -> modify (+ sum lst) *> gets (pure.LineMove)+    MoveTo OriginAbsolute [] -> pure []+    MoveTo OriginAbsolute lst -> put (last lst) *> gets (pure . LineMove)+    MoveTo OriginRelative lst -> modify (+ sum lst) *> gets (pure . LineMove)     LineTo OriginAbsolute lst -> forM lst (\to -> put to $> mkStraightLine to)-    LineTo OriginRelative lst -> forM lst (\to -> modify (+to) *> gets mkStraightLine)+    LineTo OriginRelative lst -> forM lst (\to -> modify (+ to) *> gets mkStraightLine)     HorizontalTo OriginAbsolute lst ->       forM lst $ \x -> modify (_x .~ x) *> gets mkStraightLine     HorizontalTo OriginRelative lst ->-      forM lst $ \x -> modify (_x %~ (+x)) *> gets mkStraightLine+      forM lst $ \x -> modify (_x %~ (+ x)) *> gets mkStraightLine     VerticalTo OriginAbsolute lst ->       forM lst $ \y -> modify (_y .~ y) *> gets mkStraightLine     VerticalTo OriginRelative lst ->-      forM lst $ \y -> modify (_y %~ (+y)) *> gets mkStraightLine+      forM lst $ \y -> modify (_y %~ (+ y)) *> gets mkStraightLine     CurveTo OriginAbsolute quads ->-      forM quads $ \(a,b,c) -> put c $> LineBezier [a,b,c]+      forM quads $ \(a, b, c) -> put c $> LineBezier [a, b, c]     CurveTo OriginRelative quads ->-      forM quads $ \(a,b,c) -> do-        from <- get <* modify (+c)-        pure $ LineBezier $ map (+from) [a,b,c]+      forM quads $ \(a, b, c) -> do+        from <- get <* modify (+ c)+        pure $ LineBezier $ map (+ from) [a, b, c]     SmoothCurveTo o lst -> mfix $ \result -> do       let ctrl = mbPrevControlPt : map cmdToControlPoint result-      forM (zip lst ctrl) $ \((c2,to), mbControl) -> do+      forM (zip lst ctrl) $ \((c2, to), mbControl) -> do         from <- get <* adjustPosition o to         let c1 = maybe (makeAbsolute o from c2) (mirrorPoint from) mbControl-        pure $ LineBezier [c1,makeAbsolute o from c2,makeAbsolute o from to]+        pure $ LineBezier [c1, makeAbsolute o from c2, makeAbsolute o from to]     QuadraticBezier OriginAbsolute pairs ->-      forM pairs $ \(a,b) -> put b $> LineBezier [a,b]+      forM pairs $ \(a, b) -> put b $> LineBezier [a, b]     QuadraticBezier OriginRelative pairs ->-      forM pairs $ \(a,b) -> do-        from <- get <* modify (+b)-        pure $ LineBezier $ map (+from) [a,b]+      forM pairs $ \(a, b) -> do+        from <- get <* modify (+ b)+        pure $ LineBezier $ map (+ from) [a, b]     SmoothQuadraticBezierCurveTo o lst -> mfix $ \result -> do       let ctrl = mbPrevControlPt : map cmdToControlPoint result       forM (zip lst ctrl) $ \(to, mbControl) -> do         from <- get <* adjustPosition o to         let c1 = maybe from (mirrorPoint from) mbControl-        pure $ LineBezier [c1,makeAbsolute o from to]-    EllipticalArc o points -> concat <$>-      forM points (\(rotX, rotY, angle, largeArc, sweepFlag, to) -> do-        from <- get <* adjustPosition o to-        return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to))+        pure $ LineBezier [c1, makeAbsolute o from to]+    EllipticalArc o points ->+      concat+        <$> forM+          points+          ( \(rotX, rotY, angle, largeArc, sweepFlag, to) -> do+              from <- get <* adjustPosition o to+              return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to)+          )     EndPath -> put startPos $> [LineEnd startPos]   where-    mirrorPoint c p = c*2-p-    adjustPosition OriginRelative p = modify (+p)+    mirrorPoint c p = c * 2 - p+    adjustPosition OriginRelative p = modify (+ p)     adjustPosition OriginAbsolute p = put p     makeAbsolute OriginAbsolute _from p = p-    makeAbsolute OriginRelative from p  = from+p-+    makeAbsolute OriginRelative from p = from + p  calculateVectorAngle :: Double -> Double -> Double -> Double -> Double calculateVectorAngle ux uy vx vy-    | tb >= ta-        = tb - ta-    | otherwise-        = pi * 2 - (ta - tb)-    where-        ta = atan2 uy ux-        tb = atan2 vy vx+  | tb >= ta =+    tb - ta+  | otherwise =+    pi * 2 - (ta - tb)+  where+    ta = atan2 uy ux+    tb = atan2 vy vx  -- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs {- HLINT ignore convertSvgArc -} convertSvgArc :: RPoint -> Coord -> Coord -> Coord -> Bool -> Bool -> RPoint -> [LineCommand] convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)-    | x0 == x && y0 == y-        = []-    | radiusX == 0.0 && radiusY == 0.0-        = [LineBezier [V2 x y]]-    | otherwise-        = calcSegments x0 y0 theta1' segments'-    where-        sinPhi = sin (angle * pi/180)-        cosPhi = cos (angle * pi/180)+  | x0 == x && y0 == y =+    []+  | radiusX == 0.0 && radiusY == 0.0 =+    [LineBezier [V2 x y]]+  | otherwise =+    calcSegments x0 y0 theta1' segments'+  where+    sinPhi = sin (angle * pi / 180)+    cosPhi = cos (angle * pi / 180) -        x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0-        y1dash = -sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0+    x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0+    y1dash = - sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0 -        numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash+    numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash -        s = sqrt(1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))-        rx   = if (numerator < 0.0) then (radiusX * s) else radiusX-        ry   = if (numerator < 0.0) then (radiusY * s) else radiusY-        root = if (numerator < 0.0)-                then (0.0)-                else ((if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0) *-                        sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))+    s = sqrt (1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))+    rx = if (numerator < 0.0) then (radiusX * s) else radiusX+    ry = if (numerator < 0.0) then (radiusY * s) else radiusY+    root =+      if (numerator < 0.0)+        then (0.0)+        else+          ( (if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0)+              * sqrt (numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash))+          ) -        cxdash = root * rx * y1dash / ry-        cydash = -root * ry * x1dash / rx+    cxdash = root * rx * y1dash / ry+    cydash = - root * ry * x1dash / rx -        cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0-        cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0+    cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0+    cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0 -        theta1'  = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)-        dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((-x1dash - cxdash) / rx) ((-y1dash - cydash) / ry)-        dtheta  = if (not sweepFlag && dtheta' > 0)-                    then  (dtheta' - 2 * pi)-                    else  (if (sweepFlag && dtheta' < 0) then dtheta' + 2 * pi else dtheta')+    theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)+    dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((- x1dash - cxdash) / rx) ((- y1dash - cydash) / ry)+    dtheta =+      if (not sweepFlag && dtheta' > 0)+        then (dtheta' - 2 * pi)+        else (if (sweepFlag && dtheta' < 0) then dtheta' + 2 * pi else dtheta') -        segments' = ceiling (abs (dtheta / (pi / 2.0)))-        delta = dtheta / fromInteger segments'-        t = 8.0 / 3.0 * sin(delta / 4.0) * sin(delta / 4.0) / sin(delta / 2.0)+    segments' = ceiling (abs (dtheta / (pi / 2.0)))+    delta = dtheta / fromInteger segments'+    t = 8.0 / 3.0 * sin (delta / 4.0) * sin (delta / 4.0) / sin (delta / 2.0) -        calcSegments startX startY theta1 segments-            | segments == 0-                = []-            | otherwise-                = LineBezier [ V2 (startX + dx1) (startY + dy1)-                             , V2 (endpointX + dxe) (endpointY + dye)-                             , V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)-            where-                cosTheta1 = cos theta1-                sinTheta1 = sin theta1-                theta2 = theta1 + delta-                cosTheta2 = cos theta2-                sinTheta2 = sin theta2+    calcSegments startX startY theta1 segments+      | segments == 0 =+        []+      | otherwise =+        LineBezier+          [ V2 (startX + dx1) (startY + dy1),+            V2 (endpointX + dxe) (endpointY + dye),+            V2 endpointX endpointY+          ] :+        calcSegments endpointX endpointY theta2 (segments - 1)+      where+        cosTheta1 = cos theta1+        sinTheta1 = sin theta1+        theta2 = theta1 + delta+        cosTheta2 = cos theta2+        sinTheta2 = sin theta2 -                endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx-                endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy+        endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx+        endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy -                dx1 = t * (-cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)-                dy1 = t * (-sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1)+        dx1 = t * (- cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)+        dy1 = t * (- sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1) -                dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)-                dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)+        dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)+        dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)  partialBezierPoints :: [RPoint] -> Double -> Double -> [RPoint] partialBezierPoints ps a b =   let c1 = Bezier.AnyBezier (V.fromList ps)       Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b-  in V.toList os--{- | Create an image showing portion of a path.-     Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').-     You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').--     Typical usage:+   in V.toList os -    > animate $ \t -> partialSvg t myPath--}-partialSvg :: Double -- ^ number between 0 and 1 inclusively, determining what portion of the path to show-           -> Tree -- ^ Image representing a path, of which we only want to display a portion determined by the first argument-           -> Tree+-- | Create an image showing portion of a path.+--     Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').+--     You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').+--+--     Typical usage:+--+--    > animate $ \t -> partialSvg t myPath+partialSvg ::+  -- | number between 0 and 1 inclusively, determining what portion of the path to show+  Double ->+  -- | Image representing a path, of which we only want to display a portion determined by the first argument+  Tree ->+  Tree partialSvg alpha | alpha >= 1 = id partialSvg alpha = mapTree worker   where     worker (PathTree path) =-        PathTree $ path & pathDefinition %~ lineToPath . partialLine alpha . toLineCommands+      PathTree $ path & pathDefinition %~ lineToPath . partialLine alpha . toLineCommands     worker t = t