Another another example.

README.md

@@ -11,3 +11,5 @@
 ![Speed modification](gifs/progress.gif)
 
 ![Highlight](gifs/highlight.gif)
+
+![Clipping](gifs/clip_rect.gif)

src/Reanimate/Arrow.hs

@@ -14,6 +14,9 @@ type Time = Double
 
 data Animation a b = Animation Duration (Duration -> Time -> a -> Svg b)
 
+instance Functor (Animation a) where
+  fmap f (Animation d g) = Animation d (\dur t a -> fmap f (g dur t a))
+
 instance C.Category Animation where
   id = Animation 0 (\_ _ -> pure)
   Animation a fn1 . Animation b fn2 = Animation (max a b) (\d t a -> fn2 d t a >>= fn1 d t)

src/Reanimate/Combinators.hs

@@ -52,9 +52,18 @@ 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 ())
+
 sim :: [Ani ()] -> Ani ()
 sim = foldr par (arr $ pure ())
 
@@ -128,7 +137,7 @@ adjustSpeed factor (Animation d fn) =
 
 freeze :: Double -> Ani a -> Ani a
 freeze d (Animation d' fn) =
-  Animation (d+d') (\dur t -> if t > d' then fn dur d' else fn dur t)
+  Animation (d+d') (\dur t -> if t > d' then fn d' d' else fn d' t)
 
 loop :: Ani a -> Ani a
 loop (Animation d fn) =

src/Reanimate/Examples.hs

@@ -180,3 +180,43 @@ highlight = proc () -> do
     h = 30
     commonAttrs c = [stroke_width_ "2", stroke_ c, fill_ c]
     highlightAttrs c = [stroke_width_ "2", stroke_ c, fill_opacity_ "0"]
+
+clip_rect :: Ani ()
+clip_rect = proc () -> do
+  emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
+  follow
+    [ proc () -> do
+      sim [ paintStatic prev | prev <- [max 0 (n-4) .. n-1] ] -< ()
+      sim [ runAni "black" i | i <- [n-4], i>=0 ] -< ()
+      runAni "white" n -< ()
+    | n <- [0..15]
+    ] -< ()
+  where
+    paintStatic nth = proc () ->
+      annotate' (obj "white" (20+nth*10) (20+nth*10))
+        -< g_ [transform_ $ translate 160 90]
+    runAni color nth = proc () ->
+      annotate' (defineAnimation $ circle_clip (obj color (20+nth*10) (20+nth*10)))
+        -< g_ [transform_ $ translate 160 90]
+    obj c width height = proc () -> do
+      duration 1 -< ()
+      emit -< rect_ [ width_ $ pack $ show width, height_ $ pack $ show height
+            , x_ $ pack $ show (-width/2), y_ $ pack $ show (-height/2)
+            , stroke_ c, fill_opacity_ "0", stroke_width_ "2" ]
+
+circle_clip :: Ani () -> Ani ()
+circle_clip sub = proc () -> do
+    arc <- signal (pi*2) 0 -< ()
+    let startX = pack$show$sin 0 * 1000
+        startY = pack$show$cos 0 * 1000
+        xPos = pack$show$sin arc * 1000
+        yPos = pack$show$cos arc * 1000
+        long = if arc < pi then "1" else "0"
+    emit -< defs_ $ clipPath_ [id_ $ uniqName] $
+      path_ [ stroke_ "white", fill_ "white"
+            , d_ $ "M "<>startX<>" "<>startY<>" A 1000 1000 0 "<>long<>" 1 "
+                  <>xPos<> " "<>yPos<>" L 0 0 Z"]
+    annotate' sub -<
+      g_ [clip_path_ $ "url(#"<>uniqName<>")"]
+  where
+    uniqName = "clip" -- XXX: Not very unique?

src/SvgViewer.hs

@@ -15,7 +15,7 @@ import Data.Time
 import Reanimate.Arrow
 import Reanimate.Examples
 
-animation = highlight
+animation = clip_rect
 
 main :: IO ()
 main = do