Gluing together animations

Reanimate is a library for programmatically generating animations with a twist towards mathematics / vector drawings. A lot of inspiration was drawn from 3b1b's manim library.

Reanimate aims at being a batteries-included way of gluing together different technologies: SVG as a universal image format, LaTeX for typesetting, ffmpeg for video encoding, inkscape/imagemagick for rasterization, potrace for vectorization, blender/povray for 3D graphics, and Haskell for scripting.

Scalable Vector Graphics

Movies consists of a sequence of frames and, in reanimate, these frames are SVG images. SVGs can easily reference raster images, includes a set of drawing primitives, and offers image advanced manipulation through filter effects. Since SVGs are plain-text documents, tools can be written to analyse and modify images. For example, reanimate includes code for applying 2D physics to shapes in SVG images.

SVG features, as demonstrated in the below animation:

  • Drawing primitives: Circles, rectangles, lines, external images, paths, text.
  • Drawing attributes: Rotation, position, color, line-width.
  • Filter effects: Blur and blob (merging shapes).
Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import           Reanimate
import           Reanimate.Transition
import           Reanimate.Builtin.Images

import           Codec.Picture
import           Control.Lens
import           Data.Text                (Text)
import           Graphics.SvgTree         hiding (Text)

bgColor :: PixelRGBA8
bgColor = PixelRGBA8 252 252 252 0xFF

framePause :: Double
framePause = 3

transitionTime :: Double
transitionTime = 0.5

main :: IO ()
main = reanimate $ addStatic bg $ chainT (overlapT transitionTime fadeT)
      [comp1, comp2, comp3, comp4, comp5, comp6, comp7, setDuration transitionTime comp1]
  where
    bg = mkBackgroundPixel 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 $
      center $ latex "$\\pi$"
    comp6 = svgComponent "Blurs" mkBlur
    comp7 = svgComponent "Blobs" mkBlob

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
  ]

mkBlur :: SVG
mkBlur = mkGroup
    [ FilterTree $ mkFilter "blur"
      [FEGaussianBlur $ defaultSvg
        & gaussianBlurStdDeviationX .~ Num dev
        & filterResult ?~ "blur"
      ] & filterWidth .~ pure (Percent 3)
        & filterX .~ pure (Percent (-1))
        & filterHeight .~ pure (Percent 3)
        & filterY .~ pure (Percent (-1))
    , circ
      & filterRef .~ pure (Ref "blur")
    ]
  where
    dev = 0.2
    radius = 2
    circ = mkCircle radius

mkBlob :: SVG
mkBlob =
    mkGroup
    [ FilterTree $ mkFilter "goo"
      [FEGaussianBlur $ defaultSvg
        & gaussianBlurStdDeviationX .~ Num dev
        & filterResult ?~ "blur"
      ,FEColorMatrix $ defaultSvg
        & colorMatrixType .~ Matrix
        & colorMatrixValues .~ "1 0 0 0 0 \
                               \0 1 0 0 0 \
                               \0 0 1 0 0 \
                               \0 0 0 " ++ show (sharpness*2) ++ " -" ++ show sharpness
        & filterResult .~ pure "goo"
      ,FEComposite $ defaultSvg
        & compositeIn .~ pure SourceGraphic
        & compositeIn2 .~ pure (SourceRef "goo")
        & compositeOperator .~ CompositeAtop
      ] & filterWidth .~ pure (Percent 3)
        & filterX .~ pure (Percent (-1))
        & filterHeight .~ pure (Percent 3)
        & filterY .~ pure (Percent (-1))
    , withStrokeWidth 0 $ withFillColor "red" $ mkGroup
      [ translate (0.9*(-radius)) 0 circ
      , translate (0.9*radius) 0 circ
      ] & filterRef .~ pure (Ref "goo")
    ]
  where
    sharpness = 10 :: Integer
    dev = 0.2
    radius = 2
    circ = mkCircle radius


mkFilter :: String -> [FilterElement] -> Filter
mkFilter ident fe = defaultSvg & filterChildren .~ fe & attrId ?~ ident


Animation = Time ➞ SVG

Animations can be defined as SVG images over time (plus a bit of bookkeeping such as their duration). With this approach, the time variable can determine SVG properties such as radius, path lengths, rotation, and color. Reanimate ships with a bunch of combinators for composing and arranging animations.

Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
module Main(main) where

