Update stylish preferences.

.stylish-haskell.yaml

@@ -81,7 +81,7 @@ steps:
       #   >                                           init, last, length)
       #
       # Default: true
-      pad_module_names: false
+      pad_module_names: true
 
       # Long list align style takes effect when import is too long. This is
       # determined by 'columns' setting.

examples/doc_rotationalTrajectory.hs

@@ -0,0 +1,18 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+{-# LANGUAGE OverloadedStrings #-}
+module Main(main) where
+
+import Reanimate
+import Reanimate.Builtin.Documentation
+import Reanimate.Morph.Common
+import Reanimate.Morph.Linear
+import Reanimate.Morph.Rotational
+import Graphics.SvgTree
+
+main :: IO ()
+main = reanimate $ docEnv $ playThenReverseA $ pauseAround 0.5 0.5 $ mkAnimation 3 $ \t ->
+  withStrokeLineJoin JoinRound $
+  let src = scale 8 $ center $ latex "X"
+      dst = scale 8 $ center $ latex "H"
+  in morph linear{morphTrajectory=rotationalTrajectory (0.5,0.5)} src dst t

src/Reanimate/Debug.hs

@@ -27,16 +27,19 @@ traceBuffer :: IORef [Animation]
 traceBuffer = unsafePerformIO (newIORef [])
 
 {-# NOINLINE traceSVG #-}
+-- | Add SVG image to trace stack.
 traceSVG :: SVG -> a -> a
 traceSVG = traceA . staticFrame (recip 60)
 
 {-# NOINLINE traceA #-}
+-- | Add animation to trace stack.
 traceA :: Animation -> a -> a
 traceA a v = unsafePerformIO $ do
   modifyIORef' traceBuffer (a :)
   evaluate v
 
 {-# NOINLINE playTraces #-}
+-- | Evaluate argument and play back the trace stack.
 playTraces :: a -> Animation
 playTraces v = unsafePerformIO $ do
   _   <- evaluate v

src/Reanimate/LaTeX.hs

@@ -47,6 +47,7 @@ import           System.IO.Unsafe                         ( unsafePerformIO )
 latex :: T.Text -> Tree
 latex = latexWithHeaders []
 
+-- | Invoke latex with extra script headers.
 latexWithHeaders :: [T.Text] -> T.Text -> Tree
 latexWithHeaders = someTexWithHeaders "latex" "dvi" []
 
@@ -58,6 +59,7 @@ someTexWithHeaders exec dvi args headers tex =
  where
   script = mkTexScript exec args headers tex
 
+-- | Invoke latex and separate results.
 latexChunks :: [T.Text] -> [Tree]
 latexChunks chunks | pNoExternals = map mkText chunks
 latexChunks chunks                = worker (svgGlyphs $ latex $ T.concat chunks) chunks
@@ -74,6 +76,7 @@ latexChunks chunks                = worker (svgGlyphs $ latex $ T.concat chunks)
 xelatex :: Text -> Tree
 xelatex = xelatexWithHeaders []
 
+-- | Invoke xelatex with extra script headers.
 xelatexWithHeaders :: [T.Text] -> T.Text -> Tree
 xelatexWithHeaders = someTexWithHeaders "xelatex" "xdv" ["-no-pdf"]
 
@@ -89,6 +92,7 @@ xelatexWithHeaders = someTexWithHeaders "xelatex" "xdv" ["-no-pdf"]
 ctex :: T.Text -> Tree
 ctex = ctexWithHeaders []
 
+-- | Invoke xelatex with extra script headers + ctex headers.
 ctexWithHeaders :: [T.Text] -> T.Text -> Tree
 ctexWithHeaders headers = xelatexWithHeaders ("\\usepackage[UTF8]{ctex}" : headers)
 

src/Reanimate/Memo.hs

@@ -1,6 +1,23 @@
 {-# LANGUAGE BangPatterns              #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE RankNTypes                #-}
+{-|
+Copyright   : Written by David Himmelstrup
+License     : Unlicense
+Maintainer  : lemmih@gmail.com
+Stability   : experimental
+Portability : POSIX
+
+With animations defined as SVG images over time, it is unfortunately
+quite easy to write inefficient code where expensive expressions are
+re-evaluated for every frame even if nothing has changed. This get
+around this issue, this module defines a global key-value table that
+can store expensive expressions such that they are evaluated only once.
+
+There is currently no way to clear values from the table and it is your
+own responsibility to not consume all available memory.
+
+-}
 module Reanimate.Memo
   ( Key(..)
   , memo
@@ -57,15 +74,20 @@ cacheMapInsert (k:ks) v (CacheMap sub vals) =
     fn = Just . cacheMapInsert ks v . fromMaybe emptyCacheMap
 
 {-# NOINLINE cacheMap #-}
+-- FIXME: There should be a way to clear the cache.
 cacheMap :: IORef CacheMap
 cacheMap = unsafePerformIO (newIORef emptyCacheMap)
 
+-- | Keys can either by any boxed object with identity (to be compared with
+--   StableNames) or a primitive type with an Eq instance.
 data Key = forall a. Key !a | forall a. (Typeable a, Eq a, Ord a) => KeyPrim !a
 
 fromKey :: Key -> IO DynamicName
 fromKey (Key val)     = DynamicName <$> makeStableName val
 fromKey (KeyPrim val) = pure (DynamicKey val)
 
+-- | Cache expensive value in global store. You must guarantee that the
+--   key uniquely determines the value.
 memo :: Typeable a => [Key] -> a -> a
 memo !k v = unsafePerformIO $ do
   keys <- mapM fromKey k

src/Reanimate/Morph/Rotational.hs

@@ -6,7 +6,8 @@ Stability   : experimental
 Portability : POSIX
 -}
 module Reanimate.Morph.Rotational
-  ( rotationalTrajectory
+  ( Origin
+  , rotationalTrajectory
   , polygonOrigin
   ) where
 
@@ -19,8 +20,22 @@ import           Reanimate.Ease
 import           Reanimate.Morph.Common
 import           Reanimate.Math.Polygon
 
+-- | Rotational origin relative to polygon center.
+--   (0.5, 0.5) is center of polygon. Top right is (1,1) and
+--   bottom left is (0,0)
 type Origin = (Double, Double)
 
+-- | Interpolation by rotating around an origin point.
+--
+--   Example:
+--
+--   > playThenReverseA $ pauseAround 0.5 0.5 $ mkAnimation 3 $ \t ->
+--   >   withStrokeLineJoin JoinRound $
+--   >   let src = scale 8 $ center $ latex "X"
+--   >       dst = scale 8 $ center $ latex "H"
+--   >   in morph linear{morphTrajectory=rotationalTrajectory (0.5,0.5)} src dst t
+--
+--   <<docs/gifs/doc_rotationalTrajectory.gif>>
 rotationalTrajectory :: Origin -> Trajectory
 rotationalTrajectory origin (src,dst) =
     \t ->
@@ -41,6 +56,7 @@ rotationalTrajectory origin (src,dst) =
 
     originAngle o = lineAngle (o + V2 1 0) o
 
+-- | Compute the absolute position of rotational origin point in polygon.
 polygonOrigin :: Polygon -> Origin -> V2 Double
 polygonOrigin poly (originX, originY) =
   case pBoundingBox poly of

src/Reanimate/Render.hs

@@ -5,6 +5,10 @@ License     : Unlicense
 Maintainer  : lemmih@gmail.com
 Stability   : experimental
 Portability : POSIX
+
+Internal tools for rastering SVGs and rendering videos. You are unlikely
+to ever directly use the functions in this module.
+
 -}
 module Reanimate.Render
   ( render
@@ -54,6 +58,7 @@ idempotentFile path action = do
   where
     lockFile = path <.> "lock"
 
+-- | Generate SVGs at 60fps and put them in a folder.
 renderSvgs :: FilePath -> Int -> Bool -> Animation -> IO ()
 renderSvgs folder offset _prettyPrint ani = do
   print frameCount
@@ -77,6 +82,8 @@ renderSvgs folder offset _prettyPrint ani = do
     hPutStrLn stderr msg
     exitWith (ExitFailure 1)
 
+-- | Select a single frame that doesn't already exist in the output
+--   folder and render it. If all frames have been rendered, print "Done".
 renderOneFrame :: FilePath -> Int -> Bool -> Int -> Animation -> IO ()
 renderOneFrame folder offset _prettyPrint rate ani =
     worker (frameOrder rate frameCount)
@@ -99,6 +106,9 @@ renderOneFrame folder offset _prettyPrint rate ani =
     frameCount = round (duration ani * fromIntegral rate) :: Int
 
 -- XXX: Merge with 'renderSvgs'
+-- | Render 10 frames and print them to stdout. Used for testing.
+--
+--   XXX: Not related to the snippets in the playground.
 renderSnippets :: Animation -> IO ()
 renderSnippets ani = forM_ [0 .. frameCount - 1] $ \nth -> do
   let now   = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
@@ -120,6 +130,7 @@ filterFrameList seen nthFrame nFrames = filter (not . isSeen)
                                                [0, nthFrame .. nFrames - 1]
   where isSeen x = any (\y -> x `mod` y == 0) seen
 
+-- | Video formats supported by reanimate.
 data Format = RenderMp4 | RenderGif | RenderWebm
   deriving (Show)
 
@@ -150,6 +161,7 @@ mp4Arguments fps progress template target =
 -- gifArguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
 -- gifArguments fps progress template target =
 
+-- | Render animation to a video file with given parameters.
 render
   :: Animation
   -> FilePath
@@ -334,6 +346,8 @@ rasterTemplate RasterNone = "render-%05d.svg"
 rasterTemplate RasterAuto = "render-%05d.svg"
 rasterTemplate _          = "render-%05d.png"
 
+-- | Resolve RasterNone and RasterAuto. If no valid raster can
+--   be found, exit with an error message.
 requireRaster :: Raster -> IO Raster
 requireRaster raster = do
   raster' <- selectRaster (if raster == RasterNone then RasterAuto else raster)
@@ -346,6 +360,8 @@ requireRaster raster = do
       exitWith (ExitFailure 1)
     _ -> pure raster'
 
+-- | Resolve RasterNone and RasterAuto. If no valid raster can
+--   be found, return RasterNone.
 selectRaster :: Raster -> IO Raster
 selectRaster RasterAuto = do
   rsvg   <- hasRSvg
@@ -358,6 +374,8 @@ selectRaster RasterAuto = do
     | otherwise      -> pure RasterNone
 selectRaster r = pure r
 
+-- | Convert SVG file to a PNG file with selected raster engine. If
+--   raster engine is RasterAuto or RasterNone, do nothing.
 applyRaster :: Raster -> FilePath -> IO ()
 applyRaster RasterNone     _    = return ()
 applyRaster RasterAuto     _    = return ()

src/Reanimate/Svg/BoundingBox.hs

@@ -11,18 +11,18 @@ module Reanimate.Svg.BoundingBox
   , svgWidth
   ) where
 
-import           Control.Arrow             ((***))
+import           Control.Arrow ((***))
-import           Control.Lens              ((^.))
+import           Control.Lens ((^.))
 import           Data.List
-import           Data.Maybe                (mapMaybe)
+import           Data.Maybe (mapMaybe)
-import           Graphics.SvgTree          hiding (height, line, path, use,
+import qualified Data.Vector.Unboxed as V
-                                            width)
+import qualified Geom2D.CubicBezier.Linear as Bezier
-import           Linear.V2                 hiding (angle)
+import           Graphics.SvgTree hiding (height, line, path, use, width)
+import           Linear.V2 hiding (angle)
 import           Linear.Vector
 import           Reanimate.Constants
 import           Reanimate.Svg.LineCommand
-import qualified Reanimate.Transform       as Transform
+import qualified Reanimate.Transform as Transform
--- import qualified Geom2D.CubicBezier           as Bezier
 
 -- | Return bounding box of SVG tree.
 --  The four numbers returned are (minimal X-coordinate, minimal Y-coordinate, width, height)
@@ -67,7 +67,8 @@ linePoints = worker zero
         LineBezier [p] ->
           p : worker p xs
         LineBezier ctrl -> -- approximation
-          [ last (partialBezierPoints (from:ctrl) 0 (recip chunks*i)) | i <- [0..chunks]] ++
+          let bezier = Bezier.AnyBezier (V.fromList (from:ctrl))
+          in [ Bezier.evalBezier bezier (recip chunks*i) | i <- [0..chunks]] ++
           worker (last ctrl) xs
         LineEnd p -> p : worker p xs
     chunks = 10
@@ -106,7 +107,7 @@ svgBoundingPoints t = map (Transform.transformPoint m) $
     pointToRPoint p =
       case mapTuple (toUserUnit defaultDPI) p of
         (Num x, Num y) -> V2 x y
-        _ -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."
+        _              -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."
 
     circleBoundingPoints circ =
       let (xnum, ynum) = circ ^. circleCenter

src/Reanimate/Svg/LineCommand.hs

@@ -1,18 +1,33 @@
-module Reanimate.Svg.LineCommand where
+{-|
+Copyright   : Written by David Himmelstrup
+License     : Unlicense
+Maintainer  : lemmih@gmail.com
+Stability   : experimental
+Portability : POSIX
+-}
+module Reanimate.Svg.LineCommand
+  ( LineCommand(..)
+  , lineLength
+  , toLineCommands
+  , lineToPath
+  , lineToPoints
+  , partialSvg
+  ) where
 
-import           Control.Lens        ((%~), (&), (.~))
+import           Control.Lens              ((%~), (&), (.~))
 import           Control.Monad.Fix
 import           Control.Monad.State
 import           Data.Functor
-import qualified Data.Vector.Unboxed as V
+import qualified Data.Vector.Unboxed       as V
 import qualified Geom2D.CubicBezier.Linear as Bezier
-import           Graphics.SvgTree    hiding (height, line, path, use, width)
+import           Graphics.SvgTree          hiding (height, line, path, use, width)
 import           Linear.Metric
-import           Linear.V2           hiding (angle)
+import           Linear.V2                 hiding (angle)
 import           Linear.Vector
 
 type CmdM a = State RPoint a
 
+-- | Simplified version of a PathCommand where all points are absolute.
 data LineCommand
   = LineMove RPoint
   -- | LineDraw RPoint
@@ -20,6 +35,7 @@ data LineCommand
   | LineEnd RPoint
   deriving (Show)
 
+-- | Convert from line commands to path commands.
 lineToPath :: [LineCommand] -> [PathCommand]
 lineToPath = map worker
   where
@@ -31,6 +47,7 @@ lineToPath = map worker
     worker LineBezier{}         = error "Reanimate.Svg.lineToPath: invalid bezier curve"
     worker LineEnd{}            = EndPath
 
+-- | Using @n@ control points, approximate the path of the curves.
 lineToPoints :: Int -> [LineCommand] -> [RPoint]
 lineToPoints nPoints cmds =
     map lineEnd lineSegments
@@ -58,10 +75,11 @@ adjustLineLength :: Double -> RPoint -> LineCommand -> LineCommand
 adjustLineLength alpha from cmd =
   case cmd of
     LineBezier points -> LineBezier $ drop 1 $ partialBezierPoints (from:points) 0 alpha
-    LineMove p -> LineMove p
+    LineMove p        -> LineMove p
     -- LineDraw t -> LineDraw (lerp alpha t from)
-    LineEnd p -> LineBezier [lerp alpha p from]
+    LineEnd p         -> LineBezier [lerp alpha p from]
 
+-- | Estimated length of all segments in a line.
 lineLength :: LineCommand -> CmdM Double
 lineLength cmd =
   case cmd of
@@ -80,11 +98,12 @@ lineLength cmd =
 rpointsToBezier :: [RPoint] -> Bezier.CubicBezier Double
 rpointsToBezier lst =
   case lst of
-    [a,b] -> Bezier.CubicBezier a a b b
+    [a,b]     -> Bezier.CubicBezier a a b b
-    [a,b,c] -> Bezier.quadToCubic (Bezier.QuadBezier a b c)
+    [a,b,c]   -> Bezier.quadToCubic (Bezier.QuadBezier a b c)
     [a,b,c,d] -> Bezier.CubicBezier a b c d
-    _ -> error $ "rpointsToBezier: Invalid list of points: " ++ show lst
+    _         -> error $ "rpointsToBezier: Invalid list of points: " ++ show lst
 
+-- | Convert from path commands to line commands.
 toLineCommands :: [PathCommand] -> [LineCommand]
 toLineCommands ps = evalState (worker zero Nothing ps) zero
   where
@@ -239,9 +258,6 @@ partialBezierPoints ps a b =
       Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b
   in V.toList os
 
-interpolatePathCommands :: Double -> [PathCommand] -> [PathCommand]
-interpolatePathCommands alpha = lineToPath . partialLine alpha . toLineCommands
-
 {- | Create an image showing portion of a path.
      Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
      You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').

src/Reanimate/Transform.hs

@@ -18,20 +18,18 @@ import           Data.Maybe
 import           Graphics.SvgTree
 import           Linear.V2
 
-type TMatrix = Matrix Coord
-
 -- | Identity matrix.
 --
 --   @transformPoints identity x = x@
-identity :: TMatrix
+identity :: Matrix Coord
 identity = M.identity 3
 
-fromList :: [Coord] -> TMatrix
+fromList :: [Coord] -> Matrix Coord
 fromList [a,b,c,d,e,f] = M.fromList 3 3 [a,c,e,b,d,f,0,0,1]
 fromList _             = error "Reanimate.Transform.fromList: bad input"
 
 -- | Apply a transformation matrix to a 2D point.
-transformPoint :: TMatrix -> RPoint -> RPoint
+transformPoint :: Matrix Coord -> RPoint -> RPoint
 transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)
   where
     !a = M.unsafeGet 1 1 m
@@ -43,12 +41,12 @@ transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)
     -- (a:c:e:b:d:f:_) = M.toList m
 
 -- | Convert multiple SVG transformations into a single transformation matrix.
-mkMatrix :: Maybe [Transformation] -> TMatrix
+mkMatrix :: Maybe [Transformation] -> Matrix Coord
 mkMatrix Nothing   = identity
 mkMatrix (Just ts) = foldl' (*) identity (map transformationMatrix ts)
 
 -- | Convert an SVG transformation into a transformation matrix.
-transformationMatrix :: Transformation -> TMatrix
+transformationMatrix :: Transformation -> Matrix Coord
 transformationMatrix transformation =
   case transformation of
     TransformMatrix a b c d e f -> fromList [a,b,c,d,e,f]
@@ -65,7 +63,7 @@ transformationMatrix transformation =
       where r = a * pi / 180
 
 -- | Convert a transformation matrix back into an SVG transformation.
-toTransformation :: TMatrix -> Transformation
+toTransformation :: Matrix Coord -> Transformation
 toTransformation m = TransformMatrix a b c d e f
   where
     [a,c,e,b,d,f,_,_,_] = M.toList m

src/Reanimate/Voice.hs

@@ -10,6 +10,7 @@
 module Reanimate.Voice
   ( Transcript(..)
   , TWord(..)
+  , Phone(..)
   , findWord                -- :: Transcript -> [Text] -> Text -> TWord
   , findWords               -- :: Transcript -> [Text] -> Text -> [TWord]
   , loadTranscript          -- :: FilePath -> Transcript
@@ -90,6 +91,7 @@ instance FromJSON TWord where
       <*> o
       .:  "word"
 
+-- | Phoneme type
 data Phone = Phone
   { phoneDuration :: Double
   , phoneType     :: Text