reanimate/examples/tut_glue_animate.hs
Jan Hrček b82e7e5614 Run 'chmod +x' on all example scripts
Former-commit-id: eed522cbdf8c6e5262c6c8b487d37549ba5013dc
2019-12-10 10:38:10 +01:00

53 lines
1.4 KiB
Haskell
Executable file

#!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
module Main(main) where
import Reanimate
import Codec.Picture.Types
import Data.Text (Text)
bgColor :: PixelRGBA8
bgColor = PixelRGBA8 252 252 252 0xFF
segmentDuration :: Double
segmentDuration = 3
transitionTime :: Double
transitionTime = 0.5
main :: IO ()
main = reanimate $ bg `parA`
transitions fadeInE fadeOutE transitionTime
[animateCircleR, animateCircleP, animateRectR, animateColor
,signalA (constantS 0) $ setDuration transitionTime animateCircleR]
where
bg = animate $ const $ mkBackgroundPixel bgColor
animateCircleR :: Animation
animateCircleR = mkSegment "radius" $ \t -> mkCircle (t*2)
animateCircleP :: Animation
animateCircleP = mkSegment "drawn" $ \t ->
withFillOpacity 0 $ partialSvg t (pathify $ mkCircle 2)
animateRectR :: Animation
animateRectR = mkSegment "rotation" $ \t -> rotate (t*360) $ mkRect 4 2
animateColor :: Animation
animateColor = mkSegment "color" $ \t ->
withFillColorPixel (promotePixel $ turbo t) $ mkRect 4 2
mkSegment :: Text -> (Time -> SVG) -> Animation
mkSegment label gen = mkAnimation segmentDuration $ \t -> env $
mkGroup
[ gen t
, withStrokeWidth 0 $ translate 0 3 $ scale 2 $
center $ latex label ]
env :: SVG -> SVG
env =
withStrokeColor "red" .
withFillColor "black" .
withStrokeWidth (defaultStrokeWidth*2)