hashirama/reanimate
Watch
1
0
Fork
You've already forked reanimate
 0
mirror of https://github.com/reanimate/reanimate.git synced 2026-09-14 09:32:22 +00:00
Code Issues Projects Releases Wiki Activity

Add valentine's day gif.

Browse source
This commit is contained in:
David 2019-02-14 20:07:45 +01:00
commit 82da43eec0
6 changed files with 188 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

4
README.md
View file

@ -153,3 +153,7 @@ scaling = adjustSpeed 2 $ syncAll
| animation <- [sinewave, morph_wave, highlight, progressMeters]]
```
![Scaling](gifs/scaling.gif)
## Valentine's Day
![Valentine's Day](gifs/valentine.webm)

BIN
gifs/valentine.webm Normal file
View file

Binary file not shown.

1
src/Reanimate/Arrow.hs
View file

@ -46,6 +46,7 @@ frameAt n (Animation d fn) = svg $ fn d (n `mod'` d) ()
svg content = do
doctype_
with (svg11_ content) [width_ "320" , height_ "180", viewBox_ "0 0 320 180"]
-- with (svg11_ content) [width_ "1280" , height_ "720", viewBox_ "0 0 320 180"]
emit :: Animation (Svg ()) ()
emit = Animation 0 (\d t svg -> svg)

35
src/Reanimate/Combinators.hs
View file

