mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-10 23:52:22 +00:00
4356efbc7e
* Disable windows CI (because of hmatrix) * Implement ear-clip triangulation. * Implement common framework for polygon morphing. * Draft implementations of compatible triangulation and mesh smoothing. * Implement least-work morphing. * Implement as-rigid-as-possible morphing. * Implement SSSP. * Draft article about polygon morphing. Former-commit-id: f6f19f58b9dd58c655bcca0ed2d65f72726f0a06
63 lines
1.8 KiB
Haskell
Executable file
63 lines
1.8 KiB
Haskell
Executable file
#!/usr/bin/env stack
|
|
-- stack runghc --package reanimate
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ParallelListComp #-}
|
|
module Main(main) where
|
|
|
|
import Codec.Picture
|
|
import Codec.Picture.Types
|
|
import Control.Monad
|
|
import Graphics.SvgTree (LineJoin (..))
|
|
import Reanimate
|
|
import Reanimate.Morph.Common
|
|
import Reanimate.Morph.Linear
|
|
import Reanimate.Morph.LineBend
|
|
|
|
bgColor :: PixelRGBA8
|
|
bgColor = PixelRGBA8 252 252 252 0xFF
|
|
|
|
main :: IO ()
|
|
main = reanimate $
|
|
addStatic (mkBackgroundPixel bgColor) $
|
|
mapA (withStrokeWidth defaultStrokeWidth) $
|
|
mapA (withStrokeColor "black") $
|
|
mapA (withStrokeLineJoin JoinRound) $
|
|
mapA (withFillOpacity 1) $
|
|
sceneAnimation $ do
|
|
_ <- newSpriteSVG $
|
|
withStrokeWidth 0 $ translate (-3) 4 $
|
|
center $ latex "linear"
|
|
_ <- newSpriteSVG $
|
|
withStrokeWidth 0 $ translate (3) 4 $
|
|
center $ latex "line bend"
|
|
forM_ pairs $ uncurry showPair
|
|
where
|
|
showPair from to =
|
|
waitOn $ do
|
|
fork $ play $ mkAnimation 4 (morph linear from to)
|
|
# mapA (translate (-3) (-0.5))
|
|
# signalA (curveS 4)
|
|
fork $ play $ mkAnimation 4 (morph myMorph from to)
|
|
# mapA (translate (3) (-0.5))
|
|
# signalA (curveS 4)
|
|
|
|
myMorph = linear{morphTrajectory = lineBend }
|
|
pairs = zip stages (tail stages ++ [head stages])
|
|
stages = map (lowerTransformations . scale 6 . pathify . center) $ colorize
|
|
[ latex "X"
|
|
, latex "$\\aleph$"
|
|
, latex "Y"
|
|
, latex "$\\infty$"
|
|
, latex "I"
|
|
, latex "$\\pi$"
|
|
, latex "1"
|
|
, latex "S"
|
|
, mkRect 0.5 0.5
|
|
]
|
|
|
|
colorize :: [SVG] -> [SVG]
|
|
colorize lst =
|
|
[ withFillColorPixel (promotePixel $ parula (n/fromIntegral (length lst-1))) elt
|
|
| elt <- lst
|
|
| n <- [0..]
|
|
]
|