mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-09 07:03:11 +00:00
94 lines
2.9 KiB
Haskell
Executable file
94 lines
2.9 KiB
Haskell
Executable file
#!/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)
|