@ -52,17 +52,9 @@ before :: Ani () -> Ani () -> Ani ()
before (Animation d1 fn1) (Animation d2 fn2) =
Animation (d1+d2) (\d t -> if t < d1 then fn1 d t else fn2 d (t-d1))
andThen :: Ani () -> Ani () -> Ani ()
andThen (Animation d1 fn1) (Animation d2 fn2) =
Animation (d1+d2) $ \d t -> if t < d1 then fn1 d t else do
fn1 d1 (d1-0.2)
fn2 d2 (t-d1)
follow :: [Ani ()] -> Ani ()
follow lst = foldr before (arr $ pure ()) lst
followFreeze :: [Ani ()] -> Ani ()
followFreeze = foldl andThen (arr $ pure ())
follow [] = arr $ pure ()
follow (x:xs) = foldl before x xs
sim :: [Ani ()] -> Ani ()
sim = foldr par (arr $ pure ())
@ -71,7 +63,6 @@ par :: Ani () -> Ani () -> Ani ()
par a b = proc t -> do
a -< t
b -< t
returnA -< ()
type Path = [(Double, Double)]
@ -119,9 +110,10 @@ signalSigmoid steepness from to = proc () -> do
signalSCurve :: Double -> Double -> Double -> Ani Double
signalSCurve steepness from to = proc () -> do
s <- signal 0 1 -< ()
returnA -< if s < 0.5
let s' = if s < 0.5
then 0.5 * (2*s)**steepness
else 1-0.5 * (2 - 2*s)**steepness
returnA -< from + (to-from)*s'
signalOscillate :: Double -> Double -> Ani Double
signalOscillate from to = proc () -> do
@ -131,6 +123,14 @@ signalOscillate from to = proc () -> do
where
diff = abs (to-from)
signalOscillateSCurve :: Double -> Double -> Double -> Ani Double
signalOscillateSCurve steepness from to = proc () -> do
s <- signalSCurve steepness 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))
@ -143,6 +143,10 @@ loop :: Ani a -> Ani a
loop (Animation d fn) =
Animation d (\dur t -> fn dur (mod' t d))
repeatAni :: Double -> Ani a -> Ani a
repeatAni times (Animation d fn) =
Animation (d*times) $ \dur t -> fn dur (mod' t d)
sync :: Ani () -> Ani () -> Ani ()
sync (Animation d1 fn1) (Animation d2 fn2) =
Animation (max d1 d2) $ \dur t () -> do
@ -154,5 +158,12 @@ sync (Animation d1 fn1) (Animation d2 fn2) =
syncAll :: [Ani ()] -> Ani ()
syncAll = foldl sync (arr (pure ()))
delay :: Double -> Ani () -> Ani ()
delay pause (Animation d fn) =
Animation (d+pause) $ \dur t a ->
if t < pause
then return ()
else fn dur (t-pause) a
num_ :: (Show a, Num a) => (Text -> Attribute) -> (a -> Attribute)
num_ attr n = attr (pack (show n))

137
src/Reanimate/Examples.hs
View file

@ -4,7 +4,9 @@ module Reanimate.Examples where
import Lucid.Svg
import Data.Text (Text, pack)
import Data.Monoid ((<>))
import Control.Arrow (returnA)
import Control.Arrow (returnA, (>>>))
import Text.Printf
import Numeric
import Reanimate.Arrow
import Reanimate.Combinators
@ -191,3 +193,136 @@ scaling = adjustSpeed 2 $ syncAll
| x <- [0,160]
, y <- [0,90]
| animation <- [sinewave, morph_wave, highlight, progressMeters]]
label :: String -> Ani ()
label str = proc () -> do
emit -< text_ [x_ "0", y_ "16", font_size_ "16"
, fill_ "white"] (toHtml str)
heart :: Ani ()
heart = proc () -> do
emit -< rect_ [width_ "100%", height_ "100%", fill_ "#FFFFFF"]
-- duration 1 -< ()
-- annotate' drawHeart -< g_ [transform_ $ scale 0.5 0.5 <> " " <> translate 200 200]
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
follow
[ all_read
, sim [ follow [background]
, follow [backgroundDelay, sim [delay 6.4 (fallingLove 0.09)
,delay 4.9 (fallingLove 0.12)
,delay 4.5 (fallingLove 0.88)
,delay 0.3 (fallingLove 0.43)
,delay 5.3 (fallingLove 0.93)
,delay 0.1 (fallingLove 0.80)
,delay 1.1 (fallingLove 0.39)
,delay 2.3 (fallingLove 0.21)
,delay 2.9 (fallingLove 0.77)
,delay 3.4 (fallingLove 0.46)
,delay 6.2 (fallingLove 0.19)
,delay 5.9 (fallingLove 0.53)
,delay 3.2 (fallingLove 0.14)
,delay 7.7 (fallingLove 0.99) ]]
, follow [heart_ani, sim [heart_disappear]]
, follow [backgroundDelay, message "Happy", message "Valentine's"
, message "Day!", message "", message "See"
, message "you", message "soon!"]]
] -<()
where
all_read = defineAnimation $ proc () -> do
duration 1 -< ()
emit -< rect_ [width_ "100%", height_ "100%", fill_ "red"]
background = defineAnimation $ proc () -> do
duration 2 -< ()
n <- signal 0 0xFF -< ()
let color = "#FF" ++ hex n ++ hex n
emit -< rect_ [width_ "100%", height_ "100%", fill_ $ pack color]
rev_background = defineAnimation $ proc () -> do
duration 2 -< ()
n <- signal 0xFF 0 -< ()
let color = "#FF" ++ hex n ++ hex n
emit -< rect_ [width_ "100%", height_ "100%", fill_ $ pack color]
backgroundDelay = defineAnimation $ proc () -> do
duration (animationDuration background-1) -< ()
returnA -< ()
heart_ani = repeatAni 10 $ defineAnimation $ proc () -> do
duration 1 -< ()
n <- signalOscillateSCurve 2 0.9 1.1 -< ()
annotate' drawHeart -< g_ [transform_ $ translate 160 110] . g_ [transform_ $ scale n n <> " "]
heart_disappear = defineAnimation $ proc () -> do
duration 3 -< ()
n <- signal 0.9 10 -< ()
annotate' drawHeart -< g_ [transform_ $ translate 160 110] . g_ [transform_ $ scale n n <> " "]
white = loop $ defineAnimation $ proc () -> do
duration 1 -< ()
emit -< rect_ [width_ "100%", height_ "100%", fill_ "#FFFFFF"]
fallingLove xPos = defineAnimation $ proc () -> do
duration 2 -< ()
n <- signal 0 1 -< ()
o <- signalOscillate (-1) 1 -< ()
emit -<
g_ [transform_ $ translate (xPos*360) (210*n)] $
g_ [transform_ $ rotate (45*o)] $
text_ [font_size_ "18"
,text_anchor_ "middle"
,fill_ "red"] "爱"
message txt = defineAnimation $ proc () -> do
duration 1 -< ()
o <- signalOscillate 0 1 -< ()
n <- signalOscillateSCurve 2 0.9 1.1 -< ()
emit -<
g_ [transform_ $ translate 160 110, num_ opacity_ o] $
g_ [transform_ $ scale n n ] $
text_ [x_ "0", y_ "-12", font_size_ "24"
, text_anchor_ "middle"
, fill_ "white"] txt
drawHeart = proc () -> do
emit -<
g_ [transform_ $ translate (-170) (-260)] $
g_ [transform_ $ rotateAround 225 150 121 <> " " <> scale 0.4 0.4] $
path_ ([stroke_ "red", fill_"red", d_ dat])
dat = "M0 200 v-200 h200 a100,100 90 0,1 0,200 a100,100 90 0,1 -200,0 z"
hex n = if n < 0x10 then "0" ++ showHex (round n) ""
else showHex (round n) ""
frequencies :: Ani ()
frequencies = proc () -> do
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
follow
[ drawLine
, drawFirstWave
, drawSecondWave
] -< ()
where
freqs = [3, 5, 11, 2]; margin = 30; width = 260; height = 90
drawLine = defineAnimation $ proc () -> do
label "drawLine" -< ()
duration 1 -< ()
n <- signal margin (width+margin) -< ()
emit -< do
line_ [ num_ x1_ margin, num_ y1_ height
, num_ x2_ n, num_ y2_ height
, stroke_ "white"]
circle_ [num_ cx_ n, num_ cy_ height, r_ "3", fill_ "red"]
drawFirstWave = defineAnimation $ proc () -> do
label "drawFirstWave" -< ()
duration 3 -< ()
n <- signal 0 1 -< ()
move <- signal 0 1 -< ()
emit -< do
g_ [transform_ $ translate margin height] $ renderPath $ morphPath line1 (wave1 move) n
let circleY = sum [ sin ((1+n)*pi*2*freq) * 20 | freq <- freqs ]
circle_ [num_ cx_ (width+margin), num_ cy_ (height+circleY*n), num_ r_ 3, fill_ "red"]
drawSecondWave = defineAnimation $ proc () -> do
label "drawSecondWave" -< ()
duration 3 -< ()
move <- signal 0 1 -< ()
emit -< do
g_ [transform_ $ translate margin height] $ renderPath $ wave1 move
let circleY = sum [ sin ((1+move)*pi*2*freq) * 20 | freq <- freqs ]
circle_ [num_ cx_ (width+margin), num_ cy_ (height+circleY), num_ r_ 3, fill_ "red"]
line1 = approxFnData 1000 $ \idx ->
(idx*width, 0)
wave1 n = approxFnData 1000 $ \idx ->
(idx*width, sum [ sin ((idx+n)*pi*2*freq) * 20 | freq <- freqs ])

24
src/Reanimate/Render.hs
View file

@ -13,6 +13,9 @@ import Reanimate.Examples
fps :: Int
fps = 60
fps_webm :: Int
fps_webm = 30
fps_gif :: Int
fps_gif = 25
@ -60,6 +63,27 @@ renderGif ani target = do
removeFile (tmp </> fileName))
return ()
renderWebm :: Ani () -> FilePath -> IO ()
renderWebm ani target = do
putStrLn $ "Starting render of animation: " ++ show (round (animationDuration ani)) ++ "s"
let frames :: Int
frames = round (animationDuration ani * fromIntegral fps_webm)
ffmpeg <- requireExecutable "ffmpeg"
tmp <- getTemporaryDirectory
forM_ [0..frames] $ \frame -> do
let s = fromIntegral frame / fromIntegral fps_webm
let fileName = printf nameTemplate frame
renderToFile (tmp </> fileName) (frameAt s ani)
rawSystem ffmpeg ["-r", show fps_webm, "-i", tmp </> "render-%05d.svg"
, "-c:v", "libvpx-vp9", "-vf", "fps="++show fps_webm
, target]
`finally`
forM_ [0..frames] (\frame -> do
let fileName = printf nameTemplate frame
removeFile (tmp </> fileName))
return ()
requireExecutable :: String -> IO FilePath
requireExecutable exec = do
mbPath <- findExecutable exec