Gallery

This file is auto-generated by docs/render_all.sh. DO NOT EDIT.

boundingbox

View boundingbox.hs

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

import           Graphics.SvgTree (Tree)
import           Reanimate

main :: IO ()
main = reanimate bbox

bbox :: Animation
bbox = bg `parA`
    mapA (translate (-screenWidth/4) 0) bbox1 `parA`
    mapA (translate (screenWidth/4) 0) bbox2
  where
    bg = animate $ const $ mkBackground "black"

bbox1 :: Animation
bbox1 = mkAnimation 5 $ \t ->
    mkGroup
      [ mkBoundingBox $ rotate (360*t) svg
      , withFillColor "white" $ rotate (360*t) svg ]
  where
    svg = scale 2 $ center $ latexAlign "\\sum_{k=1}^\\infty"

bbox2 :: Animation
bbox2 = playThenReverseA $ mkAnimation 2.5 $ \t ->
  mkGroup
    [ mkBoundingBox $ partialSvg t heartShape
    , withStrokeColor "white" $ withFillOpacity 0 $
      partialSvg t heartShape ]

mkBoundingBox :: Tree -> Tree
mkBoundingBox svg = withStrokeColor "red" $ withFillOpacity 0 $
    translate (x+w/2) (y+h/2) $
    mkRect w h
  where
    (x, y, w, h) = boundingBox svg

heartShape :: Tree
heartShape = lowerTransformations $ scaleXY 1 (-1) $ scale 0.1 $
    center $ rotateAroundCenter 225 $ mkPathString
      "M0.0,40.0 v-40.0 h40.0\
      \a20.0 20.0 90.0 0 1 0.0,40.0\
      \a20.0 20.0 90.0 0 1 -40.0,0.0 Z"
  





colormaps

View colormaps.hs

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

import           Codec.Picture
import qualified Data.Colour.CIE            as CIE
import           Data.Colour.CIE.Illuminant (d65)
import           Data.Colour.RGBSpace
import           Data.Colour.SRGB
import           Data.Word
import           Graphics.SvgTree           (Tree)
import           Reanimate

-- Cycle the animation if we want to upload it to youtube.
youtube :: Animation -> Animation
-- youtube = repeatAnimation 6
youtube = id

main :: IO ()
main = reanimate $ youtube $ pauseAtEnd 2 $ playThenReverseA $ pauseAtEnd 2 $ mkAnimation 5 $ \t ->
    let s           = curveS 2 t
        offsetWidth = screenWidth * 0.5
        nubWidth    = 0.2
        textYOffset = 0.2
    in mkGroup
      [ mkBackground "black"
      , translate 0 (screenHeight/2*0.85) $ withFillColor "white" $ mkGroup
        [ translate (offsetWidth*s - offsetWidth/2) 0 $
          withFillColor "white" $ mkCircle nubWidth
        , withStrokeColor "white" $ withStrokeWidth 0.05 $
          mkLine (-(offsetWidth-nubWidth)/2, 0)
                 ((offsetWidth-nubWidth)/2, 0)
        , translate (-offsetWidth/2-1.0) textYOffset $
          scale 0.5 $ centerX $ latex "Color"
        , translate (offsetWidth/2+1.5) textYOffset $
          scale 0.5 $ centerX $ latex "Greyscale"
        ]
      , translate (-columnX) (rowInit-rowStep*0) $ mkOutline "viridis" (dimmer s . viridis)
      , translate (-columnX) (rowInit-rowStep*1) $ mkOutline "inferno" (dimmer s . inferno)
      , translate (-columnX) (rowInit-rowStep*2) $ mkOutline "cividis" (dimmer s . cividis)
      , translate (-columnX) (rowInit-rowStep*3) $ mkOutline "jet" (dimmer s . jet)
      , translate (-columnX) (rowInit-rowStep*4) $ mkOutline "turbo" (dimmer s . turbo)

      , translate columnX (rowInit-rowStep*0) $ mkOutline "magma" (dimmer s . magma)
      , translate columnX (rowInit-rowStep*1) $ mkOutline "plasma" (dimmer s . plasma)
      , translate columnX (rowInit-rowStep*2) $ mkOutline "sinebow" (dimmer s . sinebow)
      , translate columnX (rowInit-rowStep*3) $ mkOutline "hsv" (dimmer s . hsv)
      , translate columnX (rowInit-rowStep*4) $ mkOutline "parula" (dimmer s . parula)
      ]
  where
    rowInit = 2.2
    rowStep = 1.2
    columnX = screenWidth/4

    mkOutline label f =
      mkGroup
      [ center $ withFillColor "grey" $ mkRect (scaleWidth+0.05) (scaleHeight+0.05)
      , scaleToSize scaleWidth scaleHeight $ mkColorMap f
      , translate (-scaleWidth/2) 0.5 $ centerY $ withFillColor "white" $
        scale 0.5 $ latex label
      ]
    scaleWidth = screenWidth/8*3
    scaleHeight = screenHeight/20

