Begin introduction to reanimate.

Former-commit-id: aae07ee92e90626de681be94689adf206fc782b8

docs/gallery.md

@@ -151,3 +151,33 @@ This file is auto-generated by docs/render_all.sh. DO NOT EDIT.
 
 <br/><hr><br/>
 
+## tut_glue_svg
+
+<details>
+  <summary>View tut_glue_svg.hs</summary>
+  <pre><code class="haskell">
+  {!examples/tut_glue_svg.hs!}
+  </code></pre>
+</details>
+<br/>
+<video width="640" height="360" autoplay loop>
+  <source src="https://github.com/Lemmih/reanimate/raw/master/docs/rendered/tut_glue_svg.mp4">
+</video>
+
+<br/><hr><br/>
+
+## tut_glue_animate
+
+<details>
+  <summary>View tut_glue_animate.hs</summary>
+  <pre><code class="haskell">
+  {!examples/tut_glue_animate.hs!}
+  </code></pre>
+</details>
+<br/>
+<video width="640" height="360" autoplay loop>
+  <source src="https://github.com/Lemmih/reanimate/raw/master/docs/rendered/tut_glue_animate.mp4">
+</video>
+
+<br/><hr><br/>
+

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))

examples/glue_tut_animate.hs

@@ -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)

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)

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
+  ]

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