import           Reanimate
import           Reanimate.Transition

import           Codec.Picture.Types
import           Data.Text           (Text)

bgColor :: PixelRGBA8
bgColor = PixelRGBA8 252 252 252 0xFF

segmentDuration :: Double
segmentDuration = 3

transitionTime :: Double
transitionTime = 0.5

main :: IO ()
main = reanimate $ addStatic bg $
    chainT transition
    [animateCircleR, animateCircleP, animateRectR, animateColor
    ,signalA (constantS 0) $ setDuration transitionTime animateCircleR]
  where
    transition = overlapT transitionTime fadeT
    bg = mkBackgroundPixel 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)


Reanimate is not an opinionated framework, though, and also offers a more traditional keyframing tools. The example below uses an imperative API to schedule the various sub animations, transitions, and effects.

Toggle source code. 

  #!/usr/bin/env cabal
{- cabal:
build-depends: base
            , reanimate
            , reanimate-svg
            , JuicyPixels
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo       #-}
module Main (main) where

import           Codec.Picture
import           Control.Lens
import           Control.Monad    (forM_)
import           Graphics.SvgTree (Tree)
import           Reanimate

main :: IO ()
main = reanimate $ addStatic bg mainScene
  where
    bg = mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)

mainScene :: Animation
mainScene = scene $ mdo
    play $ drawCircle
      & setDuration drawCircleT
      & applyE (constE flipXAxis)
      & signalA (curveS 2)
    fork $ play $ drawCircle
      & freezeAtPercentage 1
      & setDuration rotDur
    rotDur <- withSceneDuration $ waitOn $
      forM_ svgs $ \svg -> do
        fork $ play $ drawTick
          & setDuration rotateT
          & repeatA rotateN
          & applyE (overBeginning 0.5 drawInE)
          & applyE (overEnding 0.5 drawOutE)
        fork $ play $ drawSVG svg
          & setDuration rotateT
          & repeatA rotateN
          & applyE (overBeginning rotateT drawInE)
          & applyE (delayE rotateT $ overBeginning 1 fillInE)
          & applyE (overEnding 0.5 fadeOutE)
        wait (rotateT / fromIntegral (1+length svgs))
    play $ drawCircle
      & setDuration drawCircleT
      & reverseA
      & signalA (curveS 2)
    return ()
  where
    drawCircleT = 2.5
    rotateT     = 5
    rotateN     = 3

    svgCAF = center $ latex "\\LaTeX"
    getNth n = snd (splitGlyphs [n] svgCAF)
    svgs = [
        withStrokeWidth defaultStrokeWidth $
        scale 2 $
        translate 0 (tickLength*2) $
        withStrokeColor "black" $
        withFillColor "black" $
        center $ getNth n
      | n <- [0..4]]

radius, tickLength :: Double
radius = 1.25
tickLength = 0.25

drawCircle :: Animation
drawCircle = animate $ \t ->
    withFillOpacity 0 $
    withStrokeColor "black" $
    rotate (-90) $
    partialSvg t circPath
  where
    circPath = pathify $ mkCircle radius

drawTick :: Animation
drawTick = drawSVG $ mkLine (0, 0) (0, tickLength)

drawSVG :: Tree -> Animation
drawSVG svg = animate $ \t ->
    withStrokeColor "black" $
    rotate (t*360) $
    translate 0 radius
    svg


Pillar I: Haskell

A large part of Reanimate's expressive power comes from using Haskell as the scripting language. Haskell tends to favor expressiveness and correctness over raw performance and that is exactly what is needed from a glue language. All the heavy-lifting of rendering frames and encoding videos is handled by external tools and Reanimate merely needs to concern itself with finding intuitive ways of describing animations.

The following examples shows how something as seemingly complicated as fourier series can be expressed and animated in Haskell. Most noteworthy is the layered structure of the code:

  1. The first layer handles the mathematics of fourier series without worrying about graphics or how properties should be animated,
  2. the second layer describes how to draw a single frame given the length of the fourier series and the degree of rotation,
  3. the third layer deals with time: order of animations, durations, number of rotations, transition timing functions, pauses, etc.
Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import           Codec.Picture
import           Control.Lens
import           Data.Complex
import           Graphics.SvgTree
import           Linear.V2
import           Reanimate

