reanimate 1.0.0.0 → 1.1.0.0

raw patch · 58 files changed

+745/−286 lines, 58 filesdep +cryptohash-sha256dep ~base64-bytestringdep ~reanimate-svgbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: cryptohash-sha256

Dependency ranges changed: base64-bytestring, reanimate-svg

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• docs/gifs/doc_calligra.gif binary
• docs/gifs/doc_chalkduster.gif binary
• docs/gifs/doc_helvet.gif binary
• docs/gifs/doc_libertine.gif binary
• docs/gifs/doc_noto.gif binary
• examples/blender_sphere.hs +5/−8
• examples/boundingbox.hs +2/−2
• examples/demo_stars.hs +1/−1
• examples/demo_tangent.hs +12/−12
• examples/doc_calligra.hs +13/−0
• examples/doc_chalkduster.hs +13/−0
• examples/doc_helvet.hs +13/−0
• examples/doc_libertine.hs +13/−0
• examples/doc_noto.hs +13/−0
• examples/doc_slideDownT.hs +1/−1
• examples/doc_slideLeftT.hs +1/−1
• examples/doc_slideUpT.hs +1/−1
• examples/fe_bleed.hs +14/−14
• examples/fe_distortion.hs +71/−0
• examples/fe_morph.hs +4/−5
• examples/fonts_latex.hs +19/−7
• examples/intro_canvas.hs +6/−6
• examples/intro_canvas_square.hs +6/−6
• examples/knock_knock.hs +1/−1
• examples/latex_draw.hs +2/−2
• examples/latex_wheel.hs +3/−3
• examples/morphology_closest.hs +2/−2
• examples/morphology_intro.hs +1/−2
• examples/morphology_linear.hs +1/−1
• examples/morphology_object_correspondence.hs +0/−1
• examples/morphology_point_correspondence.hs +1/−2
• examples/morphology_rotational.hs +2/−2
• examples/morphology_rotational_intro.hs +4/−5
• examples/raster.hs +3/−5
• examples/sorting.hs +2/−2
• examples/tut_glue_animate.hs +2/−2
• examples/tut_glue_blender.hs +4/−5
• examples/tut_glue_keyframe.hs +3/−3
• examples/tut_glue_latex.hs +5/−5
• examples/tut_glue_potrace.hs +2/−2
• examples/tut_glue_povray.hs +3/−3
• examples/tut_glue_povray_ortho.hs +6/−7
• examples/tut_glue_svg.hs +2/−2
• reanimate.cabal +6/−3
• src/Geom2D/CubicBezier/Linear.hs +0/−2
• src/Reanimate/Cache.hs +3/−5
• src/Reanimate/Driver.hs +0/−1
• src/Reanimate/External.hs +95/−0
• src/Reanimate/GeoProjection.hs +0/−1
• src/Reanimate/LaTeX.hs +266/−84
• src/Reanimate/Misc.hs +91/−58
• src/Reanimate/Morph/Cache.hs +2/−3
• src/Reanimate/Raster.hs +1/−2
• src/Reanimate/Svg.hs +7/−0
• src/Reanimate/Svg/Unuse.hs +7/−1
• test/Helpers.hs +2/−3
• test/Properties.hs +1/−2

