mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-10 23:52:22 +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
100 lines
3.2 KiB
Haskell
Executable file
100 lines
3.2 KiB
Haskell
Executable file
#!/usr/bin/env stack
|
|
-- stack runghc --package reanimate
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main(main) where
|
|
|
|
import Codec.Picture
|
|
import Codec.Picture.Types
|
|
import Control.Lens ((&))
|
|
import Control.Monad (replicateM_)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Vector as V
|
|
import Linear.V2
|
|
import Linear.Vector
|
|
import Reanimate
|
|
import Reanimate.Math.Polygon
|
|
import Reanimate.Morph.Common
|
|
import Reanimate.Morph.Linear
|
|
|
|
bgColor :: PixelRGBA8
|
|
bgColor = PixelRGBA8 252 252 252 0xFF
|
|
|
|
main :: IO ()
|
|
main = reanimate $
|
|
addStatic (mkBackgroundPixel bgColor) $
|
|
mapA (withStrokeWidth 0) $
|
|
mapA (withStrokeColor "black") $
|
|
mapA (withFillOpacity 1) $
|
|
scene $ do
|
|
let pl1 = translate (-4) 0 $ mkGroup
|
|
[ lowerTransformations $ scale 3 $ withFillOpacity 1 $
|
|
withStrokeColor "black" $
|
|
withStrokeWidth defaultStrokeWidth $
|
|
withFillColor "lightgreen" $
|
|
polygonShape octogon
|
|
, lowerTransformations $ scale 3 $ polygonNumDots octogon 0
|
|
]
|
|
pl2 n t = translate 4 0 $ lowerTransformations $ scale 3 $ mkGroup
|
|
[ withFillOpacity 1 $
|
|
withStrokeColor "black" $
|
|
withStrokeWidth defaultStrokeWidth $
|
|
withFillColor "cyan" $
|
|
polygonShape (pSetOffset star n)
|
|
, polygonNumDots (pSetOffset star n) t ]
|
|
offset <- newVar 0
|
|
slide <- newVar 0
|
|
_ <- newSprite $ pl2 <$> unVar offset <*> unVar slide
|
|
_ <- newSpriteSVG pl1
|
|
let slideLeft = do
|
|
tweenVar slide 1 $ \v -> fromToS v 1 . curveS 4
|
|
writeVar slide 0
|
|
modifyVar offset succ
|
|
replicateM_ 8 $ do
|
|
offsetVal <- readVar offset
|
|
play $ step pl1 (pl2 offsetVal 0)
|
|
& setDuration 3
|
|
slideLeft
|
|
where
|
|
step from to =
|
|
signalA (curveS 2) $ animate $ morph rawLinear from to
|
|
|
|
octogon :: Polygon
|
|
octogon = mkPolygon $ V.fromList
|
|
[ realToFrac <$> V2 (cos phi) (sin phi)
|
|
| n <- [0..7]
|
|
, let phi = n*2*pi/8 + pi/8 :: Double
|
|
]
|
|
|
|
star :: Polygon
|
|
star = pScale 0.5 $ mkPolygon $ V.fromList
|
|
[ V2 0 1, V2 (-2) 2, V2 (-1) 0
|
|
, V2 (-2) (-2), V2 0 (-1), V2 2 (-2)
|
|
, V2 1 0, V2 2 2 ]
|
|
|
|
genColor :: Int -> Int -> PixelRGBA8
|
|
genColor n m =
|
|
promotePixel $ parula (fromIntegral (n+offset) / fromIntegral (m+offset))
|
|
where
|
|
offset = 5
|
|
|
|
polygonNumDots :: Polygon -> Double -> SVG
|
|
polygonNumDots p t = mkGroup $ reverse
|
|
[ mkGroup
|
|
[ colored n $ withStrokeWidth (defaultStrokeWidth*0.5) $ withStrokeColor "black" $
|
|
translate x y $ pathify $ mkCircle circR
|
|
, withFillColor "black" $
|
|
translate x y $ ppNum n ]
|
|
| n <- [0..pSize p-1]
|
|
, let a = realToFrac <$> pAccess p n
|
|
b = realToFrac <$> pAccess p (pNext p n)
|
|
V2 x y = lerp t b a ]
|
|
where
|
|
circR = 0.1
|
|
colored n =
|
|
let c = genColor n (pSize p-1)
|
|
in withFillColorPixel c
|
|
ppNum n = scaleToHeight (circR*1.5) $ center $ latex $ T.pack $ "\\texttt{" ++ show n ++ "}"
|
|
|
|
polygonShape :: Polygon -> SVG
|
|
polygonShape p = mkLinePathClosed
|
|
[ (x,y) | V2 x y <- map (fmap realToFrac) $ V.toList (polygonPoints p) ]
|