-- layer 3
main :: IO ()
main = reanimate $ setDuration 30 $ scene $ 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
    play $ fourierA (constantS 0)       -- Don't rotate at all
      & setDuration 10
      & reverseA
      & signalA (powerS 2)                       -- Start slow, end fast
      & pauseAtEnd 2

-- layer 2
fourierA :: (Double -> Double) -> Animation
fourierA genPhi = animate $ \t ->
    let circles = setFourierLength (t*piFourierLen) piFourier
        coeffs = fourierCoefficients $ rotateFourier (genPhi t) circles
    in mkGroup
    [ drawCircles coeffs
    , withStrokeColor "green" $
      withStrokeLineJoin JoinRound $
      withFillOpacity 0 $
      withStrokeWidth (defaultStrokeWidth*2) $
      mkLinePath $ mkFourierOutline circles
    , let x :+ y = sum coeffs in
      translate x y $ withFillColor "red" $ mkCircle (defaultStrokeWidth*3)
    ]

drawCircles :: [Complex Double] -> SVG
drawCircles [] = mkGroup []
drawCircles ( x :+ y : xs) =
  translate x y $ drawCircles' xs

drawCircles' :: [Complex Double] -> SVG
drawCircles' circles = mkGroup
    [ worker circles
    , withStrokeColor "black" $
      withStrokeLineJoin JoinRound $
      withFillOpacity 0 $
      mkLinePath [ (x, y) | x :+ y <- scanl (+) 0 circles ]]
  where
    worker [] = None
    worker (x :+ y : rest) =
      let radius = sqrt(x*x+y*y) in
      mkGroup
      [ withStrokeColor "dimgrey" $
        withFillOpacity 0 $
        mkCircle radius
      , translate x y $ worker rest ]

-- layer 1
newtype Fourier = Fourier {fourierCoefficients :: [Complex Double]}

piFourier :: Fourier
piFourier = mkFourier $ lineToPoints 500 $
  toLineCommands $ extractPath $ scale 15 $
  center $ latexAlign "\\pi"

piFourierLen :: Double
piFourierLen = sum $ map magnitude $ drop 1 $ take 500 $ fourierCoefficients piFourier

pointAtFourier :: Fourier -> Complex Double
pointAtFourier = sum . fourierCoefficients

mkFourier :: [RPoint] -> Fourier
mkFourier points = Fourier $ findCoefficient 0 :
    concat [ [findCoefficient n, findCoefficient (-n)] | n <- [1..] ]
  where
    findCoefficient :: Int -> Complex Double
    findCoefficient n =
        sum [ toComplex point * exp (negate (fromIntegral n) * 2 *pi * i*t) * deltaT
            | (idx, point) <- zip [0::Int ..] points, let t = fromIntegral idx/nPoints ]
    i = 0 :+ 1
    toComplex (V2 x y) = x :+ y
    deltaT = recip nPoints
    nPoints = fromIntegral (length points)

setFourierLength :: Double -> Fourier -> Fourier
setFourierLength _ (Fourier []) = Fourier []
setFourierLength len0 (Fourier (first:lst)) = Fourier $ first : worker len0 lst
  where
    worker _len [] = []
    worker len (c:cs) =
      if magnitude c < len
        then c : worker (len - magnitude c) cs
        else [c * realToFrac (len / magnitude c)]

rotateFourier :: Double -> Fourier -> Fourier
rotateFourier phi (Fourier coeffs) =
    Fourier $ worker coeffs (0::Integer)
  where
    worker [] _ = []
    worker (x:rest) 0 = x : worker rest 1
    worker [left] n = worker [left,0] n
    worker (left:right:rest) n =
      let n' = fromIntegral n in
      left * exp (negate n' * 2 * pi * i * phi') :
      right * exp (n' * 2 * pi * i * phi') :
      worker rest (n+1)
    i = 0 :+ 1
    phi' = realToFrac phi

mkFourierOutline :: Fourier -> [(Double, Double)]
mkFourierOutline fourier =
    [ (x, y)
    | idx <- [0 .. granularity]
    , let x :+ y = pointAtFourier $ rotateFourier (idx/granularity) fourier
    ]
  where
    granularity = 500


Scripting in Haskell also gives access to the extensive body of code libraries. There are Haskell libraries for syntax highlighting, font manipulation, and much, much more. In the spirit of being a batteries-included framework, Reanimate ships with a built-in 2D physics library, called Chipmunk2D. The example below demonstrates how SVG shapes can be used nearly effortlessly in a physics simulation.

Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Main (main) where