mkColorMap :: (Double -> PixelRGB8) -> Tree
mkColorMap f = center $ embedImage img
  where
    width = 1000
    height = 1
    img = generateImage pixelRenderer width height
    pixelRenderer x _y = f (fromIntegral x / fromIntegral width)

dimmer :: Double -> PixelRGB8 -> PixelRGB8
dimmer switch (PixelRGB8 r g b) =
    PixelRGB8 r' g' b'
  where
    (lStar, aStar, bStar) = CIE.cieLABView d65 (sRGBBounded r g b :: Colour Double)
    RGB r' g' b' = toSRGBBounded $ CIE.cieLAB d65 lStar (aStar*c) (bStar*c) :: RGB Word8
    c = 1-switch
  





goo

View goo.hs

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

import           Control.Lens

import           Graphics.SvgTree
import           Reanimate

main :: IO ()
main = reanimate $ playThenReverseA $ mkAnimation 5 $ \t ->
    let s = fromToS 0 1.5 $ curveS 2 t in
    mkGroup
    [ mkBackground "black"
    , 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))
    , 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))
    , translate 0 (radius*2.2) $ withFillColor "red" $ mkGroup
      [ translate (s*(-radius)) 0 circ
      , translate (s*radius) 0 circ
      ]
    , withFillColor "red" $ mkGroup
      [ translate (s*(-radius)) 0 circ
      , translate (s*radius) 0 circ
      ] & filterRef .~ pure (Ref "blur")
    , translate 0 (-radius*2.2) $ withFillColor "red" $ mkGroup
      [ translate (s*(-radius)) 0 circ
      , translate (s*radius) 0 circ
      ] & filterRef .~ pure (Ref "goo")
    ]
  where
    sharpness = 10 :: Integer
    dev = 0.2
    radius = 1
    circ = mkCircle radius

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





latex_basic

View latex_basic.hs

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

import           Reanimate

main :: IO ()
main = reanimate $ playThenReverseA $ mkAnimation 2 $ \t ->
    mkGroup
      [ mkBackground "black"
      , withStrokeColor "white" $ withFillOpacity 0 text
      , withFillColor "white" $ withFillOpacity t text
      ]
  where
    text = withStrokeWidth 0.01 $ scale 2 $ center $ latexAlign
      "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
  





latex_color

View latex_color.hs

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

import           Reanimate

main :: IO ()
main = reanimate $ animate $ const $
    mkGroup
    [ mkBackground "black"
    , withStrokeColor "white" $
      withSubglyphs [0] (withFillColor "blue") $
      withSubglyphs [1] (withFillColor "yellow") $
      withSubglyphs [2] (withFillColor "green") $
      withSubglyphs [3] (withFillColor "red") $
      withSubglyphs [4] (withFillColor "darkslategrey")
      svg ]
  where
    svg = withStrokeWidth 0.01 $ scale 4 $ center $ latex "\\LaTeX"
  





latex_draw

View latex_draw.hs

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

import           Reanimate

main :: IO ()
main = reanimate $
    bg `parA` (playThenReverseA $ drawText `andThen` fillText)
  where
    bg = animate $ const $ mkBackground "black"
    msg = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
    glyphs = withStrokeWidth 0.01 $ center $ latexAlign msg
    fillText = mkAnimation 1 $ \t ->
      scale 2 $ withFillColor "white" $ withFillOpacity t glyphs
    drawText = mkAnimation 2 $ \t ->
      scale 2 $
        withStrokeColor "white" $ withFillOpacity 0 $
          partialSvg t glyphs
  





latex_wheel

View latex_wheel.hs

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

import           Control.Monad    (forM_)
import           Graphics.SvgTree (Tree)
import           Reanimate

main :: IO ()
main = reanimate $ bg `parA` mainScene
  where
    bg = animate $ const $ mkBackground "black"