@@ -6,6 +6,13 @@ project adheres to the [Haskell Package Versioning Policy (PVP)](https://pvp.haskell.org) +## 1.1.0.0 -- 2020-10-07++### Added++ * LaTeX font configurations.+ * SVG support for all filter effects.+ ## 1.0.0.0 -- 2020-09-20  ### Changed

binary file changed (absent → 6696 bytes)

binary file changed (absent → 6576 bytes)

binary file changed (absent → 4937 bytes)

binary file changed (absent → 5764 bytes)

binary file changed (absent → 4397 bytes)

@@ -9,12 +9,10 @@ import           Reanimate  main :: IO ()-main = reanimate $ mkAnimation 5 $ \t ->-    let s = t * pi * 2 in-    mkGroup-    [ mkBackground "black"-    , blender (script $ T.pack $ show s)-    ]+main = reanimate $ addStatic (mkBackground "black") $ mkAnimation 5 $ \t ->+    let s = t * pi * 2+    in blender (script $ T.pack $ show s)+      texture :: T.Text texture = T.pack $ svgAsPngFile (mkGroup@@ -65,8 +63,7 @@   withStrokeColor "white" $   withStrokeWidth 0.1 $   mkGroup-  [ withStrokeWidth 0 $-    withFillOpacity 0.8 $ mkBackground "blue"+  [ withFillOpacity 0.8 $ mkBackground "blue"   , mkGroup     [ translate (stepX*x-offsetX + stepX/2) 0 $       mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)

@@ -10,11 +10,11 @@ main = reanimate bbox  bbox :: Animation-bbox = bg `parA`+bbox = addStatic bg $     mapA (translate (-screenWidth/4) 0) bbox1 `parA`     mapA (translate (screenWidth/4) 0) bbox2   where-    bg = animate $ const $ mkBackground "black"+    bg = mkBackground "black"  bbox1 :: Animation bbox1 = mkAnimation 5 $ \t ->

@@ -33,7 +33,7 @@   in  withStrokeWidth 0 $ rotate (t * 360) $ mkGroup         [ translate (x / newZ) (y / newZ) $ dot (1 - newZ)         | (x, y, z) <--          reverse $ take nStars $ dropWhile (\(_, _, z) -> z < camZ) $ allStars+          reverse $ take nStars $ dropWhile (\(_, _, z) -> z < camZ) allStars         , let newZ = z - camZ         ]  where

@@ -35,33 +35,33 @@           V2 midX midY = lerp 0.5 0 normed           V2 normVectX normVectY = normalize tangent ^* (svgWidth normalTxt*1.1)           tangentSvg =-            translate (posX) (posY) $+            translate posX posY $             rotate (unangle normed/pi*180 + 180) $-            translate 0 (svgHeight tangentTxt/2) $+            translate 0 (svgHeight tangentTxt/2)             tangentTxt           normalSvg =-            translate (posX) (posY) $+            translate posX posY $             rotate (unangle normed/pi*180 + 90) $-            translate (svgWidth normalTxt/2*1.1) (svgHeight normalTxt/2*1.3) $+            translate (svgWidth normalTxt/2*1.1) (svgHeight normalTxt/2*1.3)             normalTxt       in mkGroup-      [ withStrokeWidth (defaultStrokeWidth) $+      [ withStrokeWidth defaultStrokeWidth $         withStrokeColor "black" $         translate (posX-midX) (posY-midY) $         mkLine (0, 0) (tangentX, tangentY)-      , withStrokeWidth (defaultStrokeWidth) $+      , withStrokeWidth defaultStrokeWidth $         withStrokeColor "black" $-        translate (posX) (posY) $+        translate posX posY $         mkLine (0, 0) (-normVectY, normVectX)       , withStrokeWidth (defaultStrokeWidth*2) $-        withStrokeColor "white" $+        withStrokeColor "white"         tangentSvg-      , withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0 $+      , withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0         tangentSvg       , withStrokeWidth (defaultStrokeWidth*2) $-        withStrokeColor "white" $+        withStrokeColor "white"         normalSvg-      , withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0 $+      , withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0         normalSvg       ]     worker t = t@@ -81,7 +81,7 @@         else do           let bezier = lineCommandToBezier from cmd               (pos, tangent) = evalBezierDeriv bezier frac-          pure $ (pos, tangent)+          pure (pos, tangent)     totalLen = evalState (sum <$> mapM lineLength cmds) zero     targetLen = totalLen * alpha 

@@ -0,0 +1,13 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import           Reanimate+import           Reanimate.LaTeX+import           Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ staticFrame 1 $+  center $ withStrokeWidth 0 $ withFillOpacity 1 $ scale 4 $+  latexCfg calligra "calligra"

@@ -0,0 +1,13 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import           Reanimate+import           Reanimate.LaTeX+import           Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ staticFrame 1 $+  center $ withStrokeWidth 0 $ withFillOpacity 1 $ scale 2 $+  latexCfg chalkduster "chalkduster"

@@ -0,0 +1,13 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import           Reanimate+import           Reanimate.LaTeX+import           Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ staticFrame 1 $+  center $ withStrokeWidth 0 $ withFillOpacity 1 $ scale 4 $+  latexCfg helvet "helvet"

@@ -0,0 +1,13 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import           Reanimate+import           Reanimate.LaTeX+import           Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ staticFrame 1 $+  center $ withStrokeWidth 0 $ withFillOpacity 1 $ scale 4 $+  latexCfg libertine "libertine"

@@ -0,0 +1,13 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import           Reanimate+import           Reanimate.LaTeX+import           Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ staticFrame 1 $+  center $ withStrokeWidth 0 $ withFillOpacity 1 $ scale 4 $+  latexCfg noto "noto"

@@ -11,5 +11,5 @@ main = reanimate $ docEnv $ pauseAtEnd 1 $ signalT (curveS 2) slideDownT left right   where     left = drawCircle-    right = staticFrame 1 (withFillOpacity 1 $ mkBackground "black") `parA`+    right = staticFrame 1 (mkBackground "black") `parA`             mapA (flipXAxis . withStrokeColor "white") drawCircle

@@ -11,5 +11,5 @@ main = reanimate $ docEnv $ pauseAtEnd 1 $ signalT (curveS 2) slideLeftT left right   where     left = drawCircle-    right = staticFrame 1 (withFillOpacity 1 $ mkBackground "black") `parA`+    right = staticFrame 1 (mkBackground "black") `parA`             mapA (flipXAxis . withStrokeColor "white") drawCircle

@@ -11,5 +11,5 @@ main = reanimate $ docEnv $ pauseAtEnd 1 $ signalT (curveS 2) slideUpT left right   where     left = drawCircle-    right = staticFrame 1 (withFillOpacity 1 $ mkBackground "black") `parA`+    right = staticFrame 1 (mkBackground "black") `parA`             mapA (flipXAxis . withStrokeColor "white") drawCircle

@@ -75,11 +75,11 @@     --   & maskWidth .~ Percent 2     --   & maskHeight .~ Percent 2     newSpriteSVG_ $-      FilterTree $ mkFilter ("gooey")+      FilterTree $ mkFilter "gooey"       [ FEGaussianBlur $ defaultSvg         & gaussianBlurStdDeviationX .~ Num 0.2         & gaussianBlurEdgeMode .~ EdgeNone-        & filterResult .~ Just "blur"+        & filterResult ?~ "blur"       , FEColorMatrix $ defaultSvg         & colorMatrixType .~ Matrix         & colorMatrixValues .~@@ -88,7 +88,7 @@           \0 0 1 0 0 \           \0 0 0 19 -10"         & colorMatrixIn .~ pure (SourceRef "blur")-        & filterResult .~ Just "colormatrix"+        & filterResult ?~ "colormatrix"       ]     newSprite_ $ do       t <- spriteT@@ -100,11 +100,11 @@           [ mkGroup             [ whiteGithub             , withFillColor "white" $ mkGroup-              [(translate x y $ mkCircle (r*2))+              [ translate x y $ mkCircle (r*2)               | (ang, offset, len) <- balls               , let dir = angle ang-                    r = 1 - (mod' (t/d+offset) 1)-                    V2 x y = dir ^* (screenTop * len * (mod' (t/d+offset) 1)) ]+                    r = 1 - mod' (t/d+offset) 1+                    V2 x y = dir ^* (screenTop * len * mod' (t/d+offset) 1) ]             ] & filterRef .~ pure (Ref "gooey")           , withFillColor "black" $ mkCircle (screenTop*0.99)           , whiteGithub@@ -117,15 +117,15 @@     newSpriteSVG_ $       ctx $       mkGroup [scale 2 $ mkBackground "white"]-      & maskRef .~ (pure $ Ref "clip")+      & maskRef .~ pure (Ref "clip")     newSpriteSVG_ $-      FilterTree $ mkFilter ("blur") $+      FilterTree $ mkFilter "blur"       [ FEGaussianBlur $ defaultSvg         & gaussianBlurStdDeviationX .~ Num 0.1         & gaussianBlurEdgeMode .~ EdgeNone         & filterX .~ pure (Percent 0)         & filterY .~ pure (Percent 0)-        & filterResult .~ Just "blur"+        & filterResult ?~ "blur"         & filterWidth .~ pure (Percent 1)         & filterHeight .~ pure (Percent 1)       , FETurbulence $ defaultSvg@@ -134,14 +134,14 @@         & turbulenceNumOctaves .~ 1         & turbulenceSeed .~ 1         & turbulenceStitchTiles .~ Stitch-        & filterResult .~ Just "turbulence"+        & filterResult ?~ "turbulence"       , FEDisplacementMap $ defaultSvg         & displacementMapScale .~ pure 2         & displacementMapIn .~ pure (SourceRef "blur")         & displacementMapIn2 .~ pure (SourceRef "turbulence")         & displacementMapXChannelSelector .~ ChannelR         & displacementMapYChannelSelector .~ ChannelA-        & filterResult .~ Just "displacementMap"+        & filterResult ?~ "displacementMap"       ]      -- Color wheels:@@ -149,11 +149,11 @@       fork $ play $ mkAnimation 5 $ \t' ->         let t = (t' + offset) `mod'` 1         in ctx $ mkGroup-        [ mkGroup [(rotate (fromToS 0 dst $ curveS 2 $ oscillateS $ t) $+        [ mkGroup [ rotate (fromToS 0 dst $ curveS 2 $ oscillateS t) $           rotate pos $-          withStrokeColorPixel (promotePixel color) slice)]+          withStrokeColorPixel (promotePixel color) slice]           & filterRef .~ pure (Ref "blur")-        ] & maskRef .~ (pure $ Ref "clip")+        ] & maskRef .~ pure (Ref "clip")     wait 5  slice :: SVG

@@ -0,0 +1,71 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate++{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Main (main) where++{- FE articles/demos+scatter: https://codepen.io/mullany/pen/JmgbRB+distortion: https://codepen.io/mullany/pen/BWKePz+variable stroke width: https://codepen.io/mullany/pen/qaONQm+variable stroke gradient: https://codepen.io/mullany/pen/XXBMJd+heart: https://codepen.io/yoksel/pen/MLVjoB+elastic stroke: https://codepen.io/yoksel/pen/XJbzrO+-}++import Codec.Picture.Types+import Control.Lens hiding (magma)+import qualified Data.Text as T+import Graphics.SvgTree+import Reanimate+import Text.Printf+import NeatInterpolation+import Control.Monad++main :: IO ()+main = reanimate $+  scene $ do+    newSpriteSVG_ $ mkBackground "white"+    hue <- newVar 0+    dScale <- newVar 0.2+    newSprite $+      mkDistortFilter <$> unVar hue <*> unVar dScale+    newSpriteSVG_ $ parseSvg "<circle r=\"3\" fill=\"red\" filter=\"url(#distort)\" />"+    fork $ replicateM_ 5 $ tweenVar hue 1 $ \v -> fromToS 0 360+    tweenVar dScale 1 $ \v -> fromToS v 1.0+    tweenVar dScale 1 $ \v -> fromToS v 0.2+    tweenVar dScale 1 $ \v -> fromToS v 0.5+    tweenVar dScale 1 $ \v -> fromToS v 1.0+    tweenVar dScale 1 $ \v -> fromToS v 0.2++-- wait 1++-- hue: 0 -> 360 over 1s+-- dScale: 0;20;50;0 over 5s+mkDistortFilter :: Double -> Double -> SVG+mkDistortFilter hue dScale = parseSvg [text|+  <filter id="distort">+    <feTurbulence baseFrequency="0.7" type="fractalNoise"/>+    <feColorMatrix type="hueRotate" values="${hue'}">+    </feColorMatrix>+    <feDisplacementMap in="SourceGraphic" xChannelSelector="R" yChannelSelector="B"+      scale="${dScale'}">+      </feDisplacementMap>+    <feGaussianBlur stdDeviation="0.02"/>+    <feComponentTransfer result="main">+      <feFuncA type="gamma" amplitude="1" exponent="10"/>+    </feComponentTransfer>+    <feColorMatrix type="matrix" values="0 0 0 0 0 +                                         0 0 0 0 0+                                         0 0 0 0 0+                                         0 0 0 1 0"/>+    <feGaussianBlur stdDeviation="0.2"/>+    <feComposite operator="over" in="main"/>+  </filter>+  |]+  where+    hue' = T.pack (show hue)+    dScale' = T.pack (show dScale)

@@ -2,7 +2,6 @@ -- stack runghc --package reanimate {-# LANGUAGE ApplicativeDo     #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ParallelListComp  #-} module Main(main) where  import           Text.Printf@@ -36,7 +35,7 @@       , mkGroup         [ lowerTransformations $ center $ withFillColor "black" $ latex "Text"         , mkGroup-          [rotate (t*rot) $ translate (fromToS 0 3.5 $ bellS 2 $ t) 0 $+          [rotate (t*rot) $ translate (fromToS 0 3.5 $ bellS 2 t) 0 $             withFillColorPixel (promotePixel c) $ mkCircle (size*1.5)           | (n,(rot, size)) <- zip [0..] circles           , let c = turbo (n/fromIntegral (length circles-1))@@ -48,11 +47,11 @@  mkGooeyFilter :: Double -> SVG mkGooeyFilter blur =-  FilterTree $ mkFilter ("gooey")+  FilterTree $ mkFilter "gooey"       [ FEGaussianBlur $ defaultSvg         & gaussianBlurStdDeviationX .~ Num blur         & gaussianBlurEdgeMode      .~ EdgeNone-        & filterResult              .~ Just "blur"+        & filterResult              ?~ "blur"       , FEColorMatrix $ defaultSvg         & colorMatrixType           .~ Matrix         & colorMatrixValues         .~ printf@@ -61,7 +60,7 @@           \0 0 1 0 0 \           \0 0 0 %f %f" mul sub         & colorMatrixIn             .~ pure (SourceRef "blur")-        & filterResult              .~ Just "colormatrix"+        & filterResult              ?~ "colormatrix"       ]   where     -- Increase alpha contrast. Turns alphaMin to 0x00 and alphaMax to 0xFF.

@@ -17,13 +17,25 @@     $ staticFrame 1     $ withFillColor "black"     $ withFillOpacity 1+    $ withStrokeWidth 0     $ mkGroup-        [ latex "Computer Modern"-        , translate 0    (-2)-          $ latexWithHeaders ["\\usepackage{calligra}"] "\\calligra\nGalligra"-        , translate (-6) (-2)-          $ latexWithHeaders ["\\usepackage{noto}"] "\\normalfont\nNoto"-        , translate (-6) 0-          $ latexWithHeaders ["\\usepackage{helvet}"] "Helvetica"+        [ translate (-8) 3 $ latex "Hello Computer Modern $\\frac{a}{b}$"+        , translate (-8) 2+          $ latexCfg calligra "Hello Calligra $\\frac{a}{b}$"+        , translate (-8) 1+          $ latexCfg noto "Hello Noto $\\frac{a}{b}$"+        , translate (-8) 0+          $ latexCfg helvet "Hello Helvetica $\\frac{a}{b}$"+        , translate (-8) (-1)+          $ latexCfg libertine "Hello Libertine $\\frac{a}{b}$"+        , translate (-8) (-2)+          $ latexCfg chalkduster "Hello world"+        , translate (-8) (-3)+          $ latexCfg artemisia "Hello Artemisia $\\frac{H}{b}$"         ] +artemisia :: TexConfig+artemisia = TexConfig LaTeX+  [ "\\usepackage{gfsartemisia}"+  , "\\usepackage[T1]{fontenc}"+  ] []

@@ -33,10 +33,10 @@   wait 1   moveDot (V2 0 1)    (V2 4 2)   moveDot (V2 (-1) 0) (V2 (-4) 3)-  moveDot (V2 (0) 0)  (V2 (-4) (-3))-  moveDot (V2 (0) 0)  (V2 (5) (-2))-  moveDot (V2 (6) 2)  (V2 2 1)-  moveDot (V2 (0) 0)  (V2 0 0)+  moveDot (V2 0 0)  (V2 (-4) (-3))+  moveDot (V2 0 0)  (V2 5 (-2))+  moveDot (V2 6 2)  (V2 2 1)+  moveDot (V2 0 0)  (V2 0 0)  redDot :: V2 Double -> SVG redDot (V2 x y) = translate x y $ mkGroup@@ -89,12 +89,12 @@   [ mkGroup     [ translate           0-          (i / (screenHeight) * screenHeight - screenHeight / 2 - screenHeight / 18)+          (i / screenHeight * screenHeight - screenHeight / 2 - screenHeight / 18)         $ mkLine (-screenWidth, 0) (screenWidth, 0)     | i <- [0 .. screenHeight]     ]   , mkGroup-    [ translate (i / (screenWidth) * screenWidth - screenWidth / 2) 0+    [ translate (i / screenWidth * screenWidth - screenWidth / 2) 0         $ mkLine (0, -screenHeight) (0, screenHeight)     | i <- [0 .. screenWidth]     ]

@@ -36,10 +36,10 @@         wait 1   moveDot (V2 0 1)     (V2 2 1)   moveDot (V2 (-1) 0)  (V2 (-1) 1.5)-  moveDot (V2 (0) 0)   (V2 (-2) (-3))-  moveDot (V2 (0) 0)   (V2 (2.5) (-1))-  moveDot (V2 (3) 1.5) (V2 1.5 1)-  moveDot (V2 (0) 0)   (V2 0 0)+  moveDot (V2 0 0)   (V2 (-2) (-3))+  moveDot (V2 0 0)   (V2 2.5 (-1))+  moveDot (V2 3 1.5) (V2 1.5 1)+  moveDot (V2 0 0)   (V2 0 0)  squareViewBox :: SVG -> SVG squareViewBox = withViewBox (-4, -4, 8, 8)@@ -95,12 +95,12 @@   [ mkGroup     [ translate           0-          (i / (screenHeight) * screenHeight - screenHeight / 2 - screenHeight / 18)+          (i / screenHeight * screenHeight - screenHeight / 2 - screenHeight / 18)         $ mkLine (-screenWidth, 0) (screenWidth, 0)     | i <- [0 .. screenHeight]     ]   , mkGroup-    [ translate (i / (screenWidth) * screenWidth - screenWidth / 2) 0+    [ translate (i / screenWidth * screenWidth - screenWidth / 2) 0         $ mkLine (0, -screenHeight) (0, screenHeight)     | i <- [0 .. screenWidth]     ]

@@ -58,4 +58,4 @@     oTopY .~ bBot  newLaTeX :: [Text] -> Scene s [Object s SVG]-newLaTeX chunks = mapM newObject $ map (translate (-4) 0) $ latexChunks chunks+newLaTeX chunks = mapM (newObject . translate (-4) 0) $ latexChunks chunks

@@ -7,9 +7,9 @@  main :: IO () main = reanimate $-    bg `parA` (playThenReverseA $ drawText `andThen` fillText)+    addStatic bg $ playThenReverseA $ drawText `andThen` fillText   where-    bg = animate $ const $ mkBackground "black"+    bg = mkBackground "black"     msg = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"     glyphs = withStrokeWidth 0.01 $ center $ latexAlign msg     fillText = mkAnimation 1 $ \t ->

@@ -10,9 +10,9 @@ import           Reanimate  main :: IO ()-main = reanimate $ bg `parA` mainScene+main = reanimate $ addStatic bg mainScene   where-    bg = animate $ const $ mkBackground "black"+    bg = mkBackground "black"  mainScene :: Animation mainScene = scene $ mdo@@ -76,5 +76,5 @@ drawSVG svg = animate $ \t ->     withStrokeColor "white" $     rotate (t*360) $-    translate 0 radius $+    translate 0 radius     svg

@@ -28,7 +28,7 @@         withStrokeWidth 0 $ translate (-4) 4 $         center $ latex "no-op"       _ <- newSpriteSVG $-        withStrokeWidth 0 $ translate (4) 4 $+        withStrokeWidth 0 $ translate 4 4 $         center $ latex "closest"       forM_ pairs $ uncurry showPair   where@@ -38,7 +38,7 @@           & mapA (translate (-4) (-0.5))           & signalA (curveS 4)         fork $ play $ mkAnimation 4 (morph linear from to)-          & mapA (translate (4) (-0.5))+          & mapA (translate 4 (-0.5))           & signalA (curveS 4)      pairs = zip stages (tail stages ++ [head stages])

@@ -1,7 +1,6 @@ #!/usr/bin/env stack -- stack runghc --package reanimate {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ParallelListComp  #-} module Main(main) where  import           Codec.Picture@@ -33,5 +32,5 @@     stage2 = translate 3 0 $ withFillColor "blue" $ mkRect (radius*2) (radius*2)     stage3 = mkGroup       [translate (-1) (-1) $ withFillColor "green" $ mkRect (radius*0.5) (radius*0.5)-      ,translate 1 (1) $ withFillColor "black" $ mkRect (radius*0.5) (radius*0.5) ]+      ,translate 1 1 $ withFillColor "black" $ mkRect (radius*0.5) (radius*0.5) ]     stage4 = translate (-3) 0 $ withFillColor "purple" $ mkCircle (radius*0.24)

@@ -28,7 +28,7 @@     showPair (from:to:rest) =       waitOn $ do         toS <- newSpriteSVG $-          translate (4) 0 to+          translate 4 0 to         spriteE toS $ overBeginning 0.2 fadeInE         spriteE toS $ overEnding 0.2 fadeOutE         m <- fork $ newSpriteA $ animate (morph linear from to)

@@ -1,7 +1,6 @@ #!/usr/bin/env stack -- stack runghc --package reanimate {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ParallelListComp  #-} module Main(main) where  import           Codec.Picture

@@ -1,7 +1,6 @@ #!/usr/bin/env stack -- stack runghc --package reanimate {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ParallelListComp  #-} module Main(main) where  import           Codec.Picture@@ -45,7 +44,7 @@       offset <- newVar 0       slide <- newVar 0       _ <- newSprite $ pl2 <$> unVar offset <*> unVar slide-      _ <- newSpriteSVG $ pl1+      _ <- newSpriteSVG pl1       let slideLeft = do             tweenVar slide 1 $ \v -> fromToS v 1 . curveS 4             writeVar slide 0

@@ -29,7 +29,7 @@         withStrokeWidth 0 $ translate (-3) 4 $         center $ latex "linear"       _ <- newSpriteSVG $-        withStrokeWidth 0 $ translate (3) 4 $+        withStrokeWidth 0 $ translate 3 4 $         center $ latex "rotational"       forM_ pairs $ uncurry showPair   where@@ -39,7 +39,7 @@           & mapA (translate (-3) (-0.5))           & signalA (curveS 4)         fork $ play $ mkAnimation 4 (morph myMorph from to)-          & mapA (translate (3) (-0.5))+          & mapA (translate 3 (-0.5))           & signalA (curveS 4)     myMorph = linear{morphTrajectory = rotationalTrajectory origin }     origin = (0.5, 0.5)

@@ -2,7 +2,6 @@ -- stack runghc --package reanimate {-# LANGUAGE ApplicativeDo     #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ParallelListComp  #-} module Main(main) where  import           Codec.Picture@@ -48,7 +47,7 @@         withStrokeWidth 0 $ translate (-4) 4 $         center $ latex "linear"       _ <- newSpriteSVG $-        withStrokeWidth 0 $ translate (4) 4 $+        withStrokeWidth 0 $ translate 4 4 $         center $ latex "rotational"       originVar <- newVar (0.5, 0.5) @@ -79,7 +78,7 @@       _ <- newSprite $ do             origin <- unVar originVar             pure $-              translate (4) (-0.5) $+              translate 4 (-0.5) $               genTrails (map (rotationalTrajectory origin) [(spike1, spike2)])       return ()     showPair originVar from to =@@ -99,7 +98,7 @@                 originDst = polygonOrigin to origin                 V2 originX originY = lerp localTime originDst originSrc             in-            translate (4) (-0.5) $ mkGroup+            translate 4 (-0.5) $ mkGroup             [ withFillColor "cyan" $               morph myMorph (polygonShape from) (polygonShape to) localTime             , withFillColor "red" $ translate originX originY $@@ -108,7 +107,7 @@         wait 2         destroySprite s -genTrails :: [(Double -> Polygon)] -> SVG+genTrails :: [Double -> Polygon] -> SVG genTrails plotters =     withFillOpacity 0 $     withStrokeWidth (defaultStrokeWidth*0.5) $

@@ -6,11 +6,9 @@ import           Codec.Picture  main :: IO ()-main = reanimate $ mkAnimation 5 $ \t ->-    mkGroup-      [ mkBackground "black"-      , rotate (t*360) $ scaleToWidth 6 $ embedImage img-      ]+main = reanimate $ addStatic bg $ mkAnimation 5 $ \t ->+    rotate (t*360) $ scaleToWidth 6 $ embedImage img   where+    bg = mkBackground "black"     img = generateImage pixelRenderer 255 255     pixelRenderer x y = PixelRGB8 (fromIntegral x) (fromIntegral y) 128

@@ -135,7 +135,7 @@   snapshot   len <- inputLength   let chunkSizes = takeWhile (< len) $ map (2^) [0::Int ..]-  forM_ chunkSizes $ bottomUpMergeSort'+  forM_ chunkSizes bottomUpMergeSort'  bottomUpMergeSort' :: Int -> S s () bottomUpMergeSort' chunkSize = do@@ -215,7 +215,7 @@       pivot <- readS (lo + (hi-lo) `div` 2)       p <- partition pivot lo hi       snapshot-      worker $ insertWork (lo, p) $ insertWork (p+1, hi) $ rest+      worker $ insertWork (lo, p) $ insertWork (p+1, hi) rest      partition pivot lo hi = do       loVal <- readS lo

@@ -19,13 +19,13 @@ transitionTime = 0.5  main :: IO ()-main = reanimate $ bg `parA`+main = reanimate $ addStatic bg $     chainT transition     [animateCircleR, animateCircleP, animateRectR, animateColor     ,signalA (constantS 0) $ setDuration transitionTime animateCircleR]   where     transition = overlapT transitionTime fadeT-    bg = animate $ const $ mkBackgroundPixel bgColor+    bg = mkBackgroundPixel bgColor  animateCircleR :: Animation animateCircleR = mkSegment "radius" $ \t -> mkCircle (t*2)

@@ -172,8 +172,7 @@   withStrokeColor "lightgrey" $   withStrokeWidth (defaultStrokeWidth/2) $   mkGroup-  [ withStrokeWidth 0 $-    withFillOpacity 1 $ mkBackground "darkgrey"+  [ mkBackground "darkgrey"   , mkGroup     [ translate (stepX*x-offsetX + stepX/2) 0 $       mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)@@ -207,11 +206,11 @@       newSpriteSVG $ fn elt     -- Yoink each glyph     forM_ (reverse sprites) $ \sprite -> do-      spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)+      spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)       wait 0.5     -- Flash glyphs randomly with color     forM_ (shuffleList (sprites++sprites)) $ \sprite -> do-      spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE)+      spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)       wait 0.1     wait 0.5     mapM_ destroySprite sprites@@ -258,7 +257,7 @@             _            -> defaultStrokeWidth     fork $ do       wait (n*step)-      play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)+      play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)         & applyE (overEnding fillDur $ fadeLineOutE sWidth))     fork $ do       wait (n*step+(1-fillDur))

@@ -16,9 +16,9 @@ import           Reanimate  main :: IO ()-main = reanimate $ bg `parA` mainScene+main = reanimate $ addStatic bg mainScene   where-    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)+    bg = mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)  mainScene :: Animation mainScene = scene $ mdo@@ -84,5 +84,5 @@ drawSVG svg = animate $ \t ->     withStrokeColor "black" $     rotate (t*360) $-    translate 0 radius $+    translate 0 radius     svg

@@ -17,9 +17,9 @@ import "random-shuffle" System.Random.Shuffle  main :: IO ()-main = reanimate $ parA bg latexExample+main = reanimate $ addStatic bg latexExample   where-    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)+    bg = mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)  latexExample :: Animation latexExample = scene $ do@@ -29,11 +29,11 @@       newSpriteSVG $ fn elt     -- Yoink each glyph     forM_ (reverse sprites) $ \sprite -> do-      spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)+      spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)       wait 0.5     -- Flash glyphs randomly with color     forM_ (shuffleList (sprites++sprites)) $ \sprite -> do-      spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE)+      spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)       wait 0.1     wait 0.5     mapM_ destroySprite sprites@@ -80,7 +80,7 @@             _            -> defaultStrokeWidth     fork $ do       wait (n*step)-      play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)+      play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)         & applyE (overEnding fillDur $ fadeLineOutE sWidth))     fork $ do       wait (n*step+(1-fillDur))