import           Chiphunk.Low
import           Codec.Picture       (PixelRGBA8 (..))
import           Control.Lens
import           Control.Monad       (forM_)
import           Linear.V2           (V2 (..))
import           Reanimate
import           Reanimate.Chiphunk
import           Reanimate.PolyShape
import           System.IO.Unsafe    (unsafePerformIO)

shatter :: Animation
shatter = unsafePerformIO $ do
    bodyStore <- newBodyStore
    let gravity = Vect 0 (-1) -- Gravity points down (negative 1 y/s^2)

    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

    let toVect (V2 x y) = Vect x y
        vectGroup = plDecompose $ svgToPolyShapes $ center $ scale 4 $
          latex "$F=ma$"

    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 $ parA bg $ sceneAnimation $ do
    play $ shatter
    play $ shatter
      & reverseA
      & setDuration 5
      & signalA (powerS 2)
  where
    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)


Pillar II: LaTeX

LaTeX is a widely used system for typesetting equations and documents. It is most commonly used by writing TeX documents which are then converted to pdfs. However, since the output of LaTeX is natively vector graphics, it is trivial to get SVG documents instead of pdfs. Armed with this knowledge, Reanimate offers a simple yet powerful function: latex :: Text -> SVG

The latex function takes a snippet of TeX code, passes it through the LaTeX system, and converts the result to an SVG image. Furthermore, since the result is entirely determined by the TeX code, caching is used to hide the overhead of invoking LaTeX.

The resulting SVGs can be manipulated just like any other. The below examples illustrates how different effects can be applied to different glyphs in the equation.

Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports    #-}
module Main (main) where

import           Reanimate

import           Codec.Picture
import           Codec.Picture.Types
import           Control.Lens          ((&), (^.))
import           Control.Monad
import           Graphics.SvgTree
import           System.Random
import "random-shuffle" System.Random.Shuffle

main :: IO ()
main = reanimate $ addStatic bg latexExample
  where
    bg = mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)

latexExample :: Animation
latexExample = scene $ do
    -- Draw equation
    play $ drawAnimation strokedSvg
    sprites <- forM glyphs $ \(fn, _, elt) ->
      newSpriteSVG $ 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}"
    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 = scene $ do
  forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do
    let sWidth =
          case toUserUnit defaultDPI <$> (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
        t <- spriteT
        return $
          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)


Pillar III: povray

Although incredibly expressive, SVGs are strictly limited to 2D graphics. This limitation can be overcome with a 3D renderer such as povray: povray is a nearly 30 year-old raytracer with a relatively small but solid set of features. Reanimate offers convenient functions for importing povray scenes as well as exporting animations to be used as textures. In the video below, the LaTeX animation is projected upon a plane which is then rotated and translated in 3D space. A key thing to note is that both the 2D and 3D elements are managed entirely through code.

Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE PackageImports    #-}
module Main (main) where

