mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-10 23:52:22 +00:00
4bfafa4d8e
Rewamp the scene api, add circle plots, add blender flips, fix caching issue in driver, fix bug in partialSvg. Former-commit-id: 5cb900521044fee13766dd7474fd9b72c7691686
426 lines
12 KiB
Haskell
426 lines
12 KiB
Haskell
#!/usr/bin/env stack
|
|
-- stack runghc --package reanimate
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE ApplicativeDo #-}
|
|
module Main (main) where
|
|
|
|
import Codec.Picture
|
|
import Control.Lens ((^.))
|
|
import Control.Monad
|
|
import Data.Fixed
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
import Data.String.Here
|
|
import Data.Text (Text)
|
|
import Graphics.SvgTree (Number (..), strokeWidth, toUserUnit)
|
|
import Reanimate
|
|
import Reanimate.Animation
|
|
import Reanimate.Builtin.Images
|
|
import Reanimate.Effect
|
|
import Reanimate.Povray
|
|
import Reanimate.Raster
|
|
import Reanimate.Scene
|
|
import Reanimate.Signal
|
|
import Reanimate.Svg
|
|
|
|
{- SCRIPT
|
|
|
|
Some ideas lend themselves well to be illustrated. Take spheres, for example: It
|
|
just so happens that the surface of a sphere is exactly 4 times the area of a
|
|
circle with the same radius.
|
|
|
|
Now, this relationship has already been visually explored by others in mucher
|
|
greater detail so I'll leave it at this. But there are countless other ideas and
|
|
concepts that deserve to be illustrated yet have not. I want to remedy this, in
|
|
part, by animating ideas I find interesting, but also by encouraging you to make
|
|
your own animations.
|
|
|
|
Every video on this channel, including this one, will be open-source with the source files
|
|
linked in the description. If any of the graphics pique your interest then
|
|
please download the code and play with it. The animations are created with a
|
|
library called 'reanimate' which, at its core, is a set of tools for generating
|
|
individual frames as SVG images. Layered on top of this core are external
|
|
components such as:
|
|
|
|
* LaTeX, for typesetting equations,
|
|
* a bitmap tracer, for turning pixel data into vector graphics,
|
|
* and a raytracer, for generating 3D graphics,
|
|
|
|
Raytracing is inherently a pixel-based graphics technique but, with a bit of math,
|
|
it and vector graphics can be overlayed with pixel-perfect precision.
|
|
|
|
Everything is held together by the purely functional language Haskell. Haskell
|
|
is particularlly well suited for this task since animations are inherently
|
|
immutable.
|
|
|
|
|
|
|
|
|
|
-}
|
|
|
|
main :: IO ()
|
|
main = reanimate $ animate (const $ mkBackground "black") `parA`
|
|
-- animate $ const $ checker 10 10
|
|
-- rotateSphere
|
|
-- rotateWireSphere
|
|
sphereIntro
|
|
-- introSVG
|
|
-- mapA (scale 2) $ setDuration 20 featLaTeX
|
|
|
|
playbackTest :: Animation
|
|
playbackTest = setDuration 10 feat3D
|
|
|
|
sphereIntro :: Animation
|
|
sphereIntro = sceneAnimation $ do
|
|
-- play $ drawSphere
|
|
-- # setDuration 15
|
|
-- # pauseAtEnd 2
|
|
-- play $ rotateWireSphere
|
|
-- # setDuration 2
|
|
-- # signalA (powerS 2)
|
|
fork $ play $ rotateWireSphere
|
|
# setDuration 1
|
|
# repeatA 10
|
|
# takeA (2+5)
|
|
# applyE (delayE 2 fadeOutE)
|
|
sphereX <- newVar 0
|
|
sphereS <- newSpriteA $
|
|
rotateSphere # repeatA (5+3+1+2)
|
|
-- sphereS <- newSprite $ do
|
|
-- -- xValue <- freezeVar sphereX
|
|
-- let a = rotateSphere # setDuration 1 # repeatA (5+3+1+2)
|
|
-- return $ \real_t d t ->
|
|
-- -- translate (xValue real_t) 0 $
|
|
-- frameAt t a
|
|
applyVar sphereX sphereS (\xValue -> translate xValue 0)
|
|
|
|
spriteE sphereS (overBeginning 1 $ constE $ withGroupOpacity 0)
|
|
spriteE sphereS (delayE 1 $ overBeginning 2 fadeInE)
|
|
-- fork $ play $ rotateSphere
|
|
-- # setDuration 1
|
|
-- # repeatA (5+3+1+2)
|
|
-- # applyE (overBeginning 1 $ constE $ withGroupOpacity 0)
|
|
-- # applyE (delayE 1 $ overBeginning 2 fadeInE)
|
|
-- # applyE (delayE 8 $ translateE (-3) 0)
|
|
wait 5
|
|
adjustZ (+1) $ play $ setDuration 3 $ animate $ \t ->
|
|
partialSvg t $
|
|
withFillOpacity 0 $
|
|
rotate 180 $
|
|
pathify $
|
|
circ
|
|
-- playZ 1 $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
|
-- withFillOpacity t $
|
|
-- circ
|
|
let scaleFactor = 0.05
|
|
tweenVar sphereX 1 $ \t x -> fromToS x (-3) (curveS 3 t)
|
|
fork $ adjustZ (+1) $ play $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
|
let p = curveS 3 t in
|
|
withFillOpacity p $
|
|
translate (1*p) (2*p) $
|
|
scale (1-scaleFactor*p) $
|
|
circ
|
|
fork $ adjustZ (+1) $ play $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
|
let p = curveS 3 t in
|
|
withFillOpacity p $
|
|
translate (1*p) (-2*p) $
|
|
scale (1-scaleFactor*p) $
|
|
circ
|
|
fork $ adjustZ (+1) $ play $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
|
let p = curveS 3 t in
|
|
withFillOpacity p $
|
|
translate (5*p) (2*p) $
|
|
scale (1-scaleFactor*p) $
|
|
circ
|
|
fork $ adjustZ (+1) $ play $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
|
let p = curveS 3 t in
|
|
withFillOpacity p $
|
|
translate (5*p) (-2*p) $
|
|
scale (1-scaleFactor*p) $
|
|
circ
|
|
where
|
|
circ =
|
|
withFillColor "blue" $
|
|
withStrokeColor "white" $
|
|
mkCircle 2
|
|
circEq = mkGroup
|
|
[ circ
|
|
, withFillColor "white" $
|
|
scale 0.5 $
|
|
center $ latexAlign "A=\\pi r^2"]
|
|
|
|
mkFeatSprite :: Double -> Double -> Animation
|
|
-> Scene s (Var s Double, Var s Double, Sprite s)
|
|
mkFeatSprite xPos yPos ani = do
|
|
spriteAt <- newVar 0
|
|
spriteTMod <- newVar 0
|
|
sprite <- newSprite $ do
|
|
genAt <- unVar spriteAt
|
|
genT <- unVar spriteTMod
|
|
t <- spriteT
|
|
d <- spriteDuration
|
|
return $
|
|
let i = 1-genAt in
|
|
translate (xPos*i) (yPos*i) $
|
|
scale (1+0.5*genAt) $
|
|
frameAtT (((t+genT)/d) `mod'` 1) ani
|
|
return (spriteAt, spriteTMod, sprite)
|
|
|
|
featSVG :: Animation
|
|
featSVG = animate $ const $ scale 0.4 $ svgLogo
|
|
|
|
feat3D :: Animation
|
|
feat3D = rotateSphere
|
|
# mapA (scale 0.5)
|
|
# repeatA 10
|
|
|
|
frameAtT :: Double -> Animation -> SVG
|
|
frameAtT t (Animation d f) = f t
|
|
|
|
featLaTeX :: Animation
|
|
featLaTeX = animate $ \t ->
|
|
translate 0 0.5 $
|
|
mkGroup
|
|
[ scale 1.5 $
|
|
center $
|
|
withFillColor "white" $
|
|
latex "\\LaTeX"
|
|
, frameAtT t $
|
|
fadeTransitions 0.2 $ map mkEQ [eq1, eq3, eq4, eq5]
|
|
]
|
|
where
|
|
eq1 = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
|
eq2 = "e=mc^2"
|
|
-- eq3 = "\\int_{a}^{b}f'(x)dx=f(b)-f(a)"
|
|
eq3 = "\\Delta \\times E=- \\frac{\\partial B}{\\partial t}"
|
|
eq4 = "\\frac{d}{dt}(\\frac{\\partial L}{\\partial \\dot{q}}) = \\frac{\\partial L}{\\partial q}"
|
|
eq5 = "\\vec{E} = \\frac{\\sigma}{2\\epsilon_0}\\hat{n}"
|
|
mkEQ txt =
|
|
drawAnimation $
|
|
withStrokeColor "white" $
|
|
withFillColor "white" $
|
|
withStrokeWidth 0.01 $
|
|
translate 0 (-1.5) $
|
|
scale 0.5 $
|
|
center $
|
|
latexAlign txt
|
|
|
|
fadeTransition :: Double -> Animation -> Animation -> Animation
|
|
fadeTransition overlap a b =
|
|
(a
|
|
# pauseAtEnd overlap
|
|
# applyE (overEnding overlap $ fadeOutE)
|
|
) `seqA` (
|
|
b
|
|
# applyE (overBeginning overlap $ fadeInE)
|
|
)
|
|
|
|
fadeTransitions :: Double -> [Animation] -> Animation
|
|
fadeTransitions overlap = foldl (fadeTransition overlap) (pause 0)
|
|
|
|
featWireSphere :: Animation
|
|
featWireSphere = rotateWireSphere
|
|
# mapA (scale 0.5)
|
|
# reverseA
|
|
# repeatA 10
|
|
|
|
introSVG :: Animation
|
|
introSVG = sceneAnimation $ do
|
|
fork $ play $ animate $ const $
|
|
mkBackground "black"
|
|
-- Title
|
|
title <- newSprite $
|
|
pure $
|
|
translate 0 3.5 $
|
|
center $
|
|
withFillColor "white" $
|
|
latex "reanimate"
|
|
spriteZ title 2
|
|
-- Shading
|
|
shadeOpacity <- newVar 0
|
|
shade <- newSprite $ do
|
|
opacity <- unVar shadeOpacity
|
|
return $
|
|
withFillOpacity (0.8 * opacity) $
|
|
withFillColor "black" $
|
|
mkRect screenWidth screenHeight
|
|
spriteZ shade 1
|
|
-- Modifier
|
|
let tweenFeat sp var varT initWait dur = do
|
|
wait initWait
|
|
spriteZ sp 2
|
|
tweenVar shadeOpacity 1 $ \t i -> fromToS i 1 (curveS 2 t)
|
|
tweenVar var 1 $ \t i -> fromToS i 1 (curveS 2 t)
|
|
tweenVar varT 1 $ \t i -> fromToS i 1 (curveS 2 t)
|
|
wait 1
|
|
tweenVar varT dur $ \t i -> fromToS i (1+dur) (t/dur)
|
|
wait dur
|
|
tweenVar var 1 $ \t i -> fromToS i 0 (curveS 2 t)
|
|
tweenVar varT dur $ \t i -> fromToS i (1+dur+1) $ curveS 2 (t/dur)
|
|
tweenVar shadeOpacity 1 $ \t i -> fromToS i 0 (curveS 2 t)
|
|
wait 1
|
|
spriteZ sp 0
|
|
-- SVG
|
|
(svgAt, svgT, svgS) <- mkFeatSprite (-5.5) (1.5) featSVG
|
|
fork $ tweenFeat svgS svgAt svgT svgHighlight svgHighlightDur
|
|
-- LaTeX
|
|
(latexAt, latexT, latexS) <- mkFeatSprite (5.5) (1.5) featLaTeX
|
|
fork $ tweenFeat latexS latexAt latexT latexHighlight latexHighlightDur
|
|
-- Tracing
|
|
(traceAt, traceT, traceS) <- mkFeatSprite (-5.5) (-2.5) featWireSphere
|
|
fork $ tweenFeat traceS traceAt traceT traceHighlight traceHighlightDur
|
|
-- Raytracing
|
|
(rayAt, rayT, rayS) <- mkFeatSprite (5.5) (-2.5) feat3D
|
|
fork $ tweenFeat rayS rayAt rayT rayHighlight rayHighlightDur
|
|
-- wait
|
|
wait $ rayHighlight + rayHighlightDur + 2 + 10
|
|
return ()
|
|
where
|
|
svgHighlight = 1
|
|
svgHighlightDur = 3
|
|
latexHighlight = svgHighlight+svgHighlightDur+2
|
|
latexHighlightDur = 3
|
|
traceHighlight = latexHighlight+latexHighlightDur+2
|
|
traceHighlightDur = 3
|
|
rayHighlight = traceHighlight+traceHighlightDur+2
|
|
rayHighlightDur = 3
|
|
|
|
drawAnimation :: SVG -> Animation
|
|
drawAnimation = drawAnimation' 0.5 0.3
|
|
|
|
drawAnimation' :: Double -> Double -> SVG -> Animation
|
|
drawAnimation' fillDur step svg = sceneAnimation $ do
|
|
forM_ (zip [0..] $ 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
|
|
-- play $ animate (\t -> withStrokeWidth 0 $ fn $ withFillOpacity t tree)
|
|
-- # setDuration fillDur
|
|
-- # pauseAtEnd ((len-n)*step)
|
|
where
|
|
len = fromIntegral $ length $ svgGlyphs svg
|
|
|
|
drawSphere :: Animation
|
|
drawSphere = animate $ \t ->
|
|
partialSvg t $
|
|
withStrokeColor "white" $
|
|
withStrokeWidth 0.01 $
|
|
withFillOpacity 0 $
|
|
lowerTransformations $
|
|
flipYAxis $
|
|
translate (-screenWidth/2) (-screenHeight/2) $
|
|
scale 0.00625 $
|
|
mkPath $ extractPath $
|
|
vectorize_ ["-i"] $
|
|
povraySlow' [] (script (svgAsPngFile texture) 0)
|
|
|
|
rotateWireSphere :: Animation
|
|
rotateWireSphere = animate $ \t ->
|
|
withStrokeColor "white" $
|
|
withStrokeWidth 0.01 $
|
|
withFillOpacity 0 $
|
|
lowerTransformations $
|
|
flipYAxis $
|
|
translate (-screenWidth/2) (-screenHeight/2) $
|
|
scale (screenWidth/2560) $
|
|
mkPath $ extractPath $
|
|
vectorize_ ["-i"] $
|
|
povraySlow' [] (script (svgAsPngFile texture) (t*360/10))
|
|
|
|
rotateSphere :: Animation
|
|
rotateSphere = animate $ \t ->
|
|
povraySlow [] (script (svgAsPngFile texture) (t*360/10))
|
|
|
|
texture :: SVG
|
|
texture = checker 10 10
|
|
|
|
script :: FilePath -> Double -> Text
|
|
script png 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
|
|
up <0,9,0>
|
|
right <16,0,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>, 2
|
|
texture {
|
|
//pigment{ color rgbt <0,0,1,0.1> }
|
|
uv_mapping pigment{
|
|
image_map{ png ${png} }
|
|
//color rgbt <0,0,1,0.1>
|
|
}
|
|
}
|
|
rotate <0,${s'},0>
|
|
rotate <-30,0,0>
|
|
}
|
|
|]
|
|
where
|
|
precision = 0.1
|
|
s' = fromIntegral (round (s / precision)) * precision
|
|
|
|
checker :: Int -> Int -> SVG
|
|
checker w h =
|
|
withFillColor "white" $
|
|
withStrokeColor "white" $
|
|
withStrokeWidth 0.1 $
|
|
mkGroup
|
|
[ withStrokeWidth 0 $
|
|
withFillOpacity 0.8 $ mkBackground "blue"
|
|
, 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
|