Improve haddock documentation. (#20)

* Improve CLI help message.

* Change hackage badge color.

* Add supported platforms.

* Add 'signalOscillate'

* Split SVG module into smaller parts.

Former-commit-id: ad62a06a5442912f6bd0be0e10d02fe53345b846

videos/bakers-algorithm/bakers-algorithm.hs

@@ -9,7 +9,7 @@ import           Control.Lens
 import           Graphics.SvgTree
 import           Reanimate.Driver (reanimate)
 import           Reanimate.LaTeX
-import           Reanimate.Monad
+import           Reanimate.Animation
 import           Reanimate.Svg
 import           Reanimate.Signal
 
@@ -29,40 +29,44 @@ run out.
 -}
 main :: IO ()
 main = reanimate $ pauseAtEnd 2
-  (mkAnimation 0 $ emit $ mkBackground "black") `sim`
+  (animate $ const $ mkBackground "black") `sim`
   drawBox
 
 drawBox :: Animation
-drawBox = mkAnimation 5 $ do
-  emit $ withFillColor "white" $
+drawBox = mkAnimation 5 $ \t ->
+  mkGroup
+  [ withFillColor "white" $
     translate 0 (-70) $
     scale 2 $ center $ latex "Baker's Algorithm"
-  s <- getSignal $ signalFromList    [(0.7, signalFlat 0), (1, signalLinear)]
-  d <- getSignal $ signalFromList    [(0.7, signalFlat 0), (1, signalLinear)]
-  draw <- getSignal $ signalFromList [(0.5, signalLinear), (1, signalFlat 1)]
-  let mlc = MemoryLineChart
-        { mlcWidth = 230
-        , mlcHeight = 50 + s*50
-        , mlcDivider = d
-        , mlcOuterBox = draw }
-  emit $ translate 0 20 $ renderMemoryLineChart mlc
+  , let s    = signalFromList    [(0.7, signalFlat 0), (1, signalLinear)] t
+        d    = signalFromList    [(0.7, signalFlat 0), (1, signalLinear)] t
+        draw = signalFromList [(0.5, signalLinear), (1, signalFlat 1)] t
+        mlc  = MemoryLineChart
+               { mlcWidth = 230
+               , mlcHeight = 50 + s*50
+               , mlcDivider = d
+               , mlcOuterBox = draw }
+    in translate 0 20 $ renderMemoryLineChart mlc
+  ]
 
 highlightBox :: Animation