import           Reanimate
import           Reanimate.Povray      (povraySlow')

import           Codec.Picture
import           Codec.Picture.Types
import           Control.Lens          ((&), (^.))
import           Control.Monad
import           Data.Text             (Text)
import qualified Data.Text             as T
import           Graphics.SvgTree      hiding (Text)
import           NeatInterpolation
import           System.Random
import "random-shuffle" System.Random.Shuffle


main :: IO ()
main = reanimate $ scene $ do
    newSpriteSVG $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF
    zPos <- newVar 0
    xRot <- newVar 0
    zRot <- newVar 0
    _ <- newSprite $ do
      transZ <- unVar zPos
      getX <- unVar xRot
      getZ <- unVar zRot
      t <- spriteT
      dur <- spriteDuration
      pure $
        mkImage screenWidth screenHeight $ povraySlow' [] $
        script (svgAsPngFile (texture (t/dur))) transZ getX getZ
    wait 2
    fork $ tweenVar zPos 9 $ \v -> fromToS v 8
    fork $ tweenVar xRot 9 $ \v -> fromToS v 360 . curveS 2
    fork $ tweenVar zRot 9 $ \v -> fromToS v 360 . curveS 2
    wait 10
    tweenVar zPos 2 $ \v -> fromToS v 0 . curveS 3

texture :: Double -> SVG
texture t = frameAt (t*duration latexExample) latexExample

script :: FilePath -> Double -> Double -> Double -> Text
script png transZ rotX rotZ =
  let png_ = T.pack png
      rotX_ = T.pack $ show rotX
      transZ_ = T.pack $ show transZ
      rotZ_ = T.pack $ show rotZ
  in [text|
#version 3.7;
//Files with predefined colors and textures
#include "colors.inc"

//Place the camera
camera {
  perspective
  location <0,0,-9>
  look_at  <0,0,0>
  up y
  right x*16/9
}

global_settings { assumed_gamma 1.0 }

//Ambient light to "brighten up" darker pictures
global_settings { ambient_light White*3 }

//Set a background color
background { color rgbt <0, 0, 0, 1> } // transparent

polygon {
  5,
  <0, 0>, <0, 1>, <1, 1>, <1, 0>, <0, 0>
  texture {
    pigment{
      image_map{ png "${png_}" }
    }
  }
  translate <-1/2,-1/2>
  scale <16,9,1>
  rotate <0,${rotX_},${rotZ_}>
  translate <0,0,${transZ_}>
}
|]


-----------------------------------
-- COPIED FROM tut_glue_latex.hs --



latexExample :: Animation
latexExample = scene $ do
    -- Draw equation
    play $ drawAnimation strokedSvg
    sprites <- forM glyphs $ \(fn, _, elt) ->
      newSpriteSVG $ 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}"
    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 = scene $ do
  forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do
    let sWidth =
          case toUserUnit defaultDPI <$> (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
        t <- spriteT
        return $
          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)


The video above uses a perspective camera, ie. objects further away appears to be smaller. This gives the appearance of three dimensions but it also makes it difficult to interlace SVG objects and 3D objects with pixel-perfect precision. For example, aligning a cube and a square requires the exact position of the pinhole camera. All of this can be dramatically simplified with an orthographic projection where 'x' an 'y' coordinates in 3D space always map to the same 'x' and 'y' coordinates on the screen. Shapes lose their perspective but in many cases, especially when illustrating mathematical concepts, drawing "idealized" shapes is perfectly fine. The video below shows an orthographic projection of a sphere. The sphere (3D shape) could be completely eclipsed by a circle (2D shape) of the same radius with pixel-perfect accuracy.

Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE PackageImports    #-}
module Main (main) where

import           Reanimate
import           Reanimate.Povray

import           Codec.Picture
import           Codec.Picture.Types
import           Control.Lens          ((^.),(&))
import           Control.Monad
import           Data.Text             (Text)
import qualified Data.Text             as T
import           Graphics.SvgTree      hiding (Text)
import           NeatInterpolation
import           System.Random
import "random-shuffle" System.Random.Shuffle


main :: IO ()
main = reanimate $ addStatic bg $ scene $ do
    xRot <- newVar (-30)
    yRot <- newVar 180
    zRot <- newVar 0
    newSprite_ $ do
      getX <- unVar xRot
      getY <- unVar yRot
      getZ <- unVar zRot
      t <- spriteT
      dur <- spriteDuration
      return $
        povraySlow [] $
        script (svgAsPngFile (texture (t/dur))) getX getY getZ
    wait 2
    let tDuration = 10
    fork $ tweenVar yRot tDuration $ \v -> fromToS v (v+180) . curveS 2
    fork $ tweenVar xRot (tDuration/2) $ \v -> fromToS v (v+60) . curveS 2
    fork $ do
      wait (tDuration/2)
      tweenVar xRot (tDuration/2) $ \v -> fromToS v (v-60) . curveS 2
    wait tDuration
    wait 2
  where
    bg = mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF

texture :: Double -> SVG
texture t = mkGroup
  [ checker 20 20
  , frameAt (t*duration latexExample) latexExample
  ]

script :: FilePath -> Double -> Double -> Double -> Text
script png rotX rotY rotZ =
  let png_ = T.pack png
      rotX_ = T.pack $ show rotX
      rotY_ = T.pack $ show rotY
      rotZ_ = T.pack $ show rotZ
  in [text|
# version 3.7;
//Files with predefined colors and textures
#include "colors.inc"

#include "shapes3.inc"

//Place the camera
camera {
  orthographic
  location <0,0,-10>
  look_at  <0,0,0>
  up y*9
  right x*16
}

global_settings { assumed_gamma 1.0 }

//Ambient light to "brighten up" darker pictures
global_settings { ambient_light White*3 }

//Set a background color
//background { color White }
//background { color rgbt <0.1, 0, 0, 0> } // red
background { color rgbt <0, 0, 0, 1> } // transparent

//Sphere with specified center point and radius
sphere {
  <0,0,0>, 4
  texture {
    uv_mapping pigment{
      image_map{ png "${png_}" }
    }
  }
  rotate <0,${rotY_},${rotZ_}>
  rotate <${rotX_},0,0>
}

|]

