Add 'signalS' and signalO for applying easing functions to sprites/objects. (#260)

.azure/azure-osx-template.yml

@@ -11,12 +11,12 @@ jobs:
         BUILD: stack
         STACK_YAML: stack.yaml
         ARGS: --pedantic
-      stack-lts-15:
+      #stack-lts-16:
+      #  BUILD: stack
+      #  STACK_YAML: stack-lts-16.yaml
+      stack-lts-17:
         BUILD: stack
-        STACK_YAML: stack-lts-14.yaml
-      stack-lts-14:
-        BUILD: stack
-        STACK_YAML: stack-lts-14.yaml
+        STACK_YAML: stack-lts-17.yaml
     maxParallel: 6
   steps:
   - task: Cache@2

.github/workflows/playground.yml

@@ -30,6 +30,7 @@ jobs:
 
     - name: Install dependencies
       run: |
+        sudo apt-get update
         sudo apt-get -y install texlive texlive-latex-base texlive-latex-extra
         stack build --only-dependencies
         (cd playground && stack build --only-dependencies)

azure-pipelines.yml

@@ -21,11 +21,11 @@ jobs:
     vmImage: ubuntu-latest
     os: linux
 
-- template: ./.azure/azure-osx-template.yml
-  parameters:
-    name: macOS
-    vmImage: macOS-10.14
-    os: osx
+#- template: ./.azure/azure-osx-template.yml
+#  parameters:
+#    name: macOS
+#    vmImage: macOS-11
+#    os: osx
 
 - template: ./.azure/azure-windows-template.yml
   parameters:

examples/doc_signalO.hs

@@ -0,0 +1,27 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+module Main(main) where
+
+import Reanimate
+import Reanimate.Scene
+import Reanimate.Builtin.Documentation
+import Control.Lens
+import Control.Monad
+
+main :: IO ()
+main = reanimate $ docEnv $ scene $ do
+  objs <- waitOn $ replicateM 3 $ do
+    obj1 <- newObject $ mkCircle 1
+    oModifyS obj1 $ oEasing .= id
+    oModifyS obj1 $ oRightX .= screenRight
+    fork $ oShowWith obj1 oFadeIn
+    fork $ oTweenS obj1 2 $ \t ->
+      oLeftX %= \origin -> fromToS origin screenLeft t
+    wait 1
+    oHideWith obj1 oFadeOut
+    wait (-1.5)
+    return obj1
+  dur <- queryNow
+  wait (-dur)
+  forM_ objs $ \obj -> do
+    signalO obj dur $ curveS 2

examples/doc_signalS.hs

@@ -0,0 +1,13 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+module Main(main) where
+
+import Reanimate
+import Reanimate.Builtin.Documentation
+
+main :: IO ()
+main = reanimate $ docEnv $ playThenReverseA $ scene $ do
+  sprite <- fork $ newSpriteA $ drawCircle
+  signalS sprite 1 (curveS 2)
+  wait 1
+  signalS sprite 1 (powerS 2)

src/Reanimate.hs

@@ -103,6 +103,7 @@ module Reanimate
   , unVar             -- :: Var s a -> Frame s a
   , spriteT           -- :: Frame s Time
   , spriteDuration    -- :: Frame s Duration
+  , signalS           -- :: Sprite s -> Duration -> Signal -> Scene s ()
   , newSprite         -- :: Frame s SVG -> Scene s (Sprite s)
   , newSprite_        -- :: Frame s SVG -> Scene s ()
   , newSpriteA        -- :: Animation -> Scene s (Sprite s)

src/Reanimate/Scene.hs

@@ -20,6 +20,7 @@ module Reanimate.Scene
     waitOn, -- :: Scene s a -> Scene s a
     adjustZ, -- :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
     withSceneDuration, -- :: Scene s () -> Scene s Duration
+    signalS, -- Signal -> Scene s a -> Scene s a
 
     -- * Variables
     Var,
@@ -56,6 +57,7 @@ module Reanimate.Scene
     -- * Object API
     Object,
     ObjectData,
+    signalO,
     oNew,
     newObject,
     oModify,

src/Reanimate/Scene/Core.hs

@@ -73,6 +73,24 @@ scene action =
             )
     )
 
+-- -- | Apply easing function to all render elements created by the scene
+-- --   in the timespan from now to the scene duration.
+-- --
+-- --   Note that this does not affect time as seen by `queryNow` or any
+-- --   time-dependent variables or object properties.
+-- signalS :: Signal -> Scene s a -> Scene s a
+-- signalS signal (M action) = M $ \now -> do
+--   (a, s, p, gens) <- action now
+--   let action_dur = max s p
+--       modify_t t
+--         | t < now            = t
+--         | t > now+action_dur = t
+--         | otherwise          = now + signal ((t-now) / action_dur) * action_dur
+--   let applyS gen = do
+--         fn <- gen
+--         return $ \dur t -> fn dur (modify_t t)
+--   return (a, s, p, map applyS gens)
+
 -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before
 --   all forked actions have completed.
 --

src/Reanimate/Scene/Object.hs

@@ -18,7 +18,7 @@ import           Reanimate.Morph.Linear (linear)
 import           Reanimate.Svg
 
 import           Reanimate.Scene.Core   (Scene, fork, scene, wait)