@@ -15,7 +15,7 @@ import           NeatInterpolation  main :: IO ()-main = reanimate $ parA bg $ scene $ do+main = reanimate $ addStatic bg $ scene $ do     play $ mkAnimation drawDuration $ \t -> partialSvg t (wireframe (-45) 220)     xRot <- newVar (-45)     yRot <- newVar 220@@ -32,7 +32,7 @@     wobbles = 3     wobbleDur = 3     spinDur = fromIntegral wobbles * wobbleDur-    bg = animate $ const $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF+    bg = mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF  wireframe :: Double -> Double -> SVG wireframe rotX rotY =

@@ -100,11 +100,11 @@       newSpriteSVG $ fn elt     -- Yoink each glyph     forM_ (reverse sprites) $ \sprite -> do-      spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)+      spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)       wait 0.5     -- Flash glyphs randomly with color     forM_ (shuffleList (sprites++sprites)) $ \sprite -> do-      spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE)+      spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)       wait 0.1     wait 0.5     mapM_ destroySprite sprites@@ -151,7 +151,7 @@             _            -> defaultStrokeWidth     fork $ do       wait (n*step)-      play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)+      play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)         & applyE (overEnding fillDur $ fadeLineOutE sWidth))     fork $ do       wait (n*step+(1-fillDur))

