Better latex example and a few bug fixes.

Former-commit-id: c08f4f7b31996b8a6672a91d86724ea57869d043

docs/gallery.md

@@ -226,3 +226,18 @@ This file is auto-generated by docs/render_all.sh. DO NOT EDIT.
 
 <br/><hr><br/>
 
+## tut_glue_latex
+
+<details>
+  <summary>View tut_glue_latex.hs</summary>
+  <pre><code class="haskell">
+  {!examples/tut_glue_latex.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_latex.mp4">
+</video>
+
+<br/><hr><br/>
+

docs/gen_gallery.sh

@@ -4,7 +4,7 @@ ROOT=`stack path --project-root`
 EXAMPLES='boundingbox colormaps goo latex_basic latex_color latex_draw
           latex_wheel raster sphere blender_default_cube
           tut_glue_svg tut_glue_animate tut_glue_keyframe tut_glue_fourier
-          tut_glue_physics'
+          tut_glue_physics tut_glue_latex'
 
 WIDTH=640
 HEIGHT=$((WIDTH*9/16))

docs/glue_tut.md

@@ -105,6 +105,19 @@ TODO: Show that LaTeX is a provider of SVG graphics. It has the type
       'latex :: Text -> SVG'. Caching is automatic and it plays well with
       other SVG functions (partialSvg, center, etc).
 
+
+<details>
+  <summary>Toggle source code.</summary>
+  <pre><code class="haskell">
+  {!examples/tut_glue_latex.hs!}
+  </code></pre>
+</details>
+<br/>
+<video width="640" height="360" autoplay loop>
+  <source src="../rendered/tut_glue_latex.mp4">
+  <source src="https://github.com/Lemmih/reanimate/raw/master/docs/rendered/tut_glue_latex.mp4">
+</video>
+
 ## Pillar III: potrace
 
 ## Pillar IV: Povray

examples/tut_glue_latex.hs

@@ -0,0 +1,92 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+
+import           Codec.Picture
+import           Codec.Picture.Types
+import           Control.Lens          ((^.))
+import           Control.Monad
+import           Data.Monoid
+import           Graphics.SvgTree
+import           Linear.V2
+import           Reanimate
+import           Reanimate.Animation
+import           Reanimate.Effect
+import           Reanimate.Scene
+import           System.Random
+import           System.Random.Shuffle
+
+main :: IO ()
+main = reanimate $ parA bg $ sceneAnimation $ do
+    -- Draw equation
+    play $ drawAnimation strokedSvg
+    sprites <- forM glyphs $ \(fn, _, elt) ->
+      newSpriteA $ animate $ const $ fn elt
+    -- Yoink each glyph
+    forM_ (reverse sprites) $ \sprite -> do
+      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)
+      wait 0.1
+    wait 0.5
+    mapM_ destroySprite sprites
+    -- Undraw equations
+    play $ drawAnimation' (Just 0xdeadbeef) 1 0.1 strokedSvg
+      # reverseA
+  where
+    glyphs = svgGlyphs svg
+    strokedSvg =
+      withStrokeWidth (defaultStrokeWidth*0.5) $
+      withStrokeColor "black" svg
+    svg = lowerTransformations $ simplify $ scale 2 $ center $
+      latexAlign "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
+    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
+    shuffleList lst = shuffle' lst (length lst) (mkStdGen 0xdeadbeef)
+
+highlightE :: Effect
+highlightE d t =
+  scale (1 + bellS 2 (t/d)*0.5) . rotate (wiggleS (t/d) * 20)
+
+flashE :: Effect
+flashE d t =
+  withStrokeColor "black" .
+  withStrokeWidth (defaultStrokeWidth*0.5*bellS 2 (t/d)) .
+  withFillColorPixel (promotePixel $ turbo (t/d))
+
+-- s-curve, sin, s-curve
+wiggleS :: Signal
+wiggleS t
+  | t < 0.25  = curveS 2 (t*4)
+  | t < 0.75  = sin ((t-0.25)*2*pi+pi/2)
+  | otherwise = curveS 2 ((t-0.75)*4)-1
+
+--
+
+drawAnimation :: SVG -> Animation
+drawAnimation = drawAnimation' Nothing 0.5 0.3
+
+drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation
+drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do
+  forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do
+    let sWidth =
+          case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of
+            Just (Num d) -> d
+            _            -> defaultStrokeWidth
+    fork $ do
+      wait (n*step)
+      play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
+        # applyE (overEnding fillDur $ fadeLineOutE sWidth))
+    fork $ do
+      wait (n*step+(1-fillDur))
+      newSprite $ do
+        return $ \_real_t d t ->
+          withStrokeWidth 0 $ fn $ withFillOpacity (min 1 $ t/fillDur) tree
+  where
+    shuf lst =
+      case mbSeed of
+        Nothing -> lst
+        Just seed -> shuffle' lst (length lst) (mkStdGen seed)
+    len = fromIntegral $ length $ svgGlyphs svg

examples/tut_glue_physics.hs

@@ -5,68 +5,56 @@
 module Main (main) where
 
 import           Chiphunk.Low
-import           Control.Monad
+import           Codec.Picture       (PixelRGBA8 (..))
+import           Control.Monad       (forM_)
 import           Graphics.SvgTree    (Tree)
-import           Linear.V2
-import           Reanimate.Chiphunk
+import           Linear.V2           (V2 (..))
 import           Reanimate
+import           Reanimate.Chiphunk
 import           Reanimate.PolyShape
-import           System.IO.Unsafe
-import           Codec.Picture
+import           Reanimate.Signal
+import           System.IO.Unsafe    (unsafePerformIO)
 
-test :: Animation
-test = unsafePerformIO $ do
-  bodyStore <- newBodyStore
-  let gravity = Vect 0 (-1)
+shatter :: Animation
+shatter = unsafePerformIO $ do
+    bodyStore <- newBodyStore
+    let gravity = Vect 0 (-1) -- Gravity points down (negative 1 y/s^2)
 
-  -- Create an empty space.
-  space <- spaceNew
-  -- spaceCollisionSlop space $= (screenWidth/2560)
-  spaceGravity space $= gravity
+    space <- spaceNew
+    spaceGravity space $= gravity
 
-  static <- get $ spaceStaticBody space
-  ground <- segmentShapeNew static
-    (Vect (-screenWidth/2) (-screenHeight/2))
-    (Vect (screenWidth/2) (-screenHeight/2)) 0
-  shapeFriction ground $= 1
-  spaceAddShape space ground
-  shapeElasticity ground $= 1
+    static <- get $ spaceStaticBody space
+    ground <- segmentShapeNew static
+      (Vect (-screenWidth/2) (-screenHeight/2))
+      (Vect (screenWidth/2) (-screenHeight/2)) 0
+    shapeFriction ground $= 1
+    spaceAddShape space ground
 
-  let toVect (V2 x y) = Vect x y
+    let toVect (V2 x y) = Vect x y
+        vectGroup = plDecompose $ svgToPolyShapes $ center $ scale 4 $
+          latex "$F=ma$"
 
-  let svg = center $ scale 4 $ latex "$F=ma$"
-      poly = svgToPolyShapes svg
-      vectGroup = plDecompose poly
-
-  forM_ vectGroup $ \polygon -> do
-    bd <- polygonsToBody space [map toVect polygon]
-    bodyPosition bd $= Vect 0 (screenHeight/3)
-    addToBodyStore bodyStore bd $
-      renderPolyShape $ plFromPolygon polygon
-
-  ani <- simulate space bodyStore 60 10 10
-  spaceFreeRecursive space
-  return ani
-
-
-chunkPolyshapes :: Tree -> Tree
-chunkPolyshapes t =
-  mkGroup
-  [
-    withStrokeWidth 0.01 $
-    withStrokeColor "black" $
-    -- withFillOpacity 0 $
-    withFillColor "black" $
-    mkGroup $ map renderPolyShape $
-    svgToPolyShapes t
-  ]
-
-reorient :: Tree -> Tree
-reorient = id -- scale 6 . translate 0 (-0.9)
+    forM_ vectGroup $ \polygon -> do
+      bd <- polygonsToBody space [map toVect polygon]
+      bodyPosition bd $= Vect 0 (screenHeight/3)
+      addToBodyStore bodyStore bd $
+        renderPolyShape $ plFromPolygon polygon
 
+    ani <- simulate space bodyStore fps stepsPerFrame shatterT
+    spaceFreeRecursive space
+    return $ mapA pp ani
+  where
+    shatterT = 10
+    fps = 60
+    stepsPerFrame = 10
+    pp = withStrokeWidth 0.01 . withStrokeColor "black" . withFillColor "black"
 
 main :: IO ()
-main = reanimate $ bg `parA` mapA reorient (mapA chunkPolyshapes test)
+main = reanimate $ parA bg $ sceneAnimation $ do
+    play $ shatter
+    play $ shatter
+      # reverseA
+      # setDuration 5
+      # signalA (powerS 2)
   where
     bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
-

src/Reanimate/Effect.hs

@@ -60,3 +60,6 @@ scaleE target d t = scale (1 + (target-1) * t/d)
 
 translateE :: Double -> Double -> Effect
 translateE x y d t = translate (x * t/d) (y * t/d)
+
+aroundCenterE :: Effect -> Effect
+aroundCenterE e d t = aroundCenter (e d t)

src/Reanimate/Scene.hs

@@ -66,7 +66,7 @@ sceneAnimation action =
                   | (startT, a, z) <- tl
                   ]
     genFns <- sequence gens
-    return $ anis `parA` mkAnimation dur (\t ->
+    return $ anis `parDropA` mkAnimation dur (\t ->
       mkGroup $
       map fst $
       sortBy (comparing snd)

src/Reanimate/Svg/Constructors.hs

@@ -28,10 +28,18 @@ rotateAround a (V2 x y) = withTransformations [Rotate a (Just (x,y))]
 
 rotateAroundCenter :: Double -> Tree -> Tree
 rotateAroundCenter a t =
-    rotateAround a (V2 (x+w/h) (y+h/2)) t
+    rotateAround a (V2 (x+w/2) (y+h/2)) t
   where
     (x,y,w,h) = boundingBox t
 
+aroundCenter :: (Tree -> Tree) -> Tree -> Tree
+aroundCenter fn t =
+    translate (-offsetX) (-offsetY) $ fn $ translate offsetX offsetY t
+  where
+    offsetX = -x-w/2
+    offsetY = -y-h/2
+    (x,y,w,h) = boundingBox t
+
 scale :: Double -> Tree -> Tree
 scale a = withTransformations [Scale a Nothing]
 
@@ -207,4 +215,3 @@ mkText str =
     & fontSize .~ pure (Num 2)
   where
     span_ = defaultSvg & spanContent .~ [SpanText str]
-