mainScene :: Animation
mainScene = sceneAnimation $ mdo
    play $ drawCircle
      # setDuration drawCircleT
      # applyE (constE $ scaleXY (-1) 1)
    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
    return ()
  where
    drawCircleT = 1
    rotateT     = 5
    rotateN     = 3

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

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

drawCircle :: Animation
drawCircle = animate $ \t ->
    withFillOpacity 0 $
    withStrokeColor "white" $
    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 "white" $
    rotate (t*360) $
    translate 0 radius $
    svg
  





raster

View raster.hs

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

import           Reanimate
import           Codec.Picture

main :: IO ()
main = reanimate $ mkAnimation 5 $ \t ->
    mkGroup
      [ mkBackground "black"
      , rotate (t*360) $ scaleToWidth 6 $ embedImage img
      ]
  where
    img = generateImage pixelRenderer 255 255
    pixelRenderer x y = PixelRGB8 (fromIntegral x) (fromIntegral y) 128
  





sphere

View sphere.hs

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

import           Reanimate
import           Data.String.Here

main :: IO ()
main = reanimate $ mkAnimation 5 $ \t ->
    let s = fromToS 0 360 t in
    mkGroup
    [ mkBackground "black"
    , povray [] (script s) ]
  where
    script s = [iTrim|
//EXAMPLE OF SPHERE

//Files with predefined colors and textures
#include "colors.inc"
#include "glass.inc"
#include "golds.inc"
#include "metals.inc"
#include "stones.inc"
#include "woods.inc"

#include "shapes3.inc"

//Place the camera
camera {
  orthographic
  angle 50
  location <0,0,-10>
  look_at  <0,0,0>
  right x*image_width/image_height
}


//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>, 2
  texture {
    pigment{ color rgbt <0,0,1,0.1> }
  }
}

object {
  Ring_Sphere(2.00, 2.02, 0.015, 0.015, 12, 12)
  texture {
    pigment{ color<1,1,1> }
  }
  rotate <0,${s},0>
  rotate <-30,0,0>
}


             |]
  





blender_default_cube

View blender_default_cube.hs

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

import           Data.String.Here
import           Reanimate

main :: IO ()
main = reanimate $ mkAnimation 5 $ \t ->
  let s = t * pi in
  mkGroup
  [ mkBackground "black"
  , blender (script s)
  , withFillColor "white" $
    translate 0 2 $
    mkText "default cube"
  ]
  where
    script s = [iTrim|
import bpy

if __name__ == "__main__":
    # Args
    resolution_percentage = 40

    # Setting
    default_scene = bpy.context.scene
    default_scene.render.resolution_percentage = resolution_percentage
    default_scene.render.film_transparent = True

    default_cube = bpy.data.objects["Cube"]
    default_cube.rotation_euler = (0,0,${s})

    # Rendering
    bpy.ops.render.render(animation=False, write_still=True)
|]
  





tut_glue_svg

View tut_glue_svg.hs

  #!/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 $ bg `parA` chainT (overlapT transitionTime fadeT)
      [comp1, comp2, comp3, comp4, comp5, comp6, comp7, setDuration transitionTime comp1]
  where
    bg = animate $ const $ 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*0.3) $
      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
  





tut_glue_animate

View tut_glue_animate.hs

  #!/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 $ bg `parA`
    chainT transition
    [animateCircleR, animateCircleP, animateRectR, animateColor
    ,signalA (constantS 0) $ setDuration transitionTime animateCircleR]
  where
    transition = overlapT transitionTime fadeT
    bg = animate $ const $ 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)
  





tut_glue_keyframe

View tut_glue_keyframe.hs

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

import           Reanimate

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

main :: IO ()
main = reanimate $ bg `parA` mainScene
  where
    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)

mainScene :: Animation
mainScene = sceneAnimation $ 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 0.01 $
        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
  





tut_glue_fourier

View tut_glue_fourier.hs

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

import           Data.Complex
import           Graphics.SvgTree
import           Linear.V2
import           Reanimate
import           Reanimate.Ease
import           Codec.Picture

-- layer 3
main :: IO ()
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
    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
  





tut_glue_physics

View tut_glue_physics.hs

  #!/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.Monad       (forM_)
import           Linear.V2           (V2 (..))
import           Reanimate
import           Reanimate.Chiphunk
import           Reanimate.PolyShape
import           Reanimate.Ease
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)
  





tut_glue_latex

View tut_glue_latex.hs

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

import           Reanimate

import           Codec.Picture
import           Codec.Picture.Types
import           Control.Lens          ((^.))
import           Control.Monad
import           Data.Monoid
import           Graphics.SvgTree
import           System.Random
import           System.Random.Shuffle

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