@@ -23,7 +23,7 @@   main :: IO ()-main = reanimate $ parA bg $ scene $ do+main = reanimate $ addStatic bg $ scene $ do     xRot <- newVar (-30)     yRot <- newVar 180     zRot <- newVar 0@@ -46,7 +46,7 @@     wait tDuration     wait 2   where-    bg = animate $ const $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF+    bg = mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF  texture :: Double -> SVG texture t = mkGroup@@ -103,8 +103,7 @@   withStrokeColor "lightblue" $   withStrokeWidth (defaultStrokeWidth/2) $   mkGroup-  [ withStrokeWidth 0 $-    withFillOpacity 0.8 $ mkBackground "white"+  [ withFillOpacity 0.8 $ mkBackground "white"   , mkGroup     [ translate (stepX*x-offsetX + stepX/2) 0 $       mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)@@ -138,11 +137,11 @@       newSpriteSVG $ fn elt     -- Yoink each glyph     forM_ (reverse sprites) $ \sprite -> do-      spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)+      spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)       wait 0.5     -- Flash glyphs randomly with color     forM_ (shuffleList (sprites++sprites)) $ \sprite -> do-      spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE)+      spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)       wait 0.1     wait 0.5     mapM_ destroySprite sprites@@ -189,7 +188,7 @@             _            -> defaultStrokeWidth     fork $ do       wait (n*step)-      play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)+      play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)         & applyE (overEnding fillDur $ fadeLineOutE sWidth))     fork $ do       wait (n*step+(1-fillDur))

