diff --git a/src/Reanimate/Effect.hs b/src/Reanimate/Effect.hs index 3e2c64c..f959feb 100644 --- a/src/Reanimate/Effect.hs +++ b/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) diff --git a/src/Reanimate/Scene.hs b/src/Reanimate/Scene.hs index eb01fbf..001a0a7 100644 --- a/src/Reanimate/Scene.hs +++ b/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 - return $ \d t -> - let realD = (if spriteDuration < 0 then d else spriteDuration)-now - realT = t-now in - if realT < 0 || realD < realT + (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 || 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) -> - (ttl, \d t svg -> - let (svg', z) = render d t svg - in (delayE (now-born) effect d t svg', z)) + liftST $ modifySTRef ref $ \(ttl, renderGen) -> + (ttl, do + render <- renderGen + 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) -> - (ttl, \d t svg -> - let (svg', z) = render d t svg - in (svg', if t < now-born then z else zindex)) + liftST $ modifySTRef ref $ \(ttl, renderGen) -> + (ttl, do + render <- renderGen + 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)) diff --git a/videos/showcase/showcase.hs b/videos/showcase/showcase.hs index 08c61a1..9a43ad0 100644 --- a/videos/showcase/showcase.hs +++ b/videos/showcase/showcase.hs @@ -83,12 +83,26 @@ sphereIntro = sceneAnimation $ do # repeatA 10 # takeA (2+5) # applyE (delayE 2 fadeOutE) - fork $ play $ rotateSphere - # setDuration 1 - # repeatA 15 - # applyE (overBeginning 2 $ constE $ withGroupOpacity 0) - # applyE (delayE 2 $ overBeginning 5 fadeInE) - wait 7 + sphereX <- newVar 0 + sphereS <- newSpriteA $ + rotateSphere # repeatA (5+3+1+2) + -- sphereS <- newSprite $ do + -- -- xValue <- freezeVar sphereX + -- 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 $