checker :: Int -> Int -> SVG
checker w h =
  withStrokeColor "lightblue" $
  withStrokeWidth (defaultStrokeWidth/2) $
  mkGroup
  [ withFillOpacity 0.8 $ mkBackground "white"
  , mkGroup
    [ translate (stepX*x-offsetX + stepX/2) 0 $
      mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
    | x <- map fromIntegral [0..w-1]
    ]
  ,
    mkGroup
    [ translate 0 (stepY*y-offsetY) $
      mkLine (-screenWidth/2, 0) (screenWidth/2, 0)
    | y <- map fromIntegral [0..h]
    ]
  ]
  where
    stepX = screenWidth/fromIntegral w
    stepY = screenHeight/fromIntegral h
    offsetX = screenWidth/2
    offsetY = screenHeight/2




-----------------------------------
-- COPIED FROM tut_glue_latex.hs --


latexExample :: Animation
latexExample = scene $ do
    -- Draw equation
    play $ drawAnimation strokedSvg
    sprites <- forM glyphs $ \(fn, _, elt) ->
      newSpriteSVG $ 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}"
    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 = scene $ do
  forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do
    let sWidth =
          case toUserUnit defaultDPI <$> (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
        t <- spriteT
        return $
          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)


Pillar IV: Blender

Blender is a vastly more modern and capable 3D modeller than povray but has a slightly steeper learning curve. Most people interact with Blender through a graphical user interface but all of blender's features can also be used directly from Python. The Python API is sizable and, at first glance, it might seem that there are almost no tutorials for blender scripting. However, Blender can tell you the Python command for every action in the GUI, making it easy to translate graphical tutorials to scripting tutorials.

The example below uses built-in modifiers to bend a plane into a sphere and is rendered using the EEVEE engine.

Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE PackageImports    #-}
module Main (main) where

import           Reanimate
import           Reanimate.Builtin.Documentation

import           Codec.Picture.Types
import           Control.Lens                    ((&), (^.))
import           Control.Monad
import qualified Data.Text                       as T
import           Graphics.SvgTree
import           NeatInterpolation
import           System.Random
import "random-shuffle" System.Random.Shuffle

-- spritePercent = (/) <$> spriteT <*> spriteDur

main :: IO ()
main = seq texture $ reanimate $ pauseAtEnd 1 $ addStatic bg $ scene $ do
    bend <- newVar 0
    trans <- newVar 0
    rotX <- newVar 0
    rotY <- newVar 0
    newSprite_ $ do
      getBend <- unVar bend
      getTrans <- unVar trans
      getRotX <- unVar rotX
      getRotY <- unVar rotY
      t <- spriteT
      dur <- spriteDuration
      return $ seq (texture (t/dur)) $
        blender (script (texture (t/dur)) getBend getTrans getRotX getRotY)
    wait 2
    fork $ tweenVar trans 5 $ \v -> fromToS v (-2) .  curveS 2
    fork $ tweenVar bend 5 $ \v -> fromToS v 1 . curveS 2
    fork $ tweenVar rotY 15 $ \v -> fromToS v (pi*2*2) . curveS 2
    fork $ do
      tweenVar rotX 5 $ \v -> fromToS v (-pi/5) . curveS 2
      tweenVar rotX 5 $ \v -> fromToS v (pi/5) . curveS 2
    wait (15-5)
    fork $ tweenVar bend 5 $ \v -> fromToS v 0 . curveS 2
    fork $ tweenVar rotX 5 $ \v -> fromToS v 0 . curveS 2
    fork $ tweenVar trans 5 $ \v -> fromToS v 0 . curveS 2
    wait 4
    -- tweenVar trans 1 (\t v -> fromToS v 0 $ curveS 2 t)
    wait 1
    wait 2
  where
    bg = mkBackgroundPixel rtfdBackgroundColor