@@ -22,10 +22,10 @@ transitionTime = 0.5  main :: IO ()-main = reanimate $ bg `parA` chainT (overlapT transitionTime fadeT)+main = reanimate $ addStatic bg $ chainT (overlapT transitionTime fadeT)       [comp1, comp2, comp3, comp4, comp5, comp6, comp7, setDuration transitionTime comp1]   where-    bg = animate $ const $ mkBackgroundPixel bgColor+    bg = mkBackgroundPixel bgColor     comp1 = svgComponent "Circles" (mkCircle 2)     comp2 = svgComponent "Rects" (mkRect 4 3)     comp3 = svgComponent "Lines" (mkLine (-2,0) (2,0))

@@ -3,7 +3,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                reanimate-version:             1.0.0.0+version:             1.1.0.0 -- synopsis: -- description: license:             PublicDomain@@ -82,6 +82,7 @@                       Reanimate.Builtin.Images                       Reanimate.Debug                       Reanimate.Voice+                      Reanimate.External                       Geom2D.CubicBezier.Linear   other-modules:      Reanimate.Cache                       Reanimate.Morph.Cache@@ -133,7 +134,7 @@     process              >=1.6.3.0,     random               >=1.1,     random-shuffle       >=0.0.4,-    reanimate-svg        ^>=0.11.0.0,+    reanimate-svg        >=0.12.2.0,     split                >=0.2.3.3,     temporary            >=1.3,     text                 >=1.2.3.0,@@ -142,7 +143,9 @@     vector               >=0.12.0.0,     vector-space         >=0.13,     websockets           >=0.12.7.0,-    xml                  >=1.3.14+    xml                  >=1.3.14,+    cryptohash-sha256,+    base64-bytestring   ghc-options: -Wall -fno-ignore-asserts  test-suite spec

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveFoldable         #-}-{-# LANGUAGE DeriveFunctor          #-} {-# LANGUAGE DeriveTraversable      #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances   #-}

@@ -20,7 +20,7 @@ import qualified Data.Text.IO        as T import           Graphics.SvgTree    (Tree, unparse, pattern None) import           Reanimate.Animation (renderTree)-import           Reanimate.Misc      (renameOrCopyFile)+import           Reanimate.Misc      (renameOrCopyFile,getReanimateCacheDirectory) import           System.Directory import           System.FilePath import           System.IO@@ -32,8 +32,7 @@  cacheFile :: FilePath -> (FilePath -> IO ()) -> IO FilePath cacheFile template gen = do-    root <- getXdgDirectory XdgCache "reanimate"-    createDirectoryIfMissing True root+    root <- getReanimateCacheDirectory     let path = root </> template     hit <- doesFileExist path     unless hit $ withSystemTempFile template $ \tmp h -> do@@ -44,8 +43,7 @@  cacheDisk :: String -> (T.Text -> Maybe a) -> (a -> T.Text) -> (Text -> IO a) -> (Text -> IO a) cacheDisk cacheType parse render gen key = do-    root <- getXdgDirectory XdgCache "reanimate"-    createDirectoryIfMissing True root+    root <- getReanimateCacheDirectory     let path = root </> encodeInt (hash key) <.> cacheType     hit <- doesFileExist path     if hit

