showcase wibbles.

Former-commit-id: 80486e36ad3098387737d798ab020953f1efb28a

src/Reanimate/Effect.hs

@@ -57,3 +57,6 @@ fillInE d t = withFillOpacity f
 
 scaleE :: Double -> Effect
 scaleE target d t = scale (1 + (target-1) * t/d)
+
+translateE :: Double -> Double -> Effect
+translateE x y d t = translate (x * t/d) (y * t/d)

src/Reanimate/Scene.hs

@@ -259,21 +259,44 @@ findVar cond (v:vs) = do
   val <- readVar v
   if cond val then return v else findVar cond vs
 
-data Sprite s = Sprite Time (STRef s (Duration, Duration -> Time -> SVG -> (SVG, ZIndex)))
+applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
+applyVar var sprite fn = do
+  spriteModify sprite $ do
+    varFn <- freezeVar var
+    return $ \absT _relD _relT (svg, zindex) ->
+      (fn (varFn absT) svg, zindex)
+
+data Sprite s = Sprite Time (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex))))
 
 newSprite :: ST s (Time -> Duration -> Time -> SVG) -> Scene s (Sprite s)
 newSprite render = do
   now <- queryNow
-  ref <- liftST $ newSTRef (-1, \_d _t svg -> (svg, 0))
+  ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0))
   fromParams $ do
     fn <- render
-    (spriteDuration, spriteEffect) <- readSTRef ref
+    (spriteDuration, spriteEffectGen) <- readSTRef ref
-    return $ \d t ->
+    spriteEffect <- spriteEffectGen
-      let realD = (if spriteDuration < 0 then d else spriteDuration)-now
+    return $ \d absT ->
-          realT = t-now in
+      let relD = (if spriteDuration < 0 then d else spriteDuration)-now
-      if realT < 0 || realD < realT
+          relT = absT-now in
+      if relT < 0 || relD < relT
         then (None, 0)
-        else spriteEffect realD realT (fn t realD realT)
+        else spriteEffect relD relT (fn absT relD relT)
+  return $ Sprite now ref
+
+newSpriteA :: Animation -> Scene s (Sprite s)
+newSpriteA (Animation _ gen) = do
+  now <- queryNow
+  ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0))
+  fromParams $ do
+    (spriteDuration, spriteEffectGen) <- readSTRef ref
+    spriteEffect <- spriteEffectGen
+    return $ \d absT ->
+      let relD = (if spriteDuration < 0 then d else spriteDuration)-now
+          relT = absT-now in
+      if relT < 0 || relT > relD
+        then (None, 0)
+        else spriteEffect relD relT (gen (relT/relD))
   return $ Sprite now ref
 
 destroySprite :: Sprite s -> Scene s ()
@@ -282,21 +305,35 @@ destroySprite (Sprite _ ref) = do
   liftST $ modifySTRef ref $ \(ttl, render) ->
     (if ttl < 0 then now else min ttl now, render)
 
+spriteModify :: Sprite s -> ST s (Time -> Duration -> Time -> (SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
+spriteModify (Sprite born ref) modFn =
+  liftST $ modifySTRef ref $ \(ttl, renderGen) ->
+    (ttl, do
+      render <- renderGen
+      modRender <- modFn
+      return $ \relD relT ->
+        let absT = relT + born
+        in modRender absT relD relT . render relD relT)
+
 spriteE :: Sprite s -> Effect -> Scene s ()
 spriteE (Sprite born ref) effect = do
   now <- queryNow
-  liftST $ modifySTRef ref $ \(ttl, render) ->
+  liftST $ modifySTRef ref $ \(ttl, renderGen) ->
-    (ttl, \d t svg ->
+    (ttl, do
-      let (svg', z) = render d t svg
+      render <- renderGen
-      in (delayE (now-born) effect d t svg', z))
+      return $ \d t svg ->
+        let (svg', z) = render d t svg
+        in (delayE (now-born) effect d t svg', z))
 
 spriteZ :: Sprite s -> ZIndex -> Scene s ()
 spriteZ (Sprite born ref) zindex = do
   now <- queryNow
-  liftST $ modifySTRef ref $ \(ttl, render) ->
+  liftST $ modifySTRef ref $ \(ttl, renderGen) ->
-    (ttl, \d t svg ->
+    (ttl, do
-      let (svg', z) = render d t svg
+      render <- renderGen
-      in (svg', if t < now-born then z else zindex))
+      return $ \d t svg ->
+        let (svg', z) = render d t svg
+        in (svg', if t < now-born then z else zindex))
 
 {-
 data Var s a = Var (STRef s (Time -> a))

videos/showcase/showcase.hs

@@ -83,12 +83,26 @@ sphereIntro = sceneAnimation $ do
     # repeatA 10
     # takeA (2+5)
     # applyE (delayE 2 fadeOutE)
-  fork $ play $ rotateSphere
+  sphereX <- newVar 0
-    # setDuration 1
+  sphereS <- newSpriteA $
-    # repeatA 15
+    rotateSphere # repeatA (5+3+1+2)
-    # applyE (overBeginning 2 $ constE $ withGroupOpacity 0)
+  -- sphereS <- newSprite $ do
-    # applyE (delayE 2 $ overBeginning 5 fadeInE)
+  --   -- xValue <- freezeVar sphereX
-  wait 7
+  --   let a = rotateSphere # setDuration 1 # repeatA (5+3+1+2)
+  --   return $ \real_t d t ->
+  --     -- translate (xValue real_t) 0 $
+  --     frameAt t a
+  applyVar sphereX sphereS (\xValue -> translate xValue 0)
+
+  spriteE sphereS (overBeginning 1 $ constE $ withGroupOpacity 0)
+  spriteE sphereS (delayE 1 $ overBeginning 2 fadeInE)
+  -- fork $ play $ rotateSphere
+  --   # setDuration 1
+  --   # repeatA (5+3+1+2)
+  --   # applyE (overBeginning 1 $ constE $ withGroupOpacity 0)
+  --   # applyE (delayE 1 $ overBeginning 2 fadeInE)
+  --   # applyE (delayE 8 $ translateE (-3) 0)
+  wait 5
   playZ 1 $ setDuration 3 $ animate $ \t ->
     partialSvg t $
     withFillOpacity 0 $
@@ -99,6 +113,7 @@ sphereIntro = sceneAnimation $ do
   --   withFillOpacity t $
   --   circ
   let scaleFactor = 0.05
+  tweenVar sphereX 1 $ \t x -> fromToS x (-3) (curveS 3 t)
   fork $ playZ 1 $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
     let p = curveS 3 t in
     withFillOpacity p $