-highlightBox = mkAnimation 2 $ do
-  emit $ withFillColor "white" $
+highlightBox = mkAnimation 2 $ \t ->
+  mkGroup
+  [ withFillColor "white" $
     translate 0 (-70) $
     scale 2 $ center $ latex "Highlightbox"
-  let boxX = negate mlcWidth / 2
-      boxY = negate mlcHeight / 2
-      mlcWidth = 230
-      mlcHeight = 50
-  s <- getSignal $ signalFromList    [(0.0, signalFlat 0), (1, signalBell 2)]
-  emit $
+  , let boxX = negate mlcWidth / 2
+        boxY = negate mlcHeight / 2
+        mlcWidth = 230
+        mlcHeight = 50
+        s = signalFromList [(0.0, signalFlat 0), (1, signalBell 2)] t
+    in
     withStrokeColor "white" $
-    withStrokeWidth (Num $ 0.5 + s) $
+    withStrokeWidth (0.5 + s) $
     withFillOpacity 0 $
     translate (boxX + mlcWidth/2) (boxY + mlcHeight/2) $
-    mkRect (Num mlcWidth) (Num mlcHeight)
+    mkRect mlcWidth mlcHeight
+  ]
 
 data MemoryLineChart = MemoryLineChart
   { mlcWidth  :: Double
@@ -80,15 +84,15 @@ mlcBox MemoryLineChart{..} = (boxX, boxY, mlcWidth, mlcHeight)
 renderMemoryLineChart :: MemoryLineChart -> Tree
 renderMemoryLineChart MemoryLineChart{..} = mkGroup
     [ withStrokeColor "white" $
-      withStrokeWidth (Num 0.5) $
+      withStrokeWidth 0.5 $
       withFillOpacity 0 $
       partialSvg mlcOuterBox $ pathify $
       translate (boxX + mlcWidth/2) (boxY + mlcHeight/2) $
-      mkRect (Num mlcWidth) (Num mlcHeight)
+      mkRect mlcWidth mlcHeight
     , withStrokeColor "white" $
-      withStrokeWidth (Num 0.5) $
-      mkLine (Num (negate $ mlcWidth/2), Num 0)
-             (Num (negate (mlcWidth/2) + lineWidth), Num 0)
+      withStrokeWidth 0.5 $
+      mkLine (negate (mlcWidth/2), 0)
+             (negate (mlcWidth/2) + lineWidth, 0)
     , withFillColor "white" $
       translate (negate (mlcWidth/2) - 10) 0 $ rotate (-90) $
       center $ latex "Memory"

videos/color-theory/color-theory.hs

@@ -4,6 +4,9 @@
 {-# LANGUAGE RecordWildCards   #-}
 module Main (main) where
 
+main :: IO ()
+main = return ()
+{-
 import           Control.Lens          ()
 import           Control.Monad
 import qualified Data.ByteString       as BS
@@ -31,13 +34,10 @@ import           System.IO.Unsafe
 highdef = True
 
 takeA :: Double -> Animation -> Animation
-takeA d1 (Animation d2 f) = Animation d $ Frame $ \_ t -> unFrame f d (min d t)
-  where
-    d = min d1 d2
+takeA = undefined
 
 dropA :: Double -> Animation -> Animation
-dropA d1 (Animation d2 f) = Animation (max 0 (d2-d1)) $
-  Frame $ \d t -> unFrame f d (t+d1)
+dropA = undefined
 
 -- screen width 320
 -- screen height 180
@@ -272,10 +272,10 @@ drawPixelImage start end = mkAnimation 2 $ do
     limitGreyPixels (floor (limit*255)) monalisaLarge
 
 drawHexPixels :: Animation
-drawHexPixels = mkAnimation 1 $ do
-  when highdef $
-    emit $ defs
-  emit $ withFillOpacity 1 $ withStrokeWidth (Num 0) $ withFillColor "white" $
+drawHexPixels = mkAnimation 1 $ \_ ->
+  mkGroup
+  [ if highdef then defs else None
+  , withFillOpacity 1 $ withStrokeWidth (Num 0) $ withFillColor "white" $
     mkGroup
     [ translate ((fromIntegral x+0.5)/fromIntegral width*320 - 320/2)
                 ((fromIntegral y+0.5)/fromIntegral height*180 - 180/2) $
@@ -286,6 +286,7 @@ drawHexPixels = mkAnimation 1 $ do
     , y <- [0..height-1]
     , let pixel@(PixelRGB8 r _ _) = pixelAt monalisa x y
     ]
+  ]
   where
     defs = preRender $ mkDefinitions images
     getNthSet n = centerX $ snd (splitGlyphs [n*2,n*2+1] allGlyphs)
@@ -306,14 +307,11 @@ drawHexPixels = mkAnimation 1 $ do
 
 
 fadeIn :: Double -> Animation -> Animation
-fadeIn fadeDuration (Animation d genFrame) = Animation d $ do
-  t <- askTime
-  mapF (withGroupOpacity (max 0 $ min 1 (t/fadeDuration))) genFrame
+fadeIn = undefined
 
 fadeOut :: Double -> Animation -> Animation
-fadeOut fadeDuration (Animation d genFrame) = Animation d $ do
-  t <- askTime
-  mapF (withGroupOpacity (max 0 $ min 1 ((d-t)/fadeDuration))) genFrame
+fadeOut = undefined
 
 askTime :: Frame Time
-askTime = Frame $ \_dur t -> return t
+askTime = Frame $ \t -> return t
+-}

videos/sorting-algorithms/sorting-algorithms.hs

@@ -1,63 +1,61 @@
 #!/usr/bin/env stack
 -- stack --resolver lts-13.14 runghc --package reanimate
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards   #-}
 module Main (main) where
 
-import           Control.Lens ()
+import           Control.Lens          ()
 
-import           Graphics.SvgTree (Number(..), Tree)
-import           Reanimate.Driver (reanimate)
-import           Reanimate.LaTeX
-import           Reanimate.Monad
-import           Reanimate.Svg
-import           Reanimate.Signal
-import           Reanimate.ColorMap
 import           Codec.Picture.Types
+import           Data.Fixed
+import           Data.List
+import qualified Data.Text             as T
+import qualified Geom2D.CubicBezier    as Bezier
+import           Graphics.SvgTree      (Number (..), Tree)
 import           Numeric
-import qualified Data.Text as T
-import qualified Geom2D.CubicBezier          as Bezier
-import Data.Fixed
-import System.Random.Shuffle
-import System.Random
-import Data.List
+import           Reanimate.Animation
+import           Reanimate.ColorMap
+import           Reanimate.Driver      (reanimate)
+import           Reanimate.LaTeX
+import           Reanimate.Signal
+import           Reanimate.Svg
+import           System.Random
+import           System.Random.Shuffle
 
 fixed :: Tree -> Animation -> Animation
-fixed svg ani = mkAnimation 0 (emit svg) `sim` ani
+fixed svg ani = animate (const svg) `sim` ani
 
 digitWidth = 25
 digitCount = 10
 
 main :: IO ()
 main = reanimate $ fixed bg $ pauseAtEnd 1 $
-    mkAnimation 5 $ do
-      s <- getSignal $ signalLinear
-      emit $ withFillColor "white" $ translate (negate $ digitWidth*digitCount/2) 0 $
+    mkAnimation 5 $ \t ->
+      withFillColor "white" $ translate (negate $ digitWidth*digitCount/2) 0 $
         -- sortingTransition (zip [9,0,1,2,3,4,5,6,8,7] squares) s
         -- sortingTransition (zip [9,0,1,2,3,4,5,6,8,7] digits) s
         -- sortingTransition (zip [1,0,2,3,4,5,6,7,8,9] digiSquares) s
         -- jumpTransition (zip [1,0,2,3,4,5,6,7,8,9] digiSquares) s
-        renderSortElements (mkJumpSorted lst) s
+        renderSortElements (mkJumpSorted lst) t
   where
     seed = 0xDEADBEEF
     lst = shuffle' (zip [0..] digiSquares) 10 (mkStdGen seed)
     bg = mkBackground "black"
     msg = "0 1 2 3 4 5 6 7 8 9"
     digits =
-      map (withStrokeColor "black" . withStrokeWidth (Num 0.2)) $
+      map (withStrokeColor "black" . withStrokeWidth 0.2) $
       map (lowerTransformations . scale 3 . pathify . center . latex . T.pack . show) [0..9]
     squares = map center [ withFillColorPixel (promotePixel $ viridis (n/9)) $
-      mkRect (Num $ digitWidth+0.2) (Num digitWidth) | n <- [0..9]]
+      mkRect (digitWidth+0.2) digitWidth | n <- [0..9]]
 
     digiSquares = zipWith (\a b -> mkGroup [a,b]) squares digits
 
     -- msg = "Eve"
     glyphs = lowerTransformations $ scale 3 $ pathify $ center $ latexAlign msg
-    fillText = mkAnimation 1 $ do
-      s <- getSignal signalLinear
-      sat <- getSignal $ signalFromTo 0 0.7 signalLinear
-      emit $ withFillColor "white" $ withStrokeColor "white" $ withStrokeWidth (Num $ 0.4 * (1-s)) $
-        withFillOpacity s glyphs
+    fillText = mkAnimation 1 $ \t ->
+      let sat = signalFromTo 0 0.7 signalLinear t in
+      withFillColor "white" $ withStrokeColor "white" $ withStrokeWidth (0.4 * (1-t)) $
+        withFillOpacity t glyphs
         -- withSubglyphs [0] (withFillColorPixel $ toRGBString sat 0.0) $
         -- withSubglyphs [1] (withFillColorPixel $ toRGBString sat 0.1) $
         -- withSubglyphs [2] (withFillColorPixel $ toRGBString sat 0.2) $
@@ -69,22 +67,20 @@ main = reanimate $ fixed bg $ pauseAtEnd 1 $
         -- withSubglyphs [8] (withFillColorPixel $ toRGBString sat 0.8) $
         -- withSubglyphs [9] (withFillColorPixel $ toRGBString sat 0.9) $
         -- glyphs
-    drawText = mkAnimation 2 $ do
-      s <- getSignal signalLinear
-      emit $
-        withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.4) $
-          partialSvg s glyphs
+    drawText = mkAnimation 2 $ \t ->
+      withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth 0.4 $
+        partialSvg t glyphs
 
 data Direction = Up | Down | Sideways
 type Delay = Double
 type Position = Int
 data SortElement = SortElement
-  { sortElementDirection :: Direction
-  , sortElementStartTime :: Double
-  , sortElementDuration   :: Double
+  { sortElementDirection     :: Direction
+  , sortElementStartTime     :: Double
+  , sortElementDuration      :: Double
   , sortElementStartPosition :: Position
-  , sortElementEndPosition :: Position
-  , sortElementTree :: Tree }
+  , sortElementEndPosition   :: Position
+  , sortElementTree          :: Tree }
 
 
 mkJumpSorted :: [(Int, Tree)] -> [SortElement]
@@ -100,7 +96,7 @@ mkJumpSorted = fixParameters . worker Up . zip [0..]
       , sortElementEndPosition = target
       , sortElementTree = elt
       } : worker (flip dir) (yoink target rest)
-    flip Up = Down
+    flip Up   = Down
     flip Down = Up
 
 -- 10
@@ -155,8 +151,8 @@ renderSortElement SortElement{..} t
         to = sortElementEndPosition
         linear = fromIntegral from + (fromIntegral (to-from))*pos
         y = case sortElementDirection of
-               Down -> (sin (pos*pi) * digitWidth)
-               Up   -> negate (sin (pos*pi) * digitWidth)
+               Down     -> (sin (pos*pi) * digitWidth)
+               Up       -> negate (sin (pos*pi) * digitWidth)
                Sideways -> 0 in
     translate (linear * digitWidth) y sortElementTree