@@ -1,4 +1,3 @@-{-# LANGUAGE MultiWayIf      #-} {-# LANGUAGE RecordWildCards #-} module Reanimate.Driver   ( reanimate

@@ -0,0 +1,95 @@+module Reanimate.External+  ( URL,+    SHA256,+    zipArchive,+    tarball,+  )+where++import Control.Monad (unless)+import Crypto.Hash.SHA256 (hash)+import qualified Data.ByteString as B (readFile)+import Data.ByteString.Base64 (encode)+import qualified Data.ByteString.Char8 as B8 (unpack)+import Reanimate.Misc (getReanimateCacheDirectory, withTempFile)+import System.Directory (doesDirectoryExist, findExecutable)+import System.FilePath ((</>))+import System.IO.Unsafe (unsafePerformIO)+import System.Process (callProcess)++-- | Resource address+type URL = String++-- | Resource hash+type SHA256 = String++fetchStaticFile :: URL -> SHA256 -> (FilePath -> FilePath -> IO ()) -> IO FilePath+fetchStaticFile url sha256 unpack = do+  root <- getReanimateCacheDirectory+  let folder = root </> sha256+  hit <- doesDirectoryExist folder+  unless hit $+    downloadFile url $ \path -> do+      inp <- B.readFile path+      let inpSha = B8.unpack (encode (hash inp))+      if inpSha == sha256+        then do+          unpack folder path+        else+          error $+            "URL " ++ url ++ "\n"+              ++ "  Expected SHA256: "+              ++ sha256+              ++ "\n"+              ++ "  Actual SHA256:   "+              ++ inpSha+  return folder++{-# NOINLINE zipArchive #-}++-- | Download and unpack zip archive. The returned path is the unpacked folder.+zipArchive :: URL -> SHA256 -> FilePath+zipArchive url sha256 = unsafePerformIO $+  fetchStaticFile url sha256 $ \folder zipfile ->+    callProcess "unzip" ["-qq", "-d", folder, zipfile]++{-# NOINLINE tarball #-}++-- | Download and unpack tarball. The returned path is the unpacked folder.+tarball :: URL -> SHA256 -> FilePath+tarball url sha256 = unsafePerformIO $+  fetchStaticFile url sha256 $ \folder tarfile ->+    callProcess "tar" ["--overwrite", "--one-top-level=" ++ folder, "-xf", tarfile]++downloadFile :: URL -> (FilePath -> IO a) -> IO a+downloadFile url action = do+  mbCurl <- findExecutable "curl"+  mbWget <- findExecutable "wget"+  case (mbCurl, mbWget) of+    (Just curl, _) -> downloadFileCurl curl url action+    (_, Just wget) -> downloadFileWget wget url action+    (Nothing, Nothing) -> error "curl/wget required to download files"++downloadFileCurl :: FilePath -> URL -> (FilePath -> IO a) -> IO a+downloadFileCurl curl url action = withTempFile "dl" $ \path -> do+  callProcess+    curl+    [ url,+      "--output",+      path,+      "--silent",+      "--show-error",+      "--max-filesize",+      "10M"+    ]+  action path++downloadFileWget :: FilePath -> URL -> (FilePath -> IO a) -> IO a+downloadFileWget wget url action = withTempFile "dl" $ \path -> do+  callProcess+    wget+    [ url,+      "--output-document=" ++ path,+      "--quiet"+    ]+  action path

@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash    #-}-{-# LANGUAGE MultiWayIf   #-} {-# LANGUAGE PatternSynonyms   #-} {-| Module      : Reanimate.GeoProjection

@@ -1,41 +1,91 @@-{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}-{-|-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.LaTeX-  ( latex-  , latexWithHeaders-  , latexChunks-  , xelatex-  , xelatexWithHeaders-  , ctex-  , ctexWithHeaders-  , latexAlign+  ( latexCfg,+    TexEngine (..),+    TexConfig (..),+    latex,+    latexWithHeaders,+    latexChunks,+    xelatex,+    xelatexWithHeaders,+    ctex,+    ctexWithHeaders,+    latexAlign,++    -- * Font configurations+    chalkduster,+    calligra,+    noto,+    helvet,+    libertine,   ) where -import qualified Data.ByteString               as B-import           Data.Text                                ( Text )-import qualified Data.Text                     as T-import qualified Data.Text.Encoding            as T-import           Graphics.SvgTree                         ( Tree-                                                          , parseSvgFile-                                                          )-import           Reanimate.Cache-import           Reanimate.Misc-import           Reanimate.Svg-import           Reanimate.Parameters-import           System.FilePath                          ( replaceExtension-                                                          , takeFileName-                                                          , (</>)-                                                          )-import           System.IO.Unsafe                         ( unsafePerformIO )+import Control.Lens+import qualified Data.ByteString as B+import Data.Hashable+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import GHC.Generics (Generic)+import Graphics.SvgTree+  ( Tree,+    clipPathRef,+    clipRule,+    mapTree,+    parseSvgFile,+    strokeColor,+    pattern ClipPathTree,+    pattern None,+  )+import Reanimate.Animation (SVG)+import Reanimate.Cache+import Reanimate.External+import Reanimate.Misc+import Reanimate.Parameters+import Reanimate.Svg+import System.FilePath+  ( replaceExtension,+    takeFileName,+    (</>),+  )+import System.IO.Unsafe (unsafePerformIO) +-- | TeX backends. They have different features and capabilities.+data TexEngine = LaTeX | XeLaTeX | LuaLaTeX+  deriving (Generic, Hashable, Eq, Ord, Read, Show)++-- | TeX configurations can load packages and set up environments for tex scripts.+data TexConfig = TexConfig+  { texConfigEngine :: TexEngine,+    texConfigHeaders :: [T.Text],+    texConfigPostScript :: [T.Text]+  }+  deriving (Generic, Hashable, Read, Show, Eq, Ord)++-- | Render TeX script using a given configuration.+latexCfg :: TexConfig -> T.Text -> SVG+latexCfg (TexConfig engine headers postscript) =+  gen headers postscript+  where+    gen =+      case engine of+        LaTeX -> someTexWithHeaders engine "latex" "dvi" []+        XeLaTeX -> someTexWithHeaders engine "xelatex" "xdv" ["-no-pdf"]+        LuaLaTeX -> someTexWithHeaders engine "lualatex" "pdf" []+ -- | Invoke latex and import the result as an SVG object. SVG objects are --   cached to improve performance. --@@ -49,27 +99,36 @@  -- | Invoke latex with extra script headers. latexWithHeaders :: [T.Text] -> T.Text -> Tree-latexWithHeaders = someTexWithHeaders "latex" "dvi" []+latexWithHeaders = someTexWithHeaders LaTeX "latex" "dvi" [] [] -someTexWithHeaders :: String -> String -> [String] -> [T.Text] -> T.Text -> Tree-someTexWithHeaders _exec _dvi _args _headers tex | pNoExternals = mkText tex-someTexWithHeaders exec dvi args headers tex =-  (unsafePerformIO . (cacheMem . cacheDiskSvg) (latexToSVG dvi exec args))+someTexWithHeaders ::+  TexEngine ->+  String ->+  String ->+  [String] ->+  [T.Text] ->+  [T.Text] ->+  T.Text ->+  Tree+someTexWithHeaders _engine _exec _dvi _args _headers _postscript tex+  | pNoExternals = mkText tex+someTexWithHeaders engine exec dvi args headers postscript tex =+  (unsafePerformIO . (cacheMem . cacheDiskSvg) (latexToSVG engine dvi exec args))     script- where-  script = mkTexScript exec args headers tex+  where+    script = mkTexScript exec args headers (T.unlines (postscript ++ [tex]))  -- | Invoke latex and separate results. latexChunks :: [T.Text] -> [Tree] latexChunks chunks | pNoExternals = map mkText chunks-latexChunks chunks                = worker (svgGlyphs $ latex $ T.concat chunks) chunks- where-  merge lst = mkGroup [ fmt svg | (fmt, _, svg) <- lst ]-  worker [] [] = []-  worker _ [] = error "latex chunk mismatch"-  worker everything (x : xs) =-    let width = length $ svgGlyphs (latex x)-    in merge (take width everything) : worker (drop width everything) xs+latexChunks chunks = worker (svgGlyphs $ latex $ T.concat chunks) chunks+  where+    merge lst = mkGroup [fmt svg | (fmt, _, svg) <- lst]+    worker [] [] = []+    worker _ [] = error "latex chunk mismatch"+    worker everything (x : xs) =+      let width = length $ svgGlyphs (latex x)+       in merge (take width everything) : worker (drop width everything) xs  -- | Invoke xelatex and import the result as an SVG object. SVG objects are --   cached to improve performance. Xelatex has support for non-western scripts.@@ -78,7 +137,7 @@  -- | Invoke xelatex with extra script headers. xelatexWithHeaders :: [T.Text] -> T.Text -> Tree-xelatexWithHeaders = someTexWithHeaders "xelatex" "xdv" ["-no-pdf"]+xelatexWithHeaders = someTexWithHeaders XeLaTeX "xelatex" "xdv" [] ["-no-pdf"]  -- | Invoke xelatex with "\usepackage[UTF8]{ctex}" and import the result as an --   SVG object. SVG objects are cached to improve performance. Xelatex has@@ -109,13 +168,30 @@ latexAlign tex = latex $ T.unlines ["\\begin{align*}", tex, "\\end{align*}"]  postprocess :: Tree -> Tree-postprocess = simplify+postprocess =+  simplify+    . lowerTransformations+    . scaleXY 0.1 (-0.1)+    . removeClipPaths+    . lowerIds+    . mapTree clearDrawAttr+  where+    clearDrawAttr t = t & strokeColor .~ Last Nothing +enginePostprocess :: TexEngine -> Tree -> Tree+enginePostprocess LuaLaTeX svg = translate 0 (svgHeight svg) svg+enginePostprocess _ svg = svg++removeClipPaths :: SVG -> SVG+removeClipPaths = mapTree worker+  where+    worker ClipPathTree {} = None+    worker t = t & clipRule .~ Last Nothing & clipPathRef .~ Last Nothing+ -- executable, arguments, header, tex-latexToSVG :: String -> String -> [String] -> Text -> IO Tree-latexToSVG dviExt latexExec latexArgs tex = do+latexToSVG :: TexEngine -> String -> String -> [String] -> Text -> IO Tree+latexToSVG engine dviExt latexExec latexArgs tex = do   latexBin <- requireExecutable latexExec-  dvisvgm  <- requireExecutable "dvisvgm"   withTempDir $ \tmp_dir -> withTempFile "tex" $ \tex_file ->     withTempFile "svg" $ \svg_file -> do       let dvi_file =@@ -123,44 +199,54 @@       B.writeFile tex_file (T.encodeUtf8 tex)       runCmd         latexBin-        (  latexArgs-        ++ [ "-interaction=nonstopmode"-           , "-halt-on-error"-           , "-output-directory=" ++ tmp_dir-           , tex_file-           ]+        ( latexArgs+            ++ [ "-interaction=nonstopmode",+                 "-halt-on-error",+                 "-output-directory=" ++ tmp_dir,+                 tex_file+               ]         )-      runCmd-        dvisvgm-        [ dvi_file-        , "--precision=5"-        , "--exact"    -- better bboxes.-        , "--no-fonts" -- use glyphs instead of fonts.-        , "--scale=0.1,-0.1"-        , "--verbosity=0"-        , "-o"-        , svg_file-        ]+      if dviExt == "pdf"+        then do+          pdf2svg <- requireExecutable "pdf2svg"+          runCmd+            pdf2svg+            [dvi_file, svg_file]+        else do+          dvisvgm <- requireExecutable "dvisvgm"+          runCmd+            dvisvgm+            [ dvi_file,+              "--precision=5",+              "--exact", -- better bboxes.+              "--no-fonts", -- use glyphs instead of fonts.+              "--verbosity=0",+              "-o",+              svg_file+            ]       svg_data <- B.readFile svg_file       case parseSvgFile svg_file svg_data of-        Nothing  -> error "Malformed svg"-        Just svg -> return $ postprocess $ unbox $ replaceUses svg+        Nothing -> error "Malformed svg"+        Just svg ->+          return $+            enginePostprocess engine $+              postprocess $ unbox $ replaceUses svg  mkTexScript :: String -> [String] -> [Text] -> Text -> Text mkTexScript latexExec latexArgs texHeaders tex =-  T.unlines-    $  [ "% " <> T.pack (unwords (latexExec : latexArgs))-       , "\\documentclass[preview]{standalone}"-       , "\\usepackage{amsmath}"-       , "\\usepackage{gensymb}"-       ]-    ++ texHeaders-    ++ [ "\\usepackage[english]{babel}"-       , "\\linespread{1}"-       , "\\begin{document}"-       , tex-       , "\\end{document}"-       ]+  T.unlines $+    [ "% " <> T.pack (unwords (latexExec : latexArgs)),+      "\\documentclass[preview]{standalone}",+      "\\usepackage{amsmath}",+      "\\usepackage{gensymb}"+    ]+      ++ texHeaders+      ++ [ "\\usepackage[english]{babel}",+           "\\linespread{1}",+           "\\begin{document}",+           tex,+           "\\end{document}"+         ]  {- Packages used by manim. @@ -180,3 +266,99 @@ \\\usepackage{xfrac}\n\ \\\usepackage{microtype}\n\ -}++-- | Chalkduster configuration. Depends on lualatex.+--   Font files are automatically downloaded.+--+--   Example:+--+-- @+-- `latexCfg` `chalkduster` "chalkduster"+-- @+--+--   <<docs/gifs/doc_chalkduster.gif>>+chalkduster :: TexConfig+chalkduster =+  TexConfig+    { texConfigEngine = XeLaTeX,+      texConfigHeaders =+        [ "\\usepackage[no-math]{fontspec}",+          "\\setmainfont[Mapping=tex-text,Path={" <> chalkdusterFont <> "/},Extension=.ttf]{Chalkduster}",+          "\\usepackage[defaultmathsizes]{mathastext}"+        ],+      texConfigPostScript = []+    }+  where+    chalkdusterFont =+      T.pack $+        zipArchive+          "https://www.ffonts.net/Chalkduster.font.zip"+          "Wplv4RjuFiI0hDQnAM5MVHl2evrZqWstRLdVAfBomCM="++-- | Calligra configuration.+--+--   Example:+--+-- @+-- `latexCfg` `calligra` "calligra"+-- @+--+--   <<docs/gifs/doc_calligra.gif>>+calligra :: TexConfig+calligra =+  TexConfig+    { texConfigEngine = LaTeX,+      texConfigHeaders = ["\\usepackage{calligra}"],+      texConfigPostScript = ["\\calligra"]+    }++-- | Noto configuration.+--+--   Example:+--+-- @+-- `latexCfg` `noto` "noto"+-- @+--+--   <<docs/gifs/doc_noto.gif>>+noto :: TexConfig+noto =+  TexConfig+    { texConfigEngine = LaTeX,+      texConfigHeaders = ["\\usepackage{noto}"],+      texConfigPostScript = []+    }++-- | Helvetica configuration.+--+--   Example:+--+-- @+-- `latexCfg` `helvet` "helvet"+-- @+--+--   <<docs/gifs/doc_helvet.gif>>+helvet :: TexConfig+helvet =+  TexConfig+    { texConfigEngine = LaTeX,+      texConfigHeaders = ["\\usepackage{helvet}"],+      texConfigPostScript = []+    }++-- | Libertine configuration.+--+--   Example:+--+-- @+-- `latexCfg` `libertine` "libertine"+-- @+--+--   <<docs/gifs/doc_libertine.gif>>+libertine :: TexConfig+libertine =+  TexConfig+    { texConfigEngine = LaTeX,+      texConfigHeaders = ["\\usepackage{libertine}"],+      texConfigPostScript = []+    }

@@ -1,36 +1,55 @@ module Reanimate.Misc-  ( requireExecutable-  , runCmd-  , runCmd_-  , runCmdLazy-  , withTempDir-  , withTempFile-  , renameOrCopyFile-  ) where--import           Control.Concurrent-import           Control.Exception  (catch, evaluate, finally, throw)-import qualified Data.Text          as T-import qualified Data.Text.IO       as T-import           Foreign.C.Error-import           GHC.IO.Exception-import           System.Directory   (copyFile, findExecutable, removeFile,-                                     renameFile)-import           System.FilePath    ((<.>))-import           System.IO          (hClose, hGetContents, hIsEOF, hPutStr,-                                     stderr)-import           System.IO.Temp     (withSystemTempDirectory,-                                     withSystemTempFile)-import           System.Process     (readProcessWithExitCode,-                                     runInteractiveProcess, showCommandForUser,-                                     terminateProcess, waitForProcess)+  ( requireExecutable,+    runCmd,+    runCmd_,+    runCmdLazy,+    withTempDir,+    withTempFile,+    renameOrCopyFile,+    getReanimateCacheDirectory,+  )+where +import Control.Concurrent+import Control.Exception (catch, evaluate, finally, throw)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Foreign.C.Error+import GHC.IO.Exception+import System.Directory+  ( XdgDirectory (XdgCache),+    copyFile,+    createDirectoryIfMissing,+    findExecutable,+    getXdgDirectory,+    removeFile,+    renameFile,+  )+import System.FilePath ((<.>), (</>))+import System.IO+  ( hClose,+    hGetContents,+    hIsEOF,+    hPutStr,+    stderr,+  )+import System.IO.Temp+  ( withSystemTempDirectory,+    withSystemTempFile,+  )+import System.Process+  ( readProcessWithExitCode,+    runInteractiveProcess,+    showCommandForUser,+    terminateProcess,+    waitForProcess,+  )  requireExecutable :: String -> IO FilePath requireExecutable exec = do   mbPath <- findExecutable exec   case mbPath of-    Nothing   -> error $ "Couldn't find executable: " ++ exec+    Nothing -> error $ "Couldn't find executable: " ++ exec     Just path -> return path  runCmd :: FilePath -> [String] -> IO ()@@ -38,31 +57,33 @@   ret <- runCmd_ exec args   case ret of     Left err -> error $ showCommandForUser exec args ++ ":\n" ++ err-    Right{}  -> return ()+    Right {} -> return ()  runCmd_ :: FilePath -> [String] -> IO (Either String String) runCmd_ exec args = do   (ret, stdout, errMsg) <- readProcessWithExitCode exec args ""-  _                     <- evaluate (length stdout + length errMsg)+  _ <- evaluate (length stdout + length errMsg)   case ret of     ExitSuccess -> return (Right stdout)-    ExitFailure err | False ->-      return-        $  Left-        $  "Failed to run: "-        ++ showCommandForUser exec args-        ++ "\n"-        ++ "Error code: "-        ++ show err-        ++ "\n"-        ++ "stderr: "-        ++ errMsg-    ExitFailure{} | null errMsg -> -- LaTeX prints errors to stdout. :(-      return $ Left stdout-    ExitFailure{} -> return $ Left errMsg+    ExitFailure err+      | False ->+        return $+          Left $+            "Failed to run: "+              ++ showCommandForUser exec args+              ++ "\n"+              ++ "Error code: "+              ++ show err+              ++ "\n"+              ++ "stderr: "+              ++ errMsg+    ExitFailure {}+      | null errMsg -> -- LaTeX prints errors to stdout. :(+        return $ Left stdout+    ExitFailure {} -> return $ Left errMsg -runCmdLazy-  :: FilePath -> [String] -> (IO (Either String T.Text) -> IO a) -> IO a+runCmdLazy ::+  FilePath -> [String] -> (IO (Either String T.Text) -> IO a) -> IO a runCmdLazy exec args handler = do   (inp, out, err, pid) <- runInteractiveProcess exec args Nothing Nothing   hClose inp@@ -72,17 +93,17 @@         eof <- hIsEOF out         if eof           then do-            _      <- evaluate (length errOutput)-            ret    <- waitForProcess pid+            _ <- evaluate (length errOutput)+            ret <- waitForProcess pid             case ret of-              ExitSuccess   -> return (Left "")-              ExitFailure{} -> return (Left errOutput)-              {-ExitFailure errMsg -> do-                return $ Left $-                  "Failed to run: " ++ showCommandForUser exec args ++ "\n" ++-                  "Error code: " ++ show errMsg ++ "\n" ++-                  "stderr: " ++ stderr-}-          else do+              ExitSuccess -> return (Left "")+              ExitFailure {} -> return (Left errOutput)+          else {-ExitFailure errMsg -> do+                 return $ Left $+                   "Failed to run: " ++ showCommandForUser exec args ++ "\n" +++                   "Error code: " ++ show errMsg ++ "\n" +++                   "stderr: " ++ stderr-}+          do             line <- T.hGetLine out             return (Right line)   handler fetch `finally` do@@ -94,10 +115,11 @@ -- revert back to copyFile + removeFile. renameOrCopyFile :: FilePath -> FilePath -> IO () renameOrCopyFile src dst = renameFile src dst `catch` exdev- where-  exdev e = if fmap Errno (ioe_errno e) == Just eXDEV-    then copyFile src dst >> removeFile src-    else throw e+  where+    exdev e =+      if fmap Errno (ioe_errno e) == Just eXDEV+        then copyFile src dst >> removeFile src+        else throw e  withTempDir :: (FilePath -> IO a) -> IO a withTempDir = withSystemTempDirectory "reanimate"@@ -106,3 +128,14 @@ withTempFile ext action =   withSystemTempFile ("reanimate" <.> ext) $ \path hd ->     hClose hd >> action path++getReanimateCacheDirectory :: IO FilePath+getReanimateCacheDirectory = do+  root <- getXdgDirectory XdgCache "reanimate"+  let path = root </> show cacheVersion+  createDirectoryIfMissing True path+  return path+  where+    -- Incrementing this value invalidates all cached results.+    cacheVersion :: Int+    cacheVersion = 0

@@ -7,7 +7,7 @@ import           Data.Hashable import           Data.Serialize import           Reanimate.Cache        (encodeInt)-import           Reanimate.Misc         (renameOrCopyFile)+import           Reanimate.Misc         (renameOrCopyFile,getReanimateCacheDirectory) import           Reanimate.Morph.Common import           System.Directory import           System.FilePath@@ -18,8 +18,7 @@ -- type PointCorrespondence = Polygon → Polygon → (Polygon, Polygon) cachePointCorrespondence :: Int -> PointCorrespondence -> PointCorrespondence cachePointCorrespondence ident fn src dst = unsafePerformIO $ do-    root <- getXdgDirectory XdgCache "reanimate"-    createDirectoryIfMissing True root+    root <- getReanimateCacheDirectory     let path = root </> template     hit <- doesFileExist path     if hit

@@ -261,8 +261,7 @@ vectorize_ :: [String] -> FilePath -> SVG vectorize_ _ path | pNoExternals = mkText $ T.pack path vectorize_ args path             = unsafePerformIO $ do-  root <- getXdgDirectory XdgCache "reanimate"-  createDirectoryIfMissing True root+  root <- getReanimateCacheDirectory   let svgPath = root </> encodeInt key <.> "svg"   hit <- doesFileExist svgPath   unless hit $ withSystemTempFile "file.svg" $ \tmpSvgPath svgH ->

@@ -61,6 +61,7 @@             line & linePoint1 %~ updPoint m                  & linePoint2 %~ updPoint m         ClipPathTree{} -> t+        DefinitionTree{} -> t         -- If we encounter an unknown node and we've already tried to convert         -- to paths, give up and insert an explicit transformation.         _ | hasPathified ->@@ -75,6 +76,12 @@     worker t@GroupTree{} = t & attrId .~ Nothing     worker t@PathTree{}  = t & attrId .~ Nothing     worker t             = t++-- | Remove all draw attributes such as 'stroke', 'fill' and 'fill-opacity'.+clearDrawAttributes :: SVG -> SVG+clearDrawAttributes = mapTree worker+  where+    worker t = t & drawAttributes .~ defaultSvg  -- | Optimize SVG tree without affecting how it is rendered. simplify :: SVG -> SVG

@@ -23,6 +23,7 @@ replaceUses doc = doc & documentElements %~ map (mapTree replace)   where     replaceDefinition PathTree{} = None+    replaceDefinition SymbolTree{} = None     replaceDefinition t          = t      replace t@DefinitionTree{} = mapTree replaceDefinition t@@ -30,8 +31,13 @@     replace (UseTree use Nothing) =       case Map.lookup (use^.useName) idMap of         Nothing -> error $ "Unknown id: " ++ (use^.useName)+        Just (SymbolTree children) -> mapTree replace $+          GroupTree children+          & transform ?~+              fromMaybe [] (use^.transform) +++              [baseToTransformation (use^.useBase)]         Just tree -> mapTree replace $-          groupTree (defaultSvg & groupChildren .~ [tree])+          GroupTree (defaultSvg & groupChildren .~ [tree])           & transform ?~               fromMaybe [] (use^.transform) ++               [baseToTransformation (use^.useBase)]

@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -w      #-} -- {-# LANGUAGE TemplateHaskell      #-} module Helpers where@@ -32,7 +31,7 @@     , a' >= 0.01, b' >= 0.01     ] -data Parameters = Parameters [(Double, Double)]+newtype Parameters = Parameters [(Double, Double)]   deriving (Show) instance Arbitrary Parameters where   arbitrary = do@@ -45,7 +44,7 @@   shrink (Parameters xs) =     map Parameters (delete xs $ shrinkListByOne xs) ++     map Parameters (delete xs $-    sequence $ map (map unParam . shrink . PolyParam) xs)+    mapM (map unParam . shrink . PolyParam) xs)  shrinkListByOne :: [a] -> [[a]] shrinkListByOne x | length x <= 4 = [x]

@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -w      #-} {-# LANGUAGE TemplateHaskell      #-} module Properties where@@ -22,7 +21,7 @@ prop_pGenerate (PolyParam a) (PolyParam b) (PolyParam c) (PolyParam d) =   pIsSimple $ pGenerate [a,b,c,d] -prop_pIsSimple p = pIsSimple p+prop_pIsSimple = pIsSimple  prop_isBetween a b = percent $ \t ->     a /= b ==>