-import           Reanimate.Scene.Sprite (Sprite, newSprite, newSpriteA', play, spriteModify, unVar)
+import           Reanimate.Scene.Sprite (Sprite, newSprite, newSpriteA', play, spriteModify, unVar, signalS)
 import           Reanimate.Scene.Var    (Var, modifyVar, newVar, readVar, tweenVar)
 
 -------------------------------------------------------
@@ -245,6 +245,10 @@ oBBHeight = oBB . _4
 -------------------------------------------------------------------------------
 -- Object modifiers
 
+-- | Apply easing function before rendering object.
+signalO :: Object s a -> Duration -> Signal -> Scene s ()
+signalO obj dur signal = signalS (objectSprite obj) dur signal
+
 -- | Modify object properties.
 oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s ()
 oModify o = modifyVar (objectData o)

src/Reanimate/Scene/Sprite.hs

@@ -16,6 +16,7 @@ import           Reanimate.Scene.Core (Scene (M), ZIndex, addGen, fork, liftST,
                                        wait)
 import           Reanimate.Scene.Var  (Var (..), newVar, readVar, unpackVar)
 import           Reanimate.Transition (Transition, overlapT)
+import           Reanimate.Ease       (Signal)
 
 -- | Create and render a variable. The rendering will be born at the current timestamp
 --   and will persist until the end of the scene.
@@ -57,7 +58,7 @@ play ani = newSpriteA ani >>= destroySprite
 
 -- | Sprites are animations with a given time of birth as well as a time of death.
 --   They can be controlled using variables, tweening, and effects.
-data Sprite s = Sprite Time (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex))))
+data Sprite s = Sprite Time (STRef s (Time -> Time)) (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex))))
 
 -- | Sprite frame generator. Generates frames over time in a stateful environment.
 newtype Frame s a = Frame {unFrame :: ST s (Time -> Duration -> Time -> a)}
@@ -113,13 +114,16 @@ spriteDuration = Frame $ return (\_real_t d _t -> d)
 newSprite :: Frame s SVG -> Scene s (Sprite s)
 newSprite render = do
   now <- queryNow
+  tmod <- liftST $ newSTRef id
   ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0))
   addGen $ do
     fn <- unFrame render
+    time_fn <- readSTRef tmod
     (spriteDur, spriteEffectGen) <- readSTRef ref
     spriteEffect <- spriteEffectGen
-    return $ \d absT ->
-      let relD = (if spriteDur < 0 then d else spriteDur) - now
+    return $ \d absT_ ->
+      let absT = time_fn absT_
+          relD = (if spriteDur < 0 then d else spriteDur) - now
           relT = absT - now
           -- Sprite is live [now;duration[
           -- If we're at the end of a scene, sprites
@@ -131,7 +135,7 @@ newSprite render = do
        in if inTimeSlice || isLastFrame
             then spriteEffect relD relT (fn absT relD relT)
             else (None, 0)
-  return $ Sprite now ref
+  return $ Sprite now tmod ref
 
 -- | Create new sprite defined by a frame generator. The sprite will die at
 --   the end of the scene.
@@ -224,7 +228,7 @@ applyVar var sprite fn = spriteModify sprite $ do
 --
 --   <<docs/gifs/doc_destroySprite.gif>>
 destroySprite :: Sprite s -> Scene s ()
-destroySprite (Sprite _ ref) = do
+destroySprite (Sprite _ _tmod ref) = do
   now <- queryNow
   liftST $
     modifySTRef ref $ \(ttl, render) ->
@@ -232,7 +236,7 @@ destroySprite (Sprite _ ref) = do
 
 -- | Low-level frame modifier.
 spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
-spriteModify (Sprite born ref) modFn = liftST $
+spriteModify (Sprite born _tmod ref) modFn = liftST $
   modifySTRef ref $ \(ttl, renderGen) ->
     ( ttl,
       do
@@ -242,6 +246,19 @@ spriteModify (Sprite born ref) modFn = liftST $
           let absT = relT + born in modRender absT relD relT . render relD relT
     )
 
+-- | Apply easing function before rendering sprite.
+signalS :: Sprite s -> Duration -> Signal -> Scene s ()
+signalS (Sprite _born tmod _ref) dur signal = do
+  now <- queryNow
+  let modify_t t
+        | t < now     = t
+        | t > now+dur = t
+        | otherwise   = now + signal ((t-now) / dur) * dur
+  liftST $
+    modifySTRef tmod $ \fn -> modify_t . fn
+    
+
+
 -- | Map the SVG output of a sprite.
 --
 --   Example:
@@ -254,7 +271,7 @@ spriteModify (Sprite born ref) modFn = liftST $
 --
 --   <<docs/gifs/doc_spriteMap.gif>>
 spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
-spriteMap sprite@(Sprite born _) fn = do
+spriteMap sprite@(Sprite born _ _) fn = do
   now <- queryNow
   let tDelta = now - born
   spriteModify sprite $ do
@@ -272,7 +289,7 @@ spriteMap sprite@(Sprite born _) fn = do
 --
 --   <<docs/gifs/doc_spriteTween.gif>>
 spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
-spriteTween sprite@(Sprite born _) dur fn = do
+spriteTween sprite@(Sprite born _ _) dur fn = do
   now <- queryNow
   let tDelta = now - born
   spriteModify sprite $ do
@@ -314,7 +331,7 @@ spriteVar sprite def fn = do
 --
 --   <<docs/gifs/doc_spriteE.gif>>
 spriteE :: Sprite s -> Effect -> Scene s ()
-spriteE (Sprite born ref) effect = do
+spriteE (Sprite born _tmod ref) effect = do
   now <- queryNow
   liftST $
     modifySTRef ref $ \(ttl, renderGen) ->
@@ -340,7 +357,7 @@ spriteE (Sprite born ref) effect = do
 --
 --   <<docs/gifs/doc_spriteZ.gif>>
 spriteZ :: Sprite s -> ZIndex -> Scene s ()
-spriteZ (Sprite born ref) zindex = do
+spriteZ (Sprite born _tmod ref) zindex = do
   now <- queryNow
   liftST $
     modifySTRef ref $ \(ttl, renderGen) ->