mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-11 16:12:20 +00:00
0aca2333e2* Remove redundant brackets * Various hlint fixes * Remove unused language pragrams and other fixes * Use addStatic more consistently in examples * Rename remaining usages of sceneAnimation to scene
125 lines
4.1 KiB
Haskell
Executable file
125 lines
4.1 KiB
Haskell
Executable file
#!/usr/bin/env stack
|
|
-- stack runghc --package reanimate
|
|
{-# LANGUAGE ApplicativeDo #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main(main) where
|
|
|
|
import Codec.Picture
|
|
import Control.Lens ((&))
|
|
import Data.List (transpose)
|
|
import qualified Data.Vector as V
|
|
import Graphics.SvgTree (LineJoin (..))
|
|
import Linear.V2
|
|
import Linear.Vector
|
|
import Reanimate
|
|
import Reanimate.Math.Polygon
|
|
import Reanimate.Morph.Common
|
|
import Reanimate.Morph.Linear
|
|
import Reanimate.Morph.Rotational
|
|
|
|
bgColor :: PixelRGBA8
|
|
bgColor = PixelRGBA8 252 252 252 0xFF
|
|
|
|
spike1 :: Polygon
|
|
spike1 = pScale 2.5 $ mkPolygon $ V.map (\x -> x - V2 1 1) $ V.fromList
|
|
[ V2 0 0, V2 2 0
|
|
, V2 2 1 ]
|
|
|
|
spike2 :: Polygon
|
|
spike2 = pScale 2.5 $ mkPolygon $ V.map (\x -> x - V2 1 1) $ V.fromList
|
|
[ V2 0 0, V2 2 0
|
|
, V2 0 1 ]
|
|
|
|
polygonShape :: Polygon -> SVG
|
|
polygonShape p = mkLinePathClosed
|
|
[ (x,y) | V2 x y <- map (fmap realToFrac) $ V.toList (polygonPoints p) ]
|
|
|
|
|
|
main :: IO ()
|
|
main = reanimate $
|
|
addStatic (mkBackgroundPixel bgColor) $
|
|
mapA (withStrokeWidth defaultStrokeWidth) $
|
|
mapA (withStrokeColor "black") $
|
|
mapA (withStrokeLineJoin JoinRound) $
|
|
mapA (withFillOpacity 1) $
|
|
scene $ do
|
|
_ <- newSpriteSVG $
|
|
withStrokeWidth 0 $ translate (-4) 4 $
|
|
center $ latex "linear"
|
|
_ <- newSpriteSVG $
|
|
withStrokeWidth 0 $ translate 4 4 $
|
|
center $ latex "rotational"
|
|
originVar <- newVar (0.5, 0.5)
|
|
|
|
showTrails originVar
|
|
|
|
let pushLeft newOrigin = do
|
|
fork $ tweenVar originVar 0.5 $ \(x,y) t ->
|
|
let t' = curveS 2 t in
|
|
(fromToS x (fst newOrigin) t', fromToS y (snd newOrigin) t')
|
|
showPair originVar spike1 spike2
|
|
pushRight newOrigin = do
|
|
fork $ tweenVar originVar 0.5 $ \(x,y) t ->
|
|
let t' = curveS 2 t in
|
|
(fromToS x (fst newOrigin) t', fromToS y (snd newOrigin) t')
|
|
showPair originVar spike2 spike1
|
|
|
|
pushLeft (1, 0.5)
|
|
pushRight (0.1, 0.95)
|
|
pushLeft (0.5, 1)
|
|
pushRight (0.5, 2)
|
|
pushLeft (-0.3, -0.2)
|
|
pushRight (0.5, 0.5)
|
|
where
|
|
showTrails originVar = do
|
|
_ <- newSpriteSVG $
|
|
translate (-4) (-0.5) $
|
|
genTrails (map linearTrajectory [(spike1, spike2)])
|
|
_ <- newSprite $ do
|
|
origin <- unVar originVar
|
|
pure $
|
|
translate 4 (-0.5) $
|
|
genTrails (map (rotationalTrajectory origin) [(spike1, spike2)])
|
|
return ()
|
|
showPair originVar from to =
|
|
waitOn $ do
|
|
fork $ play $ mkAnimation 2 (morph linear (polygonShape from) (polygonShape to))
|
|
& mapA (translate (-4) (-0.5))
|
|
& mapA (withFillColor "lightgreen")
|
|
& signalA (curveS 4)
|
|
s <- fork $ newSprite $ do
|
|
origin <- unVar originVar
|
|
t <- spriteT
|
|
d <- spriteDuration
|
|
pure $
|
|
let localTime = curveS 4 (t/d)
|
|
myMorph = linear{morphTrajectory = rotationalTrajectory origin }
|
|
originSrc = polygonOrigin from origin
|
|
originDst = polygonOrigin to origin
|
|
V2 originX originY = lerp localTime originDst originSrc
|
|
in
|
|
translate 4 (-0.5) $ mkGroup
|
|
[ withFillColor "cyan" $
|
|
morph myMorph (polygonShape from) (polygonShape to) localTime
|
|
, withFillColor "red" $ translate originX originY $
|
|
mkCircle 0.1
|
|
]
|
|
wait 2
|
|
destroySprite s
|
|
|
|
genTrails :: [Double -> Polygon] -> SVG
|
|
genTrails plotters =
|
|
withFillOpacity 0 $
|
|
withStrokeWidth (defaultStrokeWidth*0.5) $
|
|
withStrokeColor "black" $
|
|
withStrokeDashArray [0.1,0.05] $
|
|
mkGroup $ map mkTrail $ transpose $ concat
|
|
[
|
|
[ V.toList $ V.map (fmap realToFrac) (polygonPoints poly)
|
|
| n <- [0..steps]
|
|
, let poly = plotter (fromIntegral n / fromIntegral steps)
|
|
]
|
|
| plotter <- plotters ]
|
|
where
|
|
steps = 100 :: Int
|
|
mkTrail lst = mkLinePath [ (x,y) | V2 x y <- lst ]
|