texture :: Double -> FilePath
texture t = svgAsPngFile $ mkGroup
  [ checker 20 20
  , frameAt (t*duration latexExample) latexExample
  ]

script :: FilePath -> Double -> Double -> Double -> Double -> T.Text
script img bend transZ rotX rotY =
  let img_ = T.pack img
      bend_ = T.pack $ show bend
      transZ_ = T.pack $ show transZ
      rotX_ = T.pack $ show rotX
      rotY_ = T.pack $ show rotY
      yScale_ = T.pack $ show (fromToS (9/2) 4 bend)
      pWidthT = T.pack $ show (max 800 pWidth)
      pHeightT = T.pack $ show (max 450 pHeight)
  in [text|
import os
import math

import bpy

light = bpy.data.objects['Light']
bpy.ops.object.select_all(action='DESELECT')
light.select_set(True)
bpy.ops.object.delete()


cam = bpy.data.objects['Camera']
cam.location = (0,0,22.25 + ${transZ_})
cam.rotation_euler = (0, 0, 0)
bpy.ops.object.empty_add(location=(0.0, 0, 0))
focus_target = bpy.context.object
bpy.ops.object.select_all(action='DESELECT')
cam.select_set(True)
focus_target.select_set(True)
bpy.ops.object.parent_set()

focus_target.rotation_euler = (${rotX_}, 0, 0)


origin = bpy.data.objects['Cube']
bpy.ops.object.select_all(action='DESELECT')
origin.select_set(True)
bpy.ops.object.delete()

x = ${bend_}
bpy.ops.mesh.primitive_plane_add()
plane = bpy.context.object
plane.scale = (16/2,${yScale_},1)
bpy.ops.object.shade_smooth()

bpy.context.object.active_material = bpy.data.materials['Material']
mat = bpy.context.object.active_material
image_node = mat.node_tree.nodes.new('ShaderNodeTexImage')
output = mat.node_tree.nodes['Material Output']
#texture = mat.node_tree.nodes['Principled BSDF']
#texture.inputs['Roughness'].default_value = 1
#mat.node_tree.links.new(image_node.outputs['Color'], texture.inputs['Base Color'])
mat.node_tree.links.new(image_node.outputs['Color'], output.inputs['Surface'])


image_node.image = bpy.data.images.load('${img_}')


modifier = plane.modifiers.new(name='Subsurf', type='SUBSURF')
modifier.levels = 7
modifier.render_levels = 7
modifier.subdivision_type = 'SIMPLE'

bpy.ops.object.empty_add(type='ARROWS',rotation=(math.pi/2,0,0))
empty = bpy.context.object

bendUp = plane.modifiers.new(name='Bend up', type='SIMPLE_DEFORM')
bendUp.deform_method = 'BEND'
bendUp.origin = empty
bendUp.deform_axis = 'X'
bendUp.factor = -math.pi*x

bendAround = plane.modifiers.new(name='Bend around', type='SIMPLE_DEFORM')
bendAround.deform_method = 'BEND'
bendAround.origin = empty
bendAround.deform_axis = 'Z'
bendAround.factor = -math.pi*2*x

bpy.context.view_layer.objects.active = plane
bpy.ops.object.modifier_apply(modifier='Subsurf')
bpy.ops.object.modifier_apply(modifier='Bend up')
bpy.ops.object.modifier_apply(modifier='Bend around')

bpy.ops.object.select_all(action='DESELECT')
plane.select_set(True);
#bpy.ops.object.origin_set(type='ORIGIN_GEOMETRY')
bpy.ops.object.origin_clear()
bpy.ops.object.origin_set(type='GEOMETRY_ORIGIN')

plane.rotation_euler = (0, ${rotY_}, 0)

scn = bpy.context.scene

scn.view_settings.view_transform = 'Standard'

#scn.render.engine = 'CYCLES'
#scn.render.resolution_percentage = 10

scn.render.resolution_x = ${pWidthT} #3200
scn.render.resolution_y = ${pHeightT} #1800

scn.render.film_transparent = True

bpy.ops.render.render( write_still=True )
|]