latexExample :: Animation
latexExample = sceneAnimation $ 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 = 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
        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)
  





tut_glue_povray

View tut_glue_povray.hs

  #!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE ApplicativeDo     #-}
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.Monoid
import           Data.String.Here
import           Data.Text             (Text)
import           Graphics.SvgTree      hiding (Text)
import           System.Random
import           System.Random.Shuffle


main :: IO ()
main = reanimate $ sceneAnimation $ 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 = [iTrim|
#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

polygon {
  4,
  <0, 0>, <0, 1>, <1, 1>, <1, 0>
  texture {
    pigment{
      image_map{ png ${png} }
    }
  }
  translate <-1/2,-1/2>
  scale <16,9>
  rotate <0,${rotX},${rotZ}>
  translate <0,0,${transZ}>
}
|]


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



latexExample :: Animation
latexExample = sceneAnimation $ 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 = 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
        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)
  





tut_glue_povray_ortho

View tut_glue_povray_ortho.hs

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

import           Reanimate
import           Reanimate.Povray

import           Codec.Picture
import           Codec.Picture.Types
import           Control.Lens          ((^.))
import           Control.Monad
import           Data.Monoid
import           Data.String.Here
import           Data.Text             (Text)
import           Graphics.SvgTree      hiding (Text)
import           System.Random
import           System.Random.Shuffle


main :: IO ()
main = reanimate $ parA bg $ sceneAnimation $ 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
    tweenVar yRot tDuration (\t v -> fromToS v (v+180) $ curveS 2 (t/tDuration))
    tweenVar xRot (tDuration/2) (\t v -> fromToS v (v+60) $ curveS 2 (t/(tDuration/2)))
    fork $ do
      wait (tDuration/2)
      tweenVar xRot (tDuration/2) (\t v -> fromToS v (v-60) $ curveS 2 (t/(tDuration/2)))
    wait tDuration
    wait 2
  where
    bg = animate $ const $ 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 = [iTrim|
//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
}


//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
  [ 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




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


latexExample :: Animation
latexExample = 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}"
    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
        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)
  





tut_glue_potrace

View tut_glue_potrace.hs

  #!/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.Monad
import           Data.String.Here
import           Data.Text             (Text)

main :: IO ()
main = reanimate $ parA bg $ sceneAnimation $ 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 = animate $ const $ 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 = [iTrim|
#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
  





tut_glue_blender

View tut_glue_blender.hs

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

import           Reanimate

import           Codec.Picture.Types
import           Control.Lens          ((^.))
import           Control.Monad
import           Data.Monoid
import           Data.String.Here
import qualified Data.Text             as T
import           Graphics.SvgTree
import           System.Random
import           System.Random.Shuffle

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

main :: IO ()
main = seq texture $ reanimate $ pauseAtEnd 1 $ parA bg $ sceneAnimation $ 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
    tweenVar trans 5 (\t v -> fromToS v (-2) $ curveS 2 t)
    tweenVar bend 5 (\t v -> fromToS v 1 $ curveS 2 t)
    tweenVar rotY 15 (\t v -> fromToS v (pi*2*2) $ curveS 2 t)
    fork $ do
      tweenVar rotX 5 (\t v -> fromToS v (-pi/5) $ curveS 2 t)
      wait 5
      tweenVar rotX 5 (\t v -> fromToS v (pi/5) $ curveS 2 t)
    wait (15-5)
    tweenVar bend 5 (\t v -> fromToS v 0 $ curveS 2 t)
    tweenVar rotX 5 (\t v -> fromToS v 0 $ curveS 2 t)
    tweenVar trans 5 (\t v -> fromToS v 0 $ curveS 2 t)
    wait 4
    -- tweenVar trans 1 (\t v -> fromToS v 0 $ curveS 2 t)
    wait 1
    wait 2
  where
    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)

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 = [iTrim|
import os
import math

import bpy

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,${fromToS (9/2) 4 bend},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')
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'])

image_node.image = bpy.data.images.load('${T.pack 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.render.engine = 'CYCLES'
#scn.render.resolution_percentage = 10

scn.render.film_transparent = True

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

checker :: Int -> Int -> SVG
checker w h =
  withStrokeColor "lightblue" $
  withStrokeWidth (defaultStrokeWidth/2) $
  mkGroup
  [ withStrokeWidth 0 $
    withFillOpacity 1 $ mkBackground "grey"
  , 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 = 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}"
    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
        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)