mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-11 16:12:20 +00:00
Refactor arrow API.
This commit is contained in:
David
parent
cf86585e8a
commit
4ccb3a70ea
4 changed files with 156 additions and 58 deletions
|
|
@ -9,29 +9,35 @@ import Data.Fixed
|
|||
import Lucid.Svg
|
||||
import Lucid ()
|
||||
|
||||
data Animation a b = Animation Double (a -> Svg b)
|
||||
type Duration = Double
|
||||
type Time = Double
|
||||
|
||||
data Animation a b = Animation Duration (Duration -> Time -> a -> Svg b)
|
||||
|
||||
instance C.Category Animation where
|
||||
id = Animation 0 pure
|
||||
Animation a fn1 . Animation b fn2 = Animation (max a b) (\a -> fn2 a >>= fn1)
|
||||
id = Animation 0 (\_ _ -> pure)
|
||||
Animation a fn1 . Animation b fn2 = Animation (max a b) (\d t a -> fn2 d t a >>= fn1 d t)
|
||||
|
||||
instance Arrow Animation where
|
||||
-- arr :: (b -> c) -> Animation b c
|
||||
arr fn = Animation 0 (pure . fn)
|
||||
arr fn = Animation 0 (\d t -> pure . fn)
|
||||
-- first :: Animation b c -> Animation (b, d) (c, d)
|
||||
first (Animation duration fn) =
|
||||
Animation duration (\(b,d) -> do c <- fn b; pure (c, d))
|
||||
Animation duration (\t dur (b,d) -> do c <- fn t dur b; pure (c, d))
|
||||
|
||||
type Ani a = Animation Double a
|
||||
type Ani a = Animation () a
|
||||
|
||||
duration :: Double -> Animation a ()
|
||||
duration duration = Animation duration (\_ -> pure ())
|
||||
duration duration = Animation duration (\_ _ _ -> pure ())
|
||||
|
||||
getDuration :: Animation a b -> Double
|
||||
getDuration (Animation d _) = d
|
||||
defineAnimation :: Animation a b -> Animation a b
|
||||
defineAnimation (Animation d fn) = Animation d (\_ t -> fn d (t `mod'` d))
|
||||
|
||||
animationDuration :: Animation a b -> Double
|
||||
animationDuration (Animation d _) = d
|
||||
|
||||
frameAt :: Double -> Ani () -> Svg ()
|
||||
frameAt n (Animation d fn) = svg $ fn (n `mod'` d)
|
||||
frameAt n (Animation d fn) = svg $ fn d (n `mod'` d) ()
|
||||
where
|
||||
svg :: Svg () -> Svg ()
|
||||
svg content = do
|
||||
|
|
@ -39,4 +45,10 @@ frameAt n (Animation d fn) = svg $ fn (n `mod'` d)
|
|||
with (svg11_ content) [width_ "320" , height_ "180", viewBox_ "0 0 320 180"]
|
||||
|
||||
emit :: Animation (Svg ()) ()
|
||||
emit = Animation 0 id
|
||||
emit = Animation 0 (\d t svg -> svg)
|
||||
|
||||
getTime :: Ani Double
|
||||
getTime = Animation 0 (\d t () -> pure t)
|
||||
|
||||
getDuration :: Ani Duration
|
||||
getDuration = Animation 0 (\d t () -> pure d)
|
||||
|
|
|
|||
|
|
@ -12,31 +12,37 @@ import Reanimate.Arrow
|
|||
|
||||
fadeIn :: Double -> Ani a -> Ani a
|
||||
fadeIn window (Animation d fn) =
|
||||
Animation d $ \t ->
|
||||
Animation d $ \dur t () ->
|
||||
let s = (t/window) in
|
||||
if s < 1
|
||||
then g_ [opacity_ (pack $ show s)] (fn t)
|
||||
else fn t
|
||||
then g_ [opacity_ (pack $ show s)] (fn dur t ())
|
||||
else fn dur t ()
|
||||
|
||||
fadeOut :: Double -> Ani a -> Ani a
|
||||
fadeOut window (Animation d fn) =
|
||||
Animation d $ \t ->
|
||||
Animation d $ \dur t () ->
|
||||
let s = (d-t)/window in
|
||||
if s < 1
|
||||
then g_ [opacity_ (pack $ show s)] (fn t)
|
||||
else fn t
|
||||
then g_ [opacity_ (pack $ show s)] (fn dur t ())
|
||||
else fn dur t ()
|
||||
|
||||
fade :: Double -> Ani a -> Ani a
|
||||
fade window = fadeIn window . fadeOut window
|
||||
|
||||
annotate :: (Svg a -> Svg a) -> Ani a -> Ani a
|
||||
annotate fn1 (Animation d fn2) =
|
||||
Animation d (fn1 . fn2)
|
||||
Animation d (\dur t -> fn1 . fn2 dur t)
|
||||
|
||||
-- data Animation a b = Animation Double (Double -> a -> Svg b)
|
||||
annotate' :: Ani a -> Animation (Svg a -> Svg a) a
|
||||
annotate' (Animation d f) =
|
||||
Animation d (\dur t g -> g (f dur t ()))
|
||||
|
||||
progress :: Ani () -> Ani ()
|
||||
progress ani = proc t -> do
|
||||
ani -< t
|
||||
let txt = show (round ((t / getDuration ani) * 100)) ++ "%"
|
||||
progress ani = proc () -> do
|
||||
ani -< ()
|
||||
t <- getTime -< ()
|
||||
let txt = show (round ((t / animationDuration ani) * 100)) ++ "%"
|
||||
emit -< text_ [x_ "10", y_ "20", font_size_ "20"
|
||||
, text_anchor_ "bottom"
|
||||
, fill_ "white"] (toHtml txt)
|
||||
|
|
@ -82,3 +88,22 @@ morphPath src dst idx = zipWith worker src dst
|
|||
approxFn :: Int -> (Double -> (Double, Double)) -> Ani ()
|
||||
approxFn steps fn = proc t -> do
|
||||
emit -< renderPath $ approxFnData steps fn
|
||||
|
||||
constantSvg :: Svg a -> Ani a
|
||||
constantSvg svg = Animation 0 (\dur t () -> svg)
|
||||
|
||||
signal :: Double -> Double -> Ani Double
|
||||
signal from to =
|
||||
Animation 0 (\dur t () -> pure (from + (to-from)*(t/dur)))
|
||||
|
||||
signalOscillate :: Double -> Double -> Ani Double
|
||||
signalOscillate from to = proc () -> do
|
||||
s <- signal from (to+diff) -< ()
|
||||
returnA -< if s < to then s
|
||||
else (to*2 - s)
|
||||
where
|
||||
diff = abs (to-from)
|
||||
|
||||
adjustSpeed :: Double -> Ani a -> Ani a
|
||||
adjustSpeed factor (Animation d fn) =
|
||||
Animation (d/factor) (\dur t -> fn dur ((t*factor) `mod'` dur))
|
||||
|
|
|
|||
|
|
@ -24,49 +24,54 @@ test2 = proc t -> do
|
|||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "red", r_ (pack $ show t)]
|
||||
|
||||
sinewave :: Ani ()
|
||||
sinewave = proc t -> do
|
||||
duration 5 -< ()
|
||||
sinewave = proc () -> do
|
||||
duration 10 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
let clipWidth = pack $ show $ t/getDuration sinewave * 260
|
||||
t <- getTime -< ()
|
||||
|
||||
idx <- signalOscillate 0 1 -< ()
|
||||
let clipWidth = pack $ show $ idx * 260
|
||||
emit -< defs_ $ clipPath_ [id_ "clip"] $ rect_ [x_ "0", y_ "-90", width_ clipWidth, height_ "100%"]
|
||||
annotate (g_ [transform_ $ translate 30 90]) $
|
||||
annotate (g_ [clip_path_ "url(#clip)"]) $
|
||||
approxFn 1000 (\idx ->
|
||||
let xPos = idx*260
|
||||
xValue = idx*getDuration sinewave
|
||||
yValue = sin (xValue*pi*2*freq) * 50
|
||||
in (xPos, yValue)) -< t
|
||||
let xValue = idx*260
|
||||
yValue = sin (idx*pi*2*freq) * 50
|
||||
in (xValue, yValue)) -< ()
|
||||
emit -< line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"]
|
||||
emit -< line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"]
|
||||
|
||||
let circX = pack $ show $ 30 + t/getDuration sinewave * (290-30)
|
||||
circY = pack $ show $ 90 + sin (t*pi*2*freq) * 50
|
||||
circX <- signalOscillate 30 290 -< ()
|
||||
let circY = pack $ show $ 90 + sin (idx*pi*2*freq) * 50
|
||||
|
||||
emit -< circle_ [cx_ circX, cy_ circY, r_ "3", fill_ "red"]
|
||||
emit -< circle_ [cx_ (pack (show circX)), cy_ circY, r_ "3", fill_ "red"]
|
||||
returnA -< ()
|
||||
where
|
||||
freq = 1/2
|
||||
freq = 3
|
||||
|
||||
morph_wave :: Ani ()
|
||||
morph_wave = proc t -> do
|
||||
morph_wave = proc () -> do
|
||||
duration 5 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
|
||||
annotate (g_ [transform_ $ translate 30 50]) $
|
||||
(proc t -> emit -< renderPath wave1) -< t
|
||||
annotate (g_ [transform_ $ translate 30 130]) $
|
||||
(proc t -> emit -< renderPath wave2) -< t
|
||||
annotate (g_ [transform_ $ translate 30 90]) $
|
||||
(proc t -> do
|
||||
let idx = if t/myD*2 < 1 then t/myD*2
|
||||
else (2 - t/myD*2)
|
||||
emit -< renderPath $ morphPath wave1 wave2 idx) -< t
|
||||
emit -<
|
||||
g_ [transform_ $ translate 30 50] $
|
||||
renderPath wave1
|
||||
emit -<
|
||||
g_ [transform_ $ translate 30 130] $
|
||||
renderPath wave2
|
||||
|
||||
morph <- signalOscillate 0 1 -< ()
|
||||
emit -<
|
||||
g_ [transform_ $ translate 30 90] $
|
||||
renderPath $ morphPath wave1 wave2 morph
|
||||
|
||||
emit -< line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"]
|
||||
emit -< line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"]
|
||||
|
||||
returnA -< ()
|
||||
where
|
||||
myD = getDuration morph_wave
|
||||
myD = animationDuration morph_wave
|
||||
freq = 1/2
|
||||
wave1 = approxFnData 1000 (\idx ->
|
||||
let xPos = idx*260
|
||||
|
|
@ -84,22 +89,78 @@ morph_wave_circle = proc t -> do
|
|||
duration 5 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
|
||||
annotate (g_ [transform_ $ translate 30 90]) $
|
||||
(proc t -> do
|
||||
let idx = if t/myD*2 < 1 then t/myD*2
|
||||
else (2 - t/myD*2)
|
||||
emit -< renderPath $ morphPath wave1 circle idx) -< t
|
||||
idx <- signalOscillate 0 1 -< ()
|
||||
emit -<
|
||||
g_ [transform_ $ translate 30 90] $
|
||||
renderPath $ morphPath circle wave1 idx
|
||||
emit -< line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"]
|
||||
emit -< line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"]
|
||||
|
||||
returnA -< ()
|
||||
where
|
||||
myD = getDuration morph_wave
|
||||
freq = 1/2
|
||||
freq = 5
|
||||
wave1 = approxFnData 1000 (\idx ->
|
||||
let xPos = idx*260
|
||||
xValue = idx*myD
|
||||
yValue = sin (xValue*pi*2*freq) * 20
|
||||
in (xPos, yValue))
|
||||
let xValue = idx*260
|
||||
yValue = sin (idx*pi*2*freq) * 20
|
||||
in (xValue, yValue))
|
||||
circle = approxFnData 1000 $ \idx ->
|
||||
(cos (idx*pi*2+pi/2)*50 + 130, sin (idx*pi*2+pi/2)*50)
|
||||
|
||||
progressMeters :: Ani ()
|
||||
progressMeters = proc () -> do
|
||||
annotate' progressMeter -< g_ [transform_ $ translate 40 20]
|
||||
annotate' (adjustSpeed 2 progressMeter) -< g_ [transform_ $ translate 140 20]
|
||||
annotate' (adjustSpeed 0.5 progressMeter) -< g_ [transform_ $ translate 240 20]
|
||||
|
||||
emit -< do
|
||||
text_ [x_ "55", y_ "150", font_size_ "20"
|
||||
, text_anchor_ "middle"
|
||||
, fill_ "black"] "1x"
|
||||
text_ [x_ "155", y_ "150", font_size_ "20"
|
||||
, text_anchor_ "middle"
|
||||
, fill_ "black"] "2x"
|
||||
text_ [x_ "255", y_ "150", font_size_ "20"
|
||||
, text_anchor_ "middle"
|
||||
, fill_ "black"] "0.5x"
|
||||
|
||||
progressMeter :: Ani ()
|
||||
progressMeter = defineAnimation $ proc () -> do
|
||||
duration 5 -< ()
|
||||
h <- signal 0 100 -< ()
|
||||
emit -< rect_ [ width_ "30", height_ "100", stroke_ "black", fill_opacity_ "0" ]
|
||||
emit -< rect_ [ width_ "30", height_ (pack $ show h), stroke_ "black", fill_ "grey" ]
|
||||
returnA -< ()
|
||||
|
||||
highlight :: Ani ()
|
||||
highlight = proc () -> do
|
||||
duration 10 -< ()
|
||||
annotate (g_ [transform_ $ scale 2 2 <> " " <> translate 25 0]) (proc t -> do
|
||||
emit -<
|
||||
g_ [transform_ $ translate 20 20] $
|
||||
g_ [transform_ $ rotateAround 45 10 10] $
|
||||
block "white"
|
||||
emit -<
|
||||
g_ [transform_ $ translate 60 20] $
|
||||
g_ [transform_ $ rotateAround 0 10 10] $
|
||||
block "white"
|
||||
emit -<
|
||||
g_ [transform_ $ translate 20 60] $
|
||||
g_ [transform_ $ rotateAround 0 10 10] $
|
||||
block "white"
|
||||
emit -<
|
||||
g_ [transform_ $ translate 20 60] $
|
||||
g_ [transform_ $ rotateAround 45 10 10] $
|
||||
block "white"
|
||||
emit -<
|
||||
g_ [transform_ $ translate 60 60] $
|
||||
g_ [transform_ $ rotateAround 45 10 10] $
|
||||
block "blue"
|
||||
t <- getTime -< ()
|
||||
emit -<
|
||||
g_ [transform_ $ translate (15 + (55-15)*(t/10)) 15] $
|
||||
rect_ [width_ "30", height_ "30", stroke_ "black", fill_opacity_ "0" ]
|
||||
) -< ()
|
||||
returnA -< ()
|
||||
where
|
||||
block c =
|
||||
rect_ [width_ "20", height_ "20", stroke_ "black", fill_ c ]
|
||||
|
|
|
|||
|
|
@ -21,9 +21,9 @@ nameTemplate = "render-%05d.svg"
|
|||
|
||||
render :: Ani () -> FilePath -> IO ()
|
||||
render ani target = do
|
||||
putStrLn $ "Starting render of animation: " ++ show (round (getDuration ani)) ++ "s"
|
||||
putStrLn $ "Starting render of animation: " ++ show (round (animationDuration ani)) ++ "s"
|
||||
let frames :: Int
|
||||
frames = round (getDuration ani * fromIntegral fps)
|
||||
frames = round (animationDuration ani * fromIntegral fps)
|
||||
ffmpeg <- requireExecutable "ffmpeg"
|
||||
tmp <- getTemporaryDirectory
|
||||
forM_ [0..frames] $ \frame -> do
|
||||
|
|
@ -42,9 +42,9 @@ render ani target = do
|
|||
|
||||
renderGif :: Ani () -> FilePath -> IO ()
|
||||
renderGif ani target = do
|
||||
putStrLn $ "Starting render of animation: " ++ show (round (getDuration ani)) ++ "s"
|
||||
putStrLn $ "Starting render of animation: " ++ show (round (animationDuration ani)) ++ "s"
|
||||
let frames :: Int
|
||||
frames = round (getDuration ani * fromIntegral fps_gif)
|
||||
frames = round (animationDuration ani * fromIntegral fps_gif)
|
||||
ffmpeg <- requireExecutable "ffmpeg"
|
||||
tmp <- getTemporaryDirectory
|
||||
forM_ [0..frames] $ \frame -> do
|
||||
|
|
|
|||
Loading…
Reference in a new issue