checker :: Int -> Int -> SVG
checker w h =
  withStrokeColor "lightgrey" $
  withStrokeWidth (defaultStrokeWidth/2) $
  mkGroup
  [ mkBackground "darkgrey"
  , mkGroup
    [ translate (stepX*x-offsetX + stepX/2) 0 $
      mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
    | x <- map fromIntegral [0..w-1]
    ]
  ,
    mkGroup
    [ translate 0 (stepY*y-offsetY) $
      mkLine (-screenWidth/2, 0) (screenWidth/2, 0)
    | y <- map fromIntegral [0..h]
    ]
  ]
  where
    stepX = screenWidth/fromIntegral w
    stepY = screenHeight/fromIntegral h
    offsetX = screenWidth/2
    offsetY = screenHeight/2




-----------------------------------
-- COPIED FROM tut_glue_latex.hs --


latexExample :: Animation
latexExample = scene $ do
    -- Draw equation
    play $ drawAnimation strokedSvg
    sprites <- forM glyphs $ \(fn, _, elt) ->
      newSpriteSVG $ 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}"
    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 = scene $ do
  forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do
    let sWidth =
          case toUserUnit defaultDPI <$> (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
        t <- spriteT
        pure $
          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)


Pillar V: potrace

Potrace takes pixel data (from an image file, or perhaps generated by povray or Blender) and automatically convert it to vector graphics. Once an image has been vectorized, it can be manipulated with the standard SVG tools. In the example below, a sphere is rendered with povray, vectorized, and then line-drawn.

Toggle source code. 

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
module Main (main) where

import           Reanimate
import           Reanimate.Povray  (povraySlow')

import           Codec.Picture
import           Control.Lens
import           Control.Monad
import           Data.Text         (Text)
import qualified Data.Text         as T
import           NeatInterpolation

main :: IO ()
main = reanimate $ addStatic bg $ scene $ do
    play $ mkAnimation drawDuration $ \t -> partialSvg t (wireframe (-45) 220)
    xRot <- newVar (-45)
    yRot <- newVar 220
    wf <- newSprite $ wireframe <$> unVar xRot <*> unVar yRot
    fork $ tweenVar yRot spinDur $ \v -> fromToS v (v+60*3) . curveS 2
    replicateM_ wobbles $ do
      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
  where
    drawDuration = 10
    wobbles = 3
    wobbleDur = 3
    spinDur = fromIntegral wobbles * wobbleDur
    bg = mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF

wireframe :: Double -> Double -> SVG
wireframe rotX rotY =
  withStrokeColor "black" $
  withStrokeWidth (defaultStrokeWidth*0.2) $
  withFillOpacity 0 $
  lowerTransformations $
  flipYAxis $
  translate (-screenWidth/2) (-screenHeight/2) $
  scale (screenWidth/2560) $
  mkPath $ extractPath $
  vectorize_ ["-t","100"] $
  povraySlow' [] $
  script (svgAsPngFile texture) rotX rotY

texture :: SVG
texture = checker 10 10

script :: FilePath -> Double -> Double -> Text
script png rotX rotY =
  let png_ = T.pack png
      rotX_ = T.pack $ show rotX
      rotY_ = T.pack $ show rotY
  in [text|
#include "colors.inc"

//Place the camera
camera {
  perspective
  location <0,0,-9>
  look_at  <0,0,0>
  up y
  right x*16/9
}

//Ambient light to "brighten up" darker pictures
global_settings { ambient_light White*3 }

//Set a background color
background { color rgbt <0, 0, 0, 1> } // transparent

//Sphere with specified center point and radius
sphere {
  <0,0,0>, 3
  texture {
    uv_mapping pigment{
      image_map{ png "${png_}" }
    }
  }
  rotate <0,${rotY_},0>
  rotate <${rotX_},0,0>
}
|]

checker :: Int -> Int -> SVG
checker w h =
  withStrokeColor "lightblue" $
  withStrokeWidth (defaultStrokeWidth*4) $
  mkGroup
  [ withStrokeWidth 0 $
    withFillOpacity 0.8 $ mkBackground "white"
  , mkGroup
    [ translate (stepX*x-offsetX + stepX/2) 0 $
      mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
    | x <- map fromIntegral [0..w-1]
    ]
  ,
    mkGroup
    [ translate 0 (stepY*y-offsetY) $
      mkLine (-screenWidth/2, 0) (screenWidth/2, 0)
    | y <- map fromIntegral [0..h]
    ]
  ]
  where
    stepX = screenWidth/fromIntegral w
    stepY = screenHeight/fromIntegral h
    offsetX = screenWidth/2
    offsetY = screenHeight/2