Improve README examples (#68)

- Move examples higher, above any technical details.
- Use a consistent off-white background color.
- Use more interesting and less trivial examples.
- Play at 50fps rather than 25fps.
- Host offsite (imgur) as to not take up repo space.
- Link to source file for each example.

Former-commit-id: 7e62a3a1ca99e9abc5781568ff920066c94783ee

examples/demo_tangent.hs

@@ -0,0 +1,110 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+{-# LANGUAGE OverloadedStrings #-}
+module Main(main) where
+
+import           Control.Lens                    ((^.))
+import           Control.Monad.State
+import qualified Data.Vector.Unboxed             as V
+import           Geom2D.CubicBezier              (AnyBezier (..), Point (..),
+                                                  evalBezierDeriv)
+import           Graphics.SvgTree                (Coord, Tree (..), mapTree,
+                                                  pathDefinition)
+import           Linear.Metric
+import           Linear.V2                       (V2 (..))
+import           Linear.Vector
+import           Reanimate
+import           Reanimate.Builtin.Documentation
+
+main :: IO ()
+main = reanimate $ docEnv $ mkAnimation 30 $ \t ->
+  let piSvg = pathify $ lowerTransformations $ center $ scale 10 $ latex "s" in
+  mkGroup
+  [ mkBackgroundPixel rtfdBackgroundColor
+  , piSvg
+  , drawTangent t piSvg ]
+
+drawTangent :: Double -> SVG -> SVG
+drawTangent alpha | alpha >= 1 = id
+drawTangent alpha = mapTree worker
+  where
+    worker (PathTree path) =
+      let (V2 posX posY, tangent) =
+            atPartial alpha $ toLineCommands $ path^.pathDefinition
+          normed@(V2 tangentX tangentY) = normalize tangent ^* 4
+          V2 midX midY = lerp 0.5 0 normed
+          V2 normVectX normVectY = normalize tangent ^* (svgWidth normalTxt*1.1)
+          tangentSvg =
+            translate (posX) (posY) $
+            rotate (unangle normed/pi*180 + 180) $
+            translate 0 (svgHeight tangentTxt/2) $
+            tangentTxt
+          normalSvg =
+            translate (posX) (posY) $
+            rotate (unangle normed/pi*180 + 90) $
+            translate (svgWidth normalTxt/2*1.1) (svgHeight normalTxt/2*1.3) $
+            normalTxt
+      in mkGroup
+      [ withStrokeWidth (defaultStrokeWidth) $
+        withStrokeColor "black" $
+        translate (posX-midX) (posY-midY) $
+        mkLine (0, 0) (tangentX, tangentY)
+      , withStrokeWidth (defaultStrokeWidth) $
+        withStrokeColor "black" $
+        translate (posX) (posY) $
+        mkLine (0, 0) (-normVectY, normVectX)
+      , withStrokeWidth (defaultStrokeWidth*2) $
+        withStrokeColor "white" $
+        tangentSvg
+      , withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0 $
+        tangentSvg
+      , withStrokeWidth (defaultStrokeWidth*2) $
+        withStrokeColor "white" $
+        normalSvg
+      , withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0 $
+        normalSvg
+      ]
+    worker t = t
+    tangentTxt = scale 1.1 $ center $ latex "tangent"
+    normalTxt = scale 1.1 $ center $ latex "normal"
+
+atPartial :: Double -> [LineCommand] -> (V2 Double, V2 Double)
+atPartial alpha cmds = evalState (worker 0 cmds) zero
+  where
+    worker _d [] = pure (0, 0)
+    worker d (cmd:xs) = do
+      from <- get
+      len <- lineLength cmd
+      let frac = (targetLen-d) / len
+      if len == 0 || frac >= 1
+        then worker (d+len) xs
+        else do
+          let bezier = lineCommandToBezier from cmd
+              (pos, tangent) = evalBezierDeriv bezier frac
+          pure $ (fromPoint pos, fromPoint tangent)
+    totalLen = evalState (sum <$> mapM lineLength cmds) zero
+    targetLen = totalLen * alpha
+
+lineCommandToBezier :: V2 Coord -> LineCommand -> AnyBezier Coord
+lineCommandToBezier from line =
+  case line of
+    LineBezier [a] ->
+      AnyBezier $ V.fromList [toTuple from, toTuple a]
+    LineBezier [a,b] ->
+      AnyBezier $ V.fromList [toTuple from, toTuple a, toTuple b]
+    LineBezier [a,b,c] ->
+      AnyBezier $ V.fromList [toTuple from, toTuple a, toTuple b, toTuple c]
+    _ -> error (show line)
+
+fromPoint :: Point a -> V2 a
+fromPoint (Point x y) = V2 x y
+
+toTuple :: V2 a -> (a,a)
+toTuple (V2 x y) = (x, y)
+
+unangle :: (Floating a, Ord a) => V2 a -> a
+unangle a@(V2 ax ay) =
+  let alpha = asin $ ay / norm a
+  in if ax < 0
+       then pi - alpha
+       else alpha

examples/tut_glue_fourier.hs

@@ -12,8 +12,9 @@ import           Codec.Picture
 
 -- layer 3
 main :: IO ()
-main = reanimate $ parA bg $ sceneAnimation $ do
-    play $ fourierA (fromToS 0 15)      -- Rotate 15 times
+main = reanimate $ setDuration 30 $ sceneAnimation $ do
+    _ <- newSpriteSVG $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
+    play $ fourierA (fromToS 0 5)      -- Rotate 15 times
       # setDuration 50
       # signalA (reverseS . powerS 2 . reverseS) -- Start fast, end slow
       # pauseAtEnd 2
@@ -22,8 +23,6 @@ main = reanimate $ parA bg $ sceneAnimation $ do
       # reverseA
       # signalA (powerS 2)                       -- Start slow, end fast
       # pauseAtEnd 2
-  where
-    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
 
 -- layer 2
 fourierA :: (Double -> Double) -> Animation

examples/tut_glue_latex.hs

@@ -25,7 +25,7 @@ latexExample = sceneAnimation $ do
     -- Draw equation
     play $ drawAnimation strokedSvg
     sprites <- forM glyphs $ \(fn, _, elt) ->
-      newSpriteA $ animate $ const $ fn elt
+      newSpriteSVG $ fn elt
     -- Yoink each glyph
     forM_ (reverse sprites) $ \sprite -> do
       spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)

examples/tut_glue_potrace.hs

@@ -18,13 +18,10 @@ main = reanimate $ parA bg $ sceneAnimation $ do
     xRot <- newVar (-45)
     yRot <- newVar 220
     wf <- newSprite $ wireframe <$> unVar xRot <*> unVar yRot
-    tweenVar yRot spinDur (\t v -> fromToS v (v+60*3) $ curveS 2 (t/spinDur))
+    fork $ tweenVar yRot spinDur $ \v -> fromToS v (v+60*3) . curveS 2
     replicateM_ wobbles $ do
-      tweenVar xRot (wobbleDur/2) (\t v -> fromToS v (v+90) $ curveS 2 (t/(wobbleDur/2)))
-      fork $ do
-        wait (wobbleDur/2)
-        tweenVar xRot (wobbleDur/2) (\t v -> fromToS v (v-90) $ curveS 2 (t/(wobbleDur/2)))
-      wait wobbleDur
+      tweenVar xRot (wobbleDur/2) $ \v -> fromToS v (v+90) . curveS 2
+      tweenVar xRot (wobbleDur/2) $ \v -> fromToS v (v-90) . curveS 2
     destroySprite wf
     play $ mkAnimation drawDuration (\t -> partialSvg t (wireframe (-45) 220))
       # reverseA

examples/tut_glue_povray.hs

@@ -22,7 +22,8 @@ import           System.Random.Shuffle
 
 
 main :: IO ()
-main = reanimate $ parA bg $ sceneAnimation $ do
+main = reanimate $ sceneAnimation $ do
+    newSpriteSVG $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF
     zPos <- newVar 0
     xRot <- newVar 0
     zRot <- newVar 0
@@ -41,8 +42,6 @@ main = reanimate $ parA bg $ sceneAnimation $ do
     fork $ tweenVar zRot 9 $ \v -> fromToS v 360 . curveS 2
     wait 10
     tweenVar zPos 2 $ \v -> fromToS v 0 . curveS 3
-  where
-    bg = animate $ const $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF
 
 texture :: Double -> SVG
 texture t = frameAt (t*duration latexExample) latexExample
@@ -92,7 +91,7 @@ latexExample = sceneAnimation $ do
     -- Draw equation
     play $ drawAnimation strokedSvg
     sprites <- forM glyphs $ \(fn, _, elt) ->
-      newSpriteA $ animate $ const $ fn elt
+      newSpriteSVG $ fn elt
     -- Yoink each glyph
     forM_ (reverse sprites) $ \sprite -> do
       spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)