reanimate-0.4.2.0: examples/tut_glue_blender.hs
#!/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 Data.Monoid
import qualified Data.Text as T
import Graphics.SvgTree hiding (text)
import NeatInterpolation
import System.Random
import "random-shuffle" System.Random.Shuffle
-- spritePercent = (/) <$> spriteT <*> spriteDur
main :: IO ()
main = seq texture $ reanimate $ pauseAtEnd 1 $ addStatic 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
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
[ withStrokeWidth 0 $
withFillOpacity 1 $ 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 = 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
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)