diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -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
diff --git a/docs/gifs/doc_calligra.gif b/docs/gifs/doc_calligra.gif
new file mode 100644
Binary files /dev/null and b/docs/gifs/doc_calligra.gif differ
diff --git a/docs/gifs/doc_chalkduster.gif b/docs/gifs/doc_chalkduster.gif
new file mode 100644
Binary files /dev/null and b/docs/gifs/doc_chalkduster.gif differ
diff --git a/docs/gifs/doc_helvet.gif b/docs/gifs/doc_helvet.gif
new file mode 100644
Binary files /dev/null and b/docs/gifs/doc_helvet.gif differ
diff --git a/docs/gifs/doc_libertine.gif b/docs/gifs/doc_libertine.gif
new file mode 100644
Binary files /dev/null and b/docs/gifs/doc_libertine.gif differ
diff --git a/docs/gifs/doc_noto.gif b/docs/gifs/doc_noto.gif
new file mode 100644
Binary files /dev/null and b/docs/gifs/doc_noto.gif differ
diff --git a/examples/blender_sphere.hs b/examples/blender_sphere.hs
--- a/examples/blender_sphere.hs
+++ b/examples/blender_sphere.hs
@@ -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)
diff --git a/examples/boundingbox.hs b/examples/boundingbox.hs
--- a/examples/boundingbox.hs
+++ b/examples/boundingbox.hs
@@ -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 ->
diff --git a/examples/demo_stars.hs b/examples/demo_stars.hs
--- a/examples/demo_stars.hs
+++ b/examples/demo_stars.hs
@@ -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
diff --git a/examples/demo_tangent.hs b/examples/demo_tangent.hs
--- a/examples/demo_tangent.hs
+++ b/examples/demo_tangent.hs
@@ -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
diff --git a/examples/doc_calligra.hs b/examples/doc_calligra.hs
new file mode 100644
--- /dev/null
+++ b/examples/doc_calligra.hs
@@ -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"
diff --git a/examples/doc_chalkduster.hs b/examples/doc_chalkduster.hs
new file mode 100644
--- /dev/null
+++ b/examples/doc_chalkduster.hs
@@ -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"
diff --git a/examples/doc_helvet.hs b/examples/doc_helvet.hs
new file mode 100644
--- /dev/null
+++ b/examples/doc_helvet.hs
@@ -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"
diff --git a/examples/doc_libertine.hs b/examples/doc_libertine.hs
new file mode 100644
--- /dev/null
+++ b/examples/doc_libertine.hs
@@ -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"
diff --git a/examples/doc_noto.hs b/examples/doc_noto.hs
new file mode 100644
--- /dev/null
+++ b/examples/doc_noto.hs
@@ -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"
diff --git a/examples/doc_slideDownT.hs b/examples/doc_slideDownT.hs
--- a/examples/doc_slideDownT.hs
+++ b/examples/doc_slideDownT.hs
@@ -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
diff --git a/examples/doc_slideLeftT.hs b/examples/doc_slideLeftT.hs
--- a/examples/doc_slideLeftT.hs
+++ b/examples/doc_slideLeftT.hs
@@ -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
diff --git a/examples/doc_slideUpT.hs b/examples/doc_slideUpT.hs
--- a/examples/doc_slideUpT.hs
+++ b/examples/doc_slideUpT.hs
@@ -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
diff --git a/examples/fe_bleed.hs b/examples/fe_bleed.hs
--- a/examples/fe_bleed.hs
+++ b/examples/fe_bleed.hs
@@ -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
diff --git a/examples/fe_distortion.hs b/examples/fe_distortion.hs
new file mode 100644
--- /dev/null
+++ b/examples/fe_distortion.hs
@@ -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 ""
+ 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|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ |]
+ where
+ hue' = T.pack (show hue)
+ dScale' = T.pack (show dScale)
diff --git a/examples/fe_morph.hs b/examples/fe_morph.hs
--- a/examples/fe_morph.hs
+++ b/examples/fe_morph.hs
@@ -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.
diff --git a/examples/fonts_latex.hs b/examples/fonts_latex.hs
--- a/examples/fonts_latex.hs
+++ b/examples/fonts_latex.hs
@@ -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}"
+ ] []
diff --git a/examples/intro_canvas.hs b/examples/intro_canvas.hs
--- a/examples/intro_canvas.hs
+++ b/examples/intro_canvas.hs
@@ -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]
]
diff --git a/examples/intro_canvas_square.hs b/examples/intro_canvas_square.hs
--- a/examples/intro_canvas_square.hs
+++ b/examples/intro_canvas_square.hs
@@ -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]
]
diff --git a/examples/knock_knock.hs b/examples/knock_knock.hs
--- a/examples/knock_knock.hs
+++ b/examples/knock_knock.hs
@@ -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
diff --git a/examples/latex_draw.hs b/examples/latex_draw.hs
--- a/examples/latex_draw.hs
+++ b/examples/latex_draw.hs
@@ -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 ->
diff --git a/examples/latex_wheel.hs b/examples/latex_wheel.hs
--- a/examples/latex_wheel.hs
+++ b/examples/latex_wheel.hs
@@ -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
diff --git a/examples/morphology_closest.hs b/examples/morphology_closest.hs
--- a/examples/morphology_closest.hs
+++ b/examples/morphology_closest.hs
@@ -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])
diff --git a/examples/morphology_intro.hs b/examples/morphology_intro.hs
--- a/examples/morphology_intro.hs
+++ b/examples/morphology_intro.hs
@@ -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)
diff --git a/examples/morphology_linear.hs b/examples/morphology_linear.hs
--- a/examples/morphology_linear.hs
+++ b/examples/morphology_linear.hs
@@ -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)
diff --git a/examples/morphology_object_correspondence.hs b/examples/morphology_object_correspondence.hs
--- a/examples/morphology_object_correspondence.hs
+++ b/examples/morphology_object_correspondence.hs
@@ -1,7 +1,6 @@
#!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ParallelListComp #-}
module Main(main) where
import Codec.Picture
diff --git a/examples/morphology_point_correspondence.hs b/examples/morphology_point_correspondence.hs
--- a/examples/morphology_point_correspondence.hs
+++ b/examples/morphology_point_correspondence.hs
@@ -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
diff --git a/examples/morphology_rotational.hs b/examples/morphology_rotational.hs
--- a/examples/morphology_rotational.hs
+++ b/examples/morphology_rotational.hs
@@ -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)
diff --git a/examples/morphology_rotational_intro.hs b/examples/morphology_rotational_intro.hs
--- a/examples/morphology_rotational_intro.hs
+++ b/examples/morphology_rotational_intro.hs
@@ -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) $
diff --git a/examples/raster.hs b/examples/raster.hs
--- a/examples/raster.hs
+++ b/examples/raster.hs
@@ -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
diff --git a/examples/sorting.hs b/examples/sorting.hs
--- a/examples/sorting.hs
+++ b/examples/sorting.hs
@@ -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
diff --git a/examples/tut_glue_animate.hs b/examples/tut_glue_animate.hs
--- a/examples/tut_glue_animate.hs
+++ b/examples/tut_glue_animate.hs
@@ -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)
diff --git a/examples/tut_glue_blender.hs b/examples/tut_glue_blender.hs
--- a/examples/tut_glue_blender.hs
+++ b/examples/tut_glue_blender.hs
@@ -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))
diff --git a/examples/tut_glue_keyframe.hs b/examples/tut_glue_keyframe.hs
--- a/examples/tut_glue_keyframe.hs
+++ b/examples/tut_glue_keyframe.hs
@@ -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
diff --git a/examples/tut_glue_latex.hs b/examples/tut_glue_latex.hs
--- a/examples/tut_glue_latex.hs
+++ b/examples/tut_glue_latex.hs
@@ -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))
diff --git a/examples/tut_glue_potrace.hs b/examples/tut_glue_potrace.hs
--- a/examples/tut_glue_potrace.hs
+++ b/examples/tut_glue_potrace.hs
@@ -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 =
diff --git a/examples/tut_glue_povray.hs b/examples/tut_glue_povray.hs
--- a/examples/tut_glue_povray.hs
+++ b/examples/tut_glue_povray.hs
@@ -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))
diff --git a/examples/tut_glue_povray_ortho.hs b/examples/tut_glue_povray_ortho.hs
--- a/examples/tut_glue_povray_ortho.hs
+++ b/examples/tut_glue_povray_ortho.hs
@@ -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))
diff --git a/examples/tut_glue_svg.hs b/examples/tut_glue_svg.hs
--- a/examples/tut_glue_svg.hs
+++ b/examples/tut_glue_svg.hs
@@ -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))
diff --git a/reanimate.cabal b/reanimate.cabal
--- a/reanimate.cabal
+++ b/reanimate.cabal
@@ -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
diff --git a/src/Geom2D/CubicBezier/Linear.hs b/src/Geom2D/CubicBezier/Linear.hs
--- a/src/Geom2D/CubicBezier/Linear.hs
+++ b/src/Geom2D/CubicBezier/Linear.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
diff --git a/src/Reanimate/Cache.hs b/src/Reanimate/Cache.hs
--- a/src/Reanimate/Cache.hs
+++ b/src/Reanimate/Cache.hs
@@ -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
diff --git a/src/Reanimate/Driver.hs b/src/Reanimate/Driver.hs
--- a/src/Reanimate/Driver.hs
+++ b/src/Reanimate/Driver.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
module Reanimate.Driver
( reanimate
diff --git a/src/Reanimate/External.hs b/src/Reanimate/External.hs
new file mode 100644
--- /dev/null
+++ b/src/Reanimate/External.hs
@@ -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
diff --git a/src/Reanimate/GeoProjection.hs b/src/Reanimate/GeoProjection.hs
--- a/src/Reanimate/GeoProjection.hs
+++ b/src/Reanimate/GeoProjection.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternSynonyms #-}
{-|
Module : Reanimate.GeoProjection
diff --git a/src/Reanimate/LaTeX.hs b/src/Reanimate/LaTeX.hs
--- a/src/Reanimate/LaTeX.hs
+++ b/src/Reanimate/LaTeX.hs
@@ -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"
+-- @
+--
+-- <>
+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"
+-- @
+--
+-- <>
+calligra :: TexConfig
+calligra =
+ TexConfig
+ { texConfigEngine = LaTeX,
+ texConfigHeaders = ["\\usepackage{calligra}"],
+ texConfigPostScript = ["\\calligra"]
+ }
+
+-- | Noto configuration.
+--
+-- Example:
+--
+-- @
+-- `latexCfg` `noto` "noto"
+-- @
+--
+-- <>
+noto :: TexConfig
+noto =
+ TexConfig
+ { texConfigEngine = LaTeX,
+ texConfigHeaders = ["\\usepackage{noto}"],
+ texConfigPostScript = []
+ }
+
+-- | Helvetica configuration.
+--
+-- Example:
+--
+-- @
+-- `latexCfg` `helvet` "helvet"
+-- @
+--
+-- <>
+helvet :: TexConfig
+helvet =
+ TexConfig
+ { texConfigEngine = LaTeX,
+ texConfigHeaders = ["\\usepackage{helvet}"],
+ texConfigPostScript = []
+ }
+
+-- | Libertine configuration.
+--
+-- Example:
+--
+-- @
+-- `latexCfg` `libertine` "libertine"
+-- @
+--
+-- <>
+libertine :: TexConfig
+libertine =
+ TexConfig
+ { texConfigEngine = LaTeX,
+ texConfigHeaders = ["\\usepackage{libertine}"],
+ texConfigPostScript = []
+ }
diff --git a/src/Reanimate/Misc.hs b/src/Reanimate/Misc.hs
--- a/src/Reanimate/Misc.hs
+++ b/src/Reanimate/Misc.hs
@@ -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
diff --git a/src/Reanimate/Morph/Cache.hs b/src/Reanimate/Morph/Cache.hs
--- a/src/Reanimate/Morph/Cache.hs
+++ b/src/Reanimate/Morph/Cache.hs
@@ -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
diff --git a/src/Reanimate/Raster.hs b/src/Reanimate/Raster.hs
--- a/src/Reanimate/Raster.hs
+++ b/src/Reanimate/Raster.hs
@@ -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 ->
diff --git a/src/Reanimate/Svg.hs b/src/Reanimate/Svg.hs
--- a/src/Reanimate/Svg.hs
+++ b/src/Reanimate/Svg.hs
@@ -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
diff --git a/src/Reanimate/Svg/Unuse.hs b/src/Reanimate/Svg/Unuse.hs
--- a/src/Reanimate/Svg/Unuse.hs
+++ b/src/Reanimate/Svg/Unuse.hs
@@ -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)]
diff --git a/test/Helpers.hs b/test/Helpers.hs
--- a/test/Helpers.hs
+++ b/test/Helpers.hs
@@ -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]
diff --git a/test/Properties.hs b/test/Properties.hs
--- a/test/Properties.hs
+++ b/test/Properties.hs
@@ -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 ==>