diff --git a/README.md b/README.md index 717b7d8..61fd45d 100644 --- a/README.md +++ b/README.md @@ -21,23 +21,23 @@ The example gifs are displayed at 25 fps. ```haskell latex_draw :: Ani () latex_draw = pauseAtEnd 1 $ defineAnimation $ proc () -> do - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] + emit -< toHtml $ mkBackground "black" drawText msg `andThen` fillText msg -< () where msg = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" - placement = g_ [transform_ $ translate 20 15 <> " " <> scale 5 5] + placement = translate (320/2) (180/2) . scale 5 fillText txt = defineAnimation $ proc () -> do duration 1 -< () s <- signal 0 1 -< () - emit -< placement $ - g_ [fill_ "white", num_ fill_opacity_ s] $ - toHtml $ latexAlign txt + emit -< toHtml $ placement $ + withFillColor "white" $ withFillOpacity s $ + center $ latexAlign txt drawText txt = defineAnimation $ proc () -> do duration 2 -< () s <- signal 0 1 -< () - emit -< placement $ - g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] $ - toHtml $ partialSvg s $ latexAlign txt + emit -< toHtml $ placement $ + withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.1) $ + partialSvg s $ center $ latexAlign txt ``` ![Drawing LaTeX equations](gifs/latex_draw.gif) @@ -54,27 +54,19 @@ bbox1 :: Ani () bbox1 = defineAnimation $ proc () -> do duration 5 -< () s <- signal 0 1 -< () - let rotated = rotate (360*s) svg - (x, y, w, h) = boundingBox rotated emit -< do - g_ [transform_ $ Lucid.translate x y] $ - rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0"] - g_ [fill_ "white"] $ toHtml rotated + toHtml $ mkBoundingBox $ rotate (360*s) svg + toHtml $ withFillColor "white" $ rotate (360*s) svg where - msg = "\\sum_{k=1}^\\infty" - svg = scale 3 $ center $ latexAlign msg + svg = scale 3 $ center $ latexAlign "\\sum_{k=1}^\\infty" bbox2 :: Ani () bbox2 = defineAnimation $ proc () -> do duration 5 -< () s <- signalOscillate 0 1 -< () - let rotated = partialSvg s heartShape - (x, y, w, h) = boundingBox rotated emit -< do - g_ [transform_ $ Lucid.translate x y] $ - rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0"] - g_ [fill_ "white", fill_opacity_ "0", stroke_width_ "4", stroke_ "white"] $ - toHtml rotated + toHtml $ mkBoundingBox $ partialSvg s heartShape + toHtml $ withStrokeColor "white" $ withFillOpacity 0 $ partialSvg s heartShape ``` ![Bounding boxes](gifs/bbox.gif) @@ -88,21 +80,19 @@ bbox2 = defineAnimation $ proc () -> do sinewave :: Ani () sinewave = proc () -> do duration 10 -< () - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] - + emit -< toHtml $ mkBackground "black" idx <- signalOscillate 0 1 -< () emit -< do - defs_ $ clipPath_ [id_ "clip"] $ - rect_ [x_ "0", num_ y_ (-height), num_ width_ (idx * width), height_ "100%"] - g_ [transform_ $ translate margin height, clip_path_ "url(#clip)"] $ - renderPath $ approxFnData 1000 wave - line_ [ num_ x1_ margin, num_ x2_ margin, y1_ "10", y2_ "170" - , stroke_ "white"] - line_ [num_ x1_ margin, num_ x2_ (margin+width), num_ y1_ height, num_ y2_ height - , stroke_ "white"] - + defs_ $ clipPath_ [id_ "clip"] $ toHtml $ + mkRect (Num 0, Num (-height)) (Num $ idx*width) (Percent 100) + toHtml $ translate margin height $ withStrokeColor "white" $ + withClipPathRef (Ref "clip") $ mkPathText $ renderPathText $ approxFnData 1000 wave + toHtml $ withStrokeColor "white" $ + mkLine (Num margin, Num 10) (Num margin, Num 170) + toHtml $ withStrokeColor "white" $ + mkLine (Num margin, Num height) (Num (margin+width), Num height) let (circX, circY) = wave idx - emit -< g_ [transform_ $ translate margin height] $ + emit -< g_ [transform_ $ Lucid.translate margin height] $ circle_ [num_ cx_ circX, num_ cy_ circY, r_ "3", fill_ "red"] where freq = 3; margin = 30; width = 260; height = 90 @@ -114,22 +104,20 @@ sinewave = proc () -> do ## Morphing wave ```haskell -morph_wave :: Ani () -morph_wave = proc () -> do +morph_wave_circle :: Ani () +morph_wave_circle = proc t -> do duration 5 -< () - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] - - morph <- signalOscillate 0 1 -< () - emit -< do - g_ [transform_ $ translate 30 50] $ renderPath wave1 - g_ [transform_ $ translate 30 130] $ renderPath wave2 - g_ [transform_ $ translate 30 90] $ renderPath $ morphPath wave1 wave2 morph - line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"] - line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"] + idx <- signalOscillate 0 1 -< () + emit -< toHtml $ withStrokeColor "white" $ mkGroup + [ mkBackground "black" + , translate 30 90 $ mkPathText $ renderPathText $ morphPath circle wave1 idx + , mkLine (Num 30, Num 10) (Num 30, Num 170) + , mkLine (Num 30, Num 90) (Num 290, Num 90) ] where - freq = 3; width = 260 + freq = 5; width = 260; radius = 50 wave1 = approxFnData 1000 $ \idx -> (idx*width, sin (idx*pi*2*freq) * 20) - wave2 = approxFnData 1000 $ \idx -> (idx*width, sin (idx*pi*2*(freq*3)) * 20) + circle = approxFnData 1000 $ \idx -> + (cos (idx*pi*2+pi/2)*radius + width/2, sin (idx*pi*2+pi/2)*radius) ``` ![Morphing wave](gifs/morphwave.gif) @@ -239,12 +227,13 @@ latex_basic :: Ani () latex_basic = proc () -> do duration 2 -< () s <- signalOscillate 0 1 -< () - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] - emit -< - g_ [transform_ $ translate 20 15 <> " " <> scale 4 4] $ do - g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] text - g_ [fill_ "white", num_ fill_opacity_ s] text + emit -< toHtml $ mkGroup + [ mkBackground "black" + , translate (320/2) (180/2) $ mkGroup + [ withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.1) text + , withFillColor "white" $ withFillOpacity s text] ] where - text = latex "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" + text = scale 4 $ center $ latexAlign + "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" ``` ![Basic LaTeX](gifs/latex_basic.gif) diff --git a/gifs/latex_basic.gif b/gifs/latex_basic.gif index f261606..9db5629 100644 Binary files a/gifs/latex_basic.gif and b/gifs/latex_basic.gif differ diff --git a/gifs/latex_draw.gif b/gifs/latex_draw.gif index 8b5c0d3..ca6e114 100644 Binary files a/gifs/latex_draw.gif and b/gifs/latex_draw.gif differ diff --git a/reanimate.cabal b/reanimate.cabal index 70cdee3..e07f1a6 100644 --- a/reanimate.cabal +++ b/reanimate.cabal @@ -27,8 +27,8 @@ library Reanimate.Svg.NamedColors build-depends: base >=4.10 && <4.13, lucid-svg, time, text, unix, lucid, filepath, process, directory, - containers, svg-tree, xml, bytestring, lens, linear, mtl, matrix, - JuicyPixels + containers, svg-tree >= 0.6.2.3, xml, bytestring, lens, linear, mtl, matrix, + JuicyPixels, attoparsec Flag gtk-viewer Description: Enable gtk-based viewer @@ -52,7 +52,7 @@ executable reanimate-viewer Reanimate.Svg.NamedColors build-depends: base >=4.10 && <4.13, cairo >=0.13 && <0.14, gtk, svgcairo, lucid-svg, time, text, unix, lucid, reanimate, - filepath, process, directory, containers, svg-tree, xml, - bytestring, lens, linear, mtl, matrix,JuicyPixels + filepath, process, directory, containers, svg-tree >= 0.6.2.3, xml, + bytestring, lens, linear, mtl, matrix,JuicyPixels, attoparsec hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Reanimate/Examples.hs b/src/Reanimate/Examples.hs index 9023a26..cfb9ee4 100644 --- a/src/Reanimate/Examples.hs +++ b/src/Reanimate/Examples.hs @@ -10,7 +10,7 @@ import Codec.Picture.Types import Data.Monoid import Data.Monoid ((<>)) import Data.Text (Text, pack) -import qualified Graphics.Svg as S +import Graphics.Svg as S import Linear.V2 import Lucid.Svg (Svg, circle_, clip_path_, cx_, cy_, d_, id_, defs_, clipPath_, fill_, fill_opacity_, font_size_, g_, @@ -32,19 +32,17 @@ import Debug.Trace sinewave :: Ani () sinewave = proc () -> do duration 10 -< () - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] - + emit -< toHtml $ mkBackground "black" idx <- signalOscillate 0 1 -< () emit -< do - defs_ $ clipPath_ [id_ "clip"] $ - rect_ [x_ "0", num_ y_ (-height), num_ width_ (idx * width), height_ "100%"] - g_ [transform_ $ Lucid.translate margin height, clip_path_ "url(#clip)"] $ - renderPath $ approxFnData 1000 wave - line_ [ num_ x1_ margin, num_ x2_ margin, y1_ "10", y2_ "170" - , stroke_ "white"] - line_ [num_ x1_ margin, num_ x2_ (margin+width), num_ y1_ height, num_ y2_ height - , stroke_ "white"] - + defs_ $ clipPath_ [id_ "clip"] $ toHtml $ + mkRect (Num 0, Num (-height)) (Num $ idx*width) (Percent 100) + toHtml $ translate margin height $ withStrokeColor "white" $ + withClipPathRef (Ref "clip") $ mkPathText $ renderPathText $ approxFnData 1000 wave + toHtml $ withStrokeColor "white" $ + mkLine (Num margin, Num 10) (Num margin, Num 170) + toHtml $ withStrokeColor "white" $ + mkLine (Num margin, Num height) (Num (margin+width), Num height) let (circX, circY) = wave idx emit -< g_ [transform_ $ Lucid.translate margin height] $ circle_ [num_ cx_ circX, num_ cy_ circY, r_ "3", fill_ "red"] @@ -55,15 +53,14 @@ sinewave = proc () -> do morph_wave :: Ani () morph_wave = proc () -> do duration 5 -< () - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] - morph <- signalOscillate 0 1 -< () - emit -< do - g_ [transform_ $ Lucid.translate 30 50] $ renderPath wave1 - g_ [transform_ $ Lucid.translate 30 130] $ renderPath wave2 - g_ [transform_ $ Lucid.translate 30 90] $ renderPath $ morphPath wave1 wave2 morph - line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"] - line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"] + emit -< toHtml $ withStrokeColor "white" $ mkGroup + [ mkBackground "black" + , translate 30 50 $ mkPathText $ renderPathText wave1 + , translate 30 130 $ mkPathText $ renderPathText wave2 + , translate 30 90 $ mkPathText $ renderPathText $ morphPath wave1 wave2 morph + , mkLine (Num 30, Num 10) (Num 30, Num 170) + , mkLine (Num 30, Num 90) (Num 290, Num 90) ] where freq = 3; width = 260 wave1 = approxFnData 1000 $ \idx -> (idx*width, sin (idx*pi*2*freq) * 20) @@ -71,15 +68,13 @@ morph_wave = proc () -> do morph_wave_circle :: Ani () morph_wave_circle = proc t -> do - duration 5 -< () - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] - - idx <- signalOscillate 0 1 -< () - emit -< do - g_ [transform_ $ Lucid.translate 30 90] $ - renderPath $ morphPath circle wave1 idx - line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"] - line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"] + duration 5 -< () + idx <- signalOscillate 0 1 -< () + emit -< toHtml $ withStrokeColor "white" $ mkGroup + [ mkBackground "black" + , translate 30 90 $ mkPathText $ renderPathText $ morphPath circle wave1 idx + , mkLine (Num 30, Num 10) (Num 30, Num 170) + , mkLine (Num 30, Num 90) (Num 290, Num 90) ] where freq = 5; width = 260; radius = 50 wave1 = approxFnData 1000 $ \idx -> (idx*width, sin (idx*pi*2*freq) * 20) @@ -357,13 +352,14 @@ latex_basic :: Ani () latex_basic = proc () -> do duration 2 -< () s <- signalOscillate 0 1 -< () - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] - emit -< - g_ [transform_ $ Lucid.translate 20 15 <> " " <> Lucid.scale 4 4] $ do - g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] text - g_ [fill_ "white", num_ fill_opacity_ s] text + emit -< toHtml $ mkGroup + [ mkBackground "black" + , translate (320/2) (180/2) $ mkGroup + [ withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.1) text + , withFillColor "white" $ withFillOpacity s text] ] where - text = toHtml $ latexAlign "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" + text = scale 4 $ center $ latexAlign + "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" bezier :: Ani () bezier = adjustSpeed 0.4 $ proc () -> do @@ -428,28 +424,28 @@ pathSquare = proc () -> do latex_draw :: Ani () latex_draw = pauseAtEnd 1 $ defineAnimation $ proc () -> do - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] + emit -< toHtml $ mkBackground "black" drawText msg `andThen` fillText msg -< () where msg = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" - placement = g_ [transform_ $ Lucid.translate 20 15 <> " " <> Lucid.scale 5 5] + placement = translate (320/2) (180/2) . scale 5 fillText txt = defineAnimation $ proc () -> do duration 1 -< () s <- signal 0 1 -< () - emit -< placement $ - g_ [fill_ "white", num_ fill_opacity_ s] $ - toHtml $ latexAlign txt + emit -< toHtml $ placement $ + withFillColor "white" $ withFillOpacity s $ + center $ latexAlign txt drawText txt = defineAnimation $ proc () -> do duration 2 -< () s <- signal 0 1 -< () - emit -< placement $ - g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] $ - toHtml $ partialSvg s $ latexAlign txt + emit -< toHtml $ placement $ + withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.1) $ + partialSvg s $ center $ latexAlign txt bbox :: Ani () bbox = proc () -> do - emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"] + emit -< toHtml $ mkBackground "black" annotate' bbox1 -< g_ [transform_ $ Lucid.translate (320/2-50) (180/2)] annotate' bbox2 -< g_ [transform_ $ Lucid.translate (320/2+50) (180/2)] @@ -457,37 +453,28 @@ bbox1 :: Ani () bbox1 = defineAnimation $ proc () -> do duration 5 -< () s <- signal 0 1 -< () - let rotated = rotate (360*s) svg - (x, y, w, h) = boundingBox rotated emit -< do - g_ [transform_ $ Lucid.translate x y] $ - rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0"] - g_ [fill_ "white"] $ toHtml rotated + toHtml $ mkBoundingBox $ rotate (360*s) svg + toHtml $ withFillColor "white" $ rotate (360*s) svg where - msg = "\\sum_{k=1}^\\infty" - svg = scale 3 $ center $ latexAlign msg + svg = scale 3 $ center $ latexAlign "\\sum_{k=1}^\\infty" bbox2 :: Ani () bbox2 = defineAnimation $ proc () -> do duration 5 -< () s <- signalOscillate 0 1 -< () - let rotated = partialSvg s heartShape - (x, y, w, h) = boundingBox rotated emit -< do - toHtml $ withStrokeColor "red" $ withFillOpacity 0 $ - mkRect (S.Num x, S.Num y) (S.Num w) (S.Num h) - toHtml $ withStrokeColor "white" $ withFillOpacity 0 $ - rotated + toHtml $ mkBoundingBox $ partialSvg s heartShape + toHtml $ withStrokeColor "white" $ withFillOpacity 0 $ partialSvg s heartShape + +mkBoundingBox :: Tree -> Tree +mkBoundingBox svg = withStrokeColor "red" $ withFillOpacity 0 $ + mkRect (S.Num x, S.Num y) (S.Num w) (S.Num h) + where + (x, y, w, h) = boundingBox svg heartShape = - rotate 225 $ center $ p - where - p = S.PathTree $ S.defaultSvg & S.pathDefinition .~ cmds - abs = S.OriginAbsolute - rel = S.OriginRelative - cmds = - [S.MoveTo abs [V2 0 40] - ,S.VerticalTo rel [-40],S.HorizontalTo rel [40] - ,S.EllipticalArc rel [(20,20,90,False,True, V2 0 40)] - ,S.EllipticalArc rel [(20,20,90,False,True, V2 (-40) 0)] - ,S.EndPath] + rotate 225 $ center $ mkPathString + "M0.0,40.0 v-40.0 h40.0\ + \a20.0 20.0 90.0 0 1 0.0,40.0\ + \a20.0 20.0 90.0 0 1 -40.0,0.0 Z" diff --git a/src/Reanimate/Svg.hs b/src/Reanimate/Svg.hs index 5938feb..749ad07 100644 --- a/src/Reanimate/Svg.hs +++ b/src/Reanimate/Svg.hs @@ -4,10 +4,14 @@ import Codec.Picture (PixelRGBA8 (..)) import Control.Lens (over, set, (%~), (&), (.~), (^.)) import Control.Monad.Fix import Control.Monad.State +import Control.Arrow +import Data.Attoparsec.Text (parseOnly) import Data.List import qualified Data.Map as Map import Data.Maybe +import qualified Data.Text as T import Graphics.Svg +import Graphics.Svg.PathParser import Linear.Metric import Linear.V2 import Linear.Vector @@ -16,6 +20,9 @@ import qualified Reanimate.Transform as Transform import Debug.Trace +defaultDPI :: Dpi +defaultDPI = 96 + replaceUses :: Document -> Document replaceUses doc = doc & elements %~ map (mapTree replace) & definitions .~ Map.empty @@ -33,7 +40,6 @@ replaceUses doc = doc & elements %~ map (mapTree replace) case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of (Num a, Num b) -> Translate a b _ -> TransformUnknown - defaultDPI = 96 docTree = GroupTree $ set groupChildren (doc^.elements) defaultSvg idMap = foldTree updMap Map.empty docTree `Map.union` Map.mapMaybe elementToTree (doc^.definitions) @@ -319,12 +325,20 @@ svgBoundingPoints t = map (Transform.transformPoint m) $ PolyLineTree{} -> error "PolyLineTree" EllipseTree{} -> error "EllipseTree" LineTree{} -> error "LineTree" - RectangleTree{} -> error "RectangleTree" + RectangleTree rect -> + -- toUserUnit defaultDPI x + case mapTuple (toUserUnit defaultDPI) (rect^.rectUpperLeftCorner) of + (Num x, Num y) -> [V2 x y] ++ + case mapTuple (toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of + (Num w, Num h) -> [V2 (x+w) (y+h)] + _ -> [] + _ -> [] TextTree{} -> [] ImageTree{} -> [] MeshGradientTree{} -> [] where m = Transform.mkMatrix (t^.drawAttr.transform) + mapTuple f = f *** f withTransformations :: [Transformation] -> Tree -> Tree withTransformations transformations = withDrawAttributes (transform .~ Just transformations) @@ -365,14 +379,41 @@ mkColor name = withStrokeColor :: String -> Tree -> Tree withStrokeColor color = withDrawAttributes (strokeColor .~ pure (mkColor color)) +withFillColor :: String -> Tree -> Tree +withFillColor color = withDrawAttributes (fillColor .~ pure (mkColor color)) + withFillOpacity :: Double -> Tree -> Tree withFillOpacity opacity = withDrawAttributes (fillOpacity .~ Just (realToFrac opacity)) withStrokeWidth :: Number -> Tree -> Tree withStrokeWidth width = withDrawAttributes (strokeWidth .~ pure width) +withClipPathRef :: ElementRef -> Tree -> Tree +withClipPathRef ref = withDrawAttributes (clipPathRef .~ pure ref) + mkRect :: Point -> Number -> Number -> Tree -mkRect corner width height = RectangleTree $ - defaultSvg & rectUpperLeftCorner .~ corner - & rectWidth .~ width - & rectHeight .~ height +mkRect corner width height = RectangleTree $ defaultSvg + & rectUpperLeftCorner .~ corner + & rectWidth .~ width + & rectHeight .~ height + +mkLine :: Point -> Point -> Tree +mkLine point1 point2 = LineTree $ defaultSvg + & linePoint1 .~ point1 + & linePoint2 .~ point2 + +mkGroup :: [Tree] -> Tree +mkGroup forest = GroupTree $ defaultSvg + & groupChildren .~ forest + +mkPathString :: String -> Tree +mkPathString = mkPathText . T.pack + +mkPathText :: T.Text -> Tree +mkPathText str = + case parseOnly pathParser str of + Left err -> error err + Right cmds -> PathTree $ defaultSvg & pathDefinition .~ cmds + +mkBackground :: String -> Tree +mkBackground color = withFillColor color $ mkRect (Num 0, Num 0) (Percent 100) (Percent 100) diff --git a/stack.yaml b/stack.yaml index 2189571..a5b1dea 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,4 +7,4 @@ extra-deps: - gtk-0.15.0@sha256:a76d280dbeefbe08cf021c31bcd51c09cda97ebee7934debbfc14e1da4220b78 - svgcairo-0.13.1.1@sha256:145b6acce7306e84652376efb3f00e9194ccd8787a62d3f93fb539c4a3382a2e - lucid-svg-0.7.0.0@sha256:2a2d0fe51329e8b89f723a8e86e6ab8d150d7b205591fffe4c09d8d11e022f98 - +- svg-tree-0.6.2.3