From 0da599d563f8ddfec7a7dbb85c6d3d9880d20c99 Mon Sep 17 00:00:00 2001 From: David Himmelstrup Date: Sun, 1 Dec 2019 14:04:01 +0800 Subject: [PATCH] Begin introduction to reanimate. Former-commit-id: aae07ee92e90626de681be94689adf206fc782b8 --- docs/gallery.md | 30 ++++++++++++++++++++ docs/gen_gallery.sh | 3 +- examples/glue_tut_animate.hs | 48 ------------------------------- examples/tut_glue_animate.hs | 55 ++++++++++++++++++++++++++++++++++++ examples/tut_glue_svg.hs | 43 ++++++++++++++++++++++++++++ src/Reanimate/Scene.hs | 20 +++++++++++++ 6 files changed, 150 insertions(+), 49 deletions(-) delete mode 100644 examples/glue_tut_animate.hs create mode 100644 examples/tut_glue_animate.hs create mode 100755 examples/tut_glue_svg.hs diff --git a/docs/gallery.md b/docs/gallery.md index dc5fc70..a192809 100644 --- a/docs/gallery.md +++ b/docs/gallery.md @@ -151,3 +151,33 @@ This file is auto-generated by docs/render_all.sh. DO NOT EDIT.

+## tut_glue_svg + +
+ View tut_glue_svg.hs + 

+  {!examples/tut_glue_svg.hs!}
+
+
+
+ + +

+ +## tut_glue_animate + +
+ View tut_glue_animate.hs + 

+  {!examples/tut_glue_animate.hs!}
+
+
+
+ + +

+ diff --git a/docs/gen_gallery.sh b/docs/gen_gallery.sh index 4472595..e5c81d2 100755 --- a/docs/gen_gallery.sh +++ b/docs/gen_gallery.sh @@ -2,7 +2,8 @@ ROOT=`stack path --project-root` EXAMPLES='boundingbox colormaps goo latex_basic latex_color latex_draw - latex_wheel raster sphere blender_default_cube' + latex_wheel raster sphere blender_default_cube + tut_glue_svg tut_glue_animate' WIDTH=640 HEIGHT=$((WIDTH*9/16)) diff --git a/examples/glue_tut_animate.hs b/examples/glue_tut_animate.hs deleted file mode 100644 index 448e4fc..0000000 --- a/examples/glue_tut_animate.hs +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/env stack --- stack runghc --package reanimate -{-# LANGUAGE OverloadedStrings #-} -module Main(main) where - -import Reanimate -import Reanimate.Builtin.Documentation -import Reanimate.Builtin.Images - -main :: IO () -main = reanimate $ bg `parA` (animateCircleR `seqA` animateCircleP `seqA` animateRectR) - --(animateLogo) - where - bg = animate $ const $ mkBackground "white" - -animateCircleR :: Animation -animateCircleR = mkAnimation 2 $ \t -> env $ - mkGroup - [ mkCircle (t*2) - , withStrokeWidth 0 $ translate 0 3 $ scale 2 $ - center $ latex "radius = t" ] - -animateCircleP :: Animation -animateCircleP = mkAnimation 2 $ \t -> env $ - mkGroup - [ partialSvg t (pathify $ mkCircle 2) - , withStrokeWidth 0 $ translate 0 3 $ scale 2 $ - center $ latex "$\\% = t$" ] - -animateRectR :: Animation -animateRectR = mkAnimation 2 $ \t -> env $ - mkGroup - [ rotate (t*360) $ mkRect 4 2 - , withStrokeWidth 0 $ translate 0 3 $ scale 2 $ - center $ latex "rotation = t" ] - -animateLogo :: Animation -animateLogo = mkAnimation 2 $ \t -> env $ - mkGroup - [ partialSvg t haskellLogo - , withStrokeWidth 0 $ translate 0 3 $ scale 2 $ - center $ latex "$\\% = t%" ] - -env :: SVG -> SVG -env = - withStrokeColor "red" . - withFillColor "black" . - withStrokeWidth (defaultStrokeWidth*2) diff --git a/examples/tut_glue_animate.hs b/examples/tut_glue_animate.hs new file mode 100644 index 0000000..0e4504b --- /dev/null +++ b/examples/tut_glue_animate.hs @@ -0,0 +1,55 @@ +#!/usr/bin/env stack +-- stack runghc --package reanimate +{-# LANGUAGE OverloadedStrings #-} +module Main(main) where + +import Codec.Picture.Types +import Data.Text (Text) +import Reanimate +import Reanimate.Animation +import Reanimate.Effect +import Reanimate.Scene + +bgColor :: String +bgColor = "white" + +segmentDuration :: Double +segmentDuration = 3 + +transitionTime :: Double +transitionTime = 0.5 + +main :: IO () +main = reanimate $ bg `parA` + transitions fadeInE fadeOutE transitionTime + [animateCircleR, animateCircleP, animateRectR, animateColor + ,signalA (constantS 0) $ setDuration transitionTime animateCircleR] + where + bg = animate $ const $ mkBackground bgColor + +animateCircleR :: Animation +animateCircleR = mkSegment "radius" $ \t -> mkCircle (t*2) + +animateCircleP :: Animation +animateCircleP = mkSegment "drawn" $ \t -> + withFillOpacity 0 $ partialSvg t (pathify $ mkCircle 2) + +animateRectR :: Animation +animateRectR = mkSegment "rotation" $ \t -> rotate (t*360) $ mkRect 4 2 + +animateColor :: Animation +animateColor = mkSegment "color" $ \t -> + withFillColorPixel (promotePixel $ turbo t) $ mkRect 4 2 + +mkSegment :: Text -> (Time -> SVG) -> Animation +mkSegment label gen = mkAnimation segmentDuration $ \t -> env $ + mkGroup + [ gen t + , withStrokeWidth 0 $ translate 0 3 $ scale 2 $ + center $ latex label ] + +env :: SVG -> SVG +env = + withStrokeColor "red" . + withFillColor "black" . + withStrokeWidth (defaultStrokeWidth*2) diff --git a/examples/tut_glue_svg.hs b/examples/tut_glue_svg.hs new file mode 100755 index 0000000..7fba7bc --- /dev/null +++ b/examples/tut_glue_svg.hs @@ -0,0 +1,43 @@ +#!/usr/bin/env stack +-- stack runghc --package reanimate +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Data.Text (Text) +import Reanimate +import Reanimate.Builtin.Images +import Reanimate.Effect +import Reanimate.Scene + +bgColor :: String +bgColor = "white" + +framePause :: Double +framePause = 3 + +transitionTime :: Double +transitionTime = 0.5 + +main :: IO () +main = reanimate $ bg `parA` transitions fadeInE fadeOutE transitionTime + [comp1, comp2, comp3, comp4, comp5, setDuration transitionTime comp1] + where + bg = animate $ const $ mkBackground bgColor + comp1 = svgComponent "Circles" (mkCircle 2) + comp2 = svgComponent "Rects" (mkRect 4 3) + comp3 = svgComponent "Lines" (mkLine (-2,0) (2,0)) + comp4 = svgComponent "Images" (scale 0.5 svgLogo) + comp5 = svgComponent "Paths" $ + withFillOpacity 0 $ + scale 8 $ withStrokeWidth (defaultStrokeWidth*0.3) $ + center $ latex "$\\pi$" + +svgComponent :: Text -> SVG -> Animation +svgComponent txt svg = mkAnimation framePause $ const $ + mkGroup + [ translate 0 (-1) $ + withStrokeWidth (defaultStrokeWidth*2) $ + withStrokeColor "red" $ withFillColor "black" svg + , translate 0 3 $ + withFillColor "black" $ scale 2 $ center $ latex txt + ] diff --git a/src/Reanimate/Scene.hs b/src/Reanimate/Scene.hs index 001a0a7..2a9ea45 100644 --- a/src/Reanimate/Scene.hs +++ b/src/Reanimate/Scene.hs @@ -351,3 +351,23 @@ spriteE :: Sprite s -> Effect -> Scene s () newBlock :: Var s Position -> Number -> Scene s (Sprite s) -} + + +-- FIXME: Move this somewhere more appropriate +transition :: Effect + -> Effect + -> Double + -> Animation + -> Animation + -> Animation +transition tIn tOut tT a b = sceneAnimation $ do + fork $ play $ a + # applyE (overEnding tT $ tOut) + wait (duration a - tT) + play $ b + # applyE (overBeginning tT $ tIn) + +transitions :: Effect -> Effect -> Double -> [Animation] -> Animation +transitions _ _ _ [] = pause 0 +transitions tIn tOut tT (x:xs) = + foldl (transition tIn tOut tT) x xs