Hierarchical sprites and objects (#269)

* Separate sprite creation from adding to scene

This is work towards supporting hierarchical sprites and objects:
the Sprite data definition is updated to include it's generator and
a new function newSpritePart is added to create a sprite without
adding the generator to the scene, making it invisible. Later commits
will provide a way for sprites created by newSpritePart to be used
in the definitions of other sprites.

* Support use of one sprite within another

This is work towards supporting hierarchical sprites and objects.
A new function, renderSprite, is defined that exposes its generator
in the form of a Frame context that can be used in the definitions
of other sprites.

Some internal types have had to be changed to support renderSprite. The
frame context created by renderSprite runs the sprite's generator, and must
supply the scene duration to it, and so the frame type has had to be updated
also to be dependent on the scene duration. In turn, a sprite's effects
mapping needs to be able to interpret a frame context in the implementation
of spriteModify, and so the effects mapping has also had to be made
dependent on the scene duration.

* Support use of objects within hierarchical sprites

Allow use of objects as leaves within a hierarchically
defined sprite. Two new functions are added:

  The function newObjectPart creates an object, not immediately
  added to the scene, so invisible even after calls to oShow, and
  mainfesting only if used within the definition of a sprite.

  The function renderObject exposes the generator of the object's
  internal sprite in the form of a frame context that can be used
  in the definitions of other sprites.

* Add example script showing use of newObjectPart and renderObject

This is a slightly contrived example, chosen to show an animation that
is difficult to contruct other than hiearchically. Two strings are placed
one over the other. They are shown using oDraw which requires their being
Objects. The overlapping strings are faded out, which requires
opacity to be applied at the group level: fading each individually would
lead to the lower string becoming visible through the upper one as opacity
is decreased.

src/Reanimate.hs

@@ -105,12 +105,14 @@ module Reanimate
   , spriteDuration    -- :: Frame s Duration
   , signalS           -- :: Sprite s -> Duration -> Signal -> Scene s ()
   , newSprite         -- :: Frame s SVG -> Scene s (Sprite s)
+  , newSpritePart     -- :: Frame s SVG -> Scene s (Sprite s)
   , newSprite_        -- :: Frame s SVG -> Scene s ()
   , newSpriteA        -- :: Animation -> Scene s (Sprite s)
   , newSpriteA'       -- :: Sync -> Animation -> Scene s (Sprite s)
   , newSpriteSVG      -- :: SVG -> Scene s (Sprite s)
   , newSpriteSVG_     -- :: SVG -> Scene s ()
   , destroySprite     -- :: Sprite s -> Scene s ()
+  , renderSprite      -- :: Sprite s -> Frame s SVG
   , applyVar          -- :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
   , spriteModify      -- :: Sprite s -> Frame s ((SVG,ZIndex) -> (SVG, ZIndex)) -> Scene s ()
   , spriteMap         -- :: Sprite s -> (SVG -> SVG) -> Scene s ()

src/Reanimate/Scene.hs

@@ -39,12 +39,14 @@ module Reanimate.Scene
     spriteT, -- :: Frame s Time
     spriteDuration, -- :: Frame s Duration
     newSprite, -- :: Frame s SVG -> Scene s (Sprite s)
+    newSpritePart, -- :: Frame s SVG -> Scene s (Sprite s)
     newSprite_, -- :: Frame s SVG -> Scene s ()
     newSpriteA, -- :: Animation -> Scene s (Sprite s)
     newSpriteA', -- :: Sync -> Animation -> Scene s (Sprite s)
     newSpriteSVG, -- :: SVG -> Scene s (Sprite s)
     newSpriteSVG_, -- :: SVG -> Scene s ()
     destroySprite, -- :: Sprite s -> Scene s ()
+    renderSprite, -- :: Sprite s -> Frame s SVG
     applyVar, -- :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
     spriteModify, -- :: Sprite s -> Frame s ((SVG,ZIndex) -> (SVG, ZIndex)) -> Scene s ()
     spriteMap, -- :: Sprite s -> (SVG -> SVG) -> Scene s ()
@@ -60,6 +62,8 @@ module Reanimate.Scene
     signalO,
     oNew,
     newObject,
+    newObjectPart,
+    renderObject,
     oModify,
     oModifyS,
     oRead,

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, signalS)
+import           Reanimate.Scene.Sprite (Frame, Sprite, addPartToScene, newSpritePart, newSpriteA', play, spriteModify, unVar, signalS, renderSprite)
 import           Reanimate.Scene.Var    (Var, modifyVar, newVar, readVar, tweenVar)
 
 -------------------------------------------------------
@@ -290,6 +290,15 @@ oNew = newObject
 -- | Create new object.
 newObject :: Renderable a => a -> Scene s (Object s a)
 newObject val = do
+  obj <- newObjectPart val
+  addPartToScene $ objectSprite obj
+  return obj
+
+-- | Create new object, but not showing as part of the scene, Such
+--   objects can be used hierachically within the definitions of
+--   sprites, via the function renderObject.
+newObjectPart :: Renderable a => a -> Scene s (Object s a)
+newObjectPart val = do
   ref <-
     newVar
       ObjectData
@@ -306,7 +315,7 @@ newObject val = do
           _oScale = 1,
           _oScaleOrigin = V2 0 0
         }
-  sprite <- newSprite $ do
+  sprite <- newSpritePart $ do
     ~obj@ObjectData {..} <- unVar ref
     pure $
       if _oShown
@@ -327,6 +336,32 @@ newObject val = do
   where
     svg = toSVG val
 
+-- | Create a frame context from an object for use within a sprite definition.
+--
+--   Example:
+--
+-- @
+-- do opacityVar <- 'newVar' 1
+--    textObj1 <- 'newObjectPart' $ 'scale' 3 $ 'center' $ 'latex' "Fade"
+--    'oModify' textObj1 $ 'oContext' .~ 'withFillColor' "red"
+--    textObj2 <- 'newObjectPart' $ 'scale' 3 $ 'center' $ 'latex' "Overlap"
+--    'oModify' textObj2 $ 'oContext' .~ 'withFillColor' "blue"
+--    sprite <- 'newSprite' $ do
+--      opacity <- 'unVar' opacityVar
+--      text1 <- 'renderObject' textObj1
+--      text2 <- 'renderObject' textObj2
+--      'return' $ 'withGroupOpacity' opacity $ 'mkGroup' [text1, text2]
+--    'fork' $ 'oShowWith' textObj1 $ 'setDuration' 1 . 'oDraw'
+--    'wait' 0.2
+--    'fork' $ 'oShowWith' textObj2 $ 'setDuration' 1 . 'oDraw'
+--    'wait' 0.2
+--    'tweenVar' opacityVar 1 $ 'const' $ 'fromToS' 1 0
+-- @
+--
+-- <<docs/gifs/doc_renderObject.gif>>
+renderObject :: Object s a -> Frame s SVG
+renderObject obj = renderSprite $ objectSprite obj
+
 oScaleApply :: ObjectData a -> (SVG -> SVG)
 oScaleApply ObjectData {..} =
   uncurryV2 translate (negate _oScaleOrigin)

src/Reanimate/Scene/Sprite.hs

@@ -12,7 +12,7 @@ import           Graphics.SvgTree     (pattern None)
 import           Reanimate.Animation  (Animation, Duration, SVG, Sync (SyncStretch), Time, dropA,
                                        duration, getAnimationFrame)
 import           Reanimate.Effect     (Effect, delayE)
-import           Reanimate.Scene.Core (Scene (M), ZIndex, addGen, fork, liftST, queryNow, scene,
+import           Reanimate.Scene.Core (Gen, Scene (M), ZIndex, addGen, fork, liftST, queryNow, scene,
                                        wait)
 import           Reanimate.Scene.Var  (Var (..), newVar, readVar, unpackVar)
 import           Reanimate.Transition (Transition, overlapT)
@@ -58,22 +58,22 @@ 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 (Time -> 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 -> Duration -> Time -> SVG -> (SVG, ZIndex)))) (Gen s)
 
 -- | Sprite frame generator. Generates frames over time in a stateful environment.
-newtype Frame s a = Frame {unFrame :: ST s (Time -> Duration -> Time -> a)}
+newtype Frame s a = Frame {unFrame :: ST s (Duration -> Time -> Duration -> Time -> a)}
 
 instance Functor (Frame s) where
   fmap fn (Frame gen) = Frame $ do
     m <- gen
-    return (\real_t d t -> fn $ m real_t d t)
+    return (\scene_d real_t d t -> fn $ m scene_d real_t d t)
 
 instance Applicative (Frame s) where
-  pure v = Frame $ return (\_ _ _ -> v)
+  pure v = Frame $ return (\_ _ _ _ -> v)
   Frame f <*> Frame g = Frame $ do
     m1 <- f
     m2 <- g
-    return $ \real_t d t -> m1 real_t d t (m2 real_t d t)
+    return $ \scene_d real_t d t -> m1 scene_d real_t d t (m2 scene_d real_t d t)
 
 -- | Dereference a variable as a Sprite frame.
 --
@@ -90,15 +90,15 @@ instance Applicative (Frame s) where
 unVar :: Var s a -> Frame s a
 unVar var = Frame $ do
   fn <- unpackVar var
-  return $ \real_t _d _t -> fn real_t
+  return $ \_scene_d real_t _d _t -> fn real_t
 
 -- | Dereference seconds since sprite birth.
 spriteT :: Frame s Time
-spriteT = Frame $ return (\_real_t _d t -> t)
+spriteT = Frame $ return (\_scene_d _real_t _d t -> t)
 
 -- | Dereference duration of the current sprite.
 spriteDuration :: Frame s Duration
-spriteDuration = Frame $ return (\_real_t d _t -> d)
+spriteDuration = Frame $ return (\_scene_d _real_t d _t -> d)
 
 -- | Create new sprite defined by a frame generator. Unless otherwise specified using
 --   'destroySprite', the sprite will die at the end of the scene.
@@ -113,17 +113,26 @@ spriteDuration = Frame $ return (\_real_t d _t -> d)
 --   <<docs/gifs/doc_newSprite.gif>>
 newSprite :: Frame s SVG -> Scene s (Sprite s)
 newSprite render = do
+  s <- newSpritePart render
+  addPartToScene s
+  return s
+
+-- | Create a new sprite defined by a frame generator, but not showing
+--   as part of the scene. Such sprites can be used hierarchically within
+--   the definitions of other sprites, via the function renderSprite.
+newSpritePart :: Frame s SVG -> Scene s (Sprite s)
+newSpritePart render = do
   now <- queryNow
   tmod <- liftST $ newSTRef id
-  ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0))
-  addGen $ do
+  ref <- liftST $ newSTRef (-1, return $ \_ad _d _t svg -> (svg, 0))
+  return $ Sprite now tmod ref $ do
     fn <- unFrame render
     time_fn <- readSTRef tmod
     (spriteDur, spriteEffectGen) <- readSTRef ref
     spriteEffect <- spriteEffectGen
-    return $ \d absT_ ->
+    return $ \absD absT_ ->
       let absT = time_fn absT_
-          relD = (if spriteDur < 0 then d else spriteDur) - now
+          relD = (if spriteDur < 0 then absD else spriteDur) - now
           relT = absT - now
           -- Sprite is live [now;duration[
           -- If we're at the end of a scene, sprites
@@ -131,11 +140,13 @@ newSprite render = do
           -- This behavior is difficult to get right. See the 'bug_*' examples for
           -- automated tests.
           inTimeSlice = relT >= 0 && relT < relD
-          isLastFrame = d == absT && relT == relD
-       in if inTimeSlice || isLastFrame
-            then spriteEffect relD relT (fn absT relD relT)
+          isLastFrame = absD == absT && relT == relD
+      in if inTimeSlice || isLastFrame
+            then spriteEffect absD relD relT (fn absD absT relD relT)
             else (None, 0)
-  return $ Sprite now tmod ref
+
+addPartToScene :: Sprite s -> Scene s ()
+addPartToScene (Sprite _ _ _ gen) = addGen gen
 
 -- | Create new sprite defined by a frame generator. The sprite will die at
 --   the end of the scene.
@@ -197,6 +208,15 @@ newSpriteSVG = newSprite . pure
 newSpriteSVG_ :: SVG -> Scene s ()
 newSpriteSVG_ = void . newSpriteSVG
 
+-- | Create a frame context from the source sprite for use within another. Use of this
+--   function allows several sprites to be combined into a single one, with the
+--   method of combination controled by variables.
+renderSprite :: Sprite s -> Frame s SVG
+renderSprite (Sprite _ _ _ gen) =
+  Frame $ do
+            genFn <- gen
+            return (\absD absT _ _ -> fst $ genFn absD absT)
+
 -- | Change the rendering of a sprite using data from a variable. If data from several variables
 --   is needed, use a frame generator instead.
 --
@@ -228,7 +248,7 @@ applyVar var sprite fn = spriteModify sprite $ do
 --
 --   <<docs/gifs/doc_destroySprite.gif>>
 destroySprite :: Sprite s -> Scene s ()
-destroySprite (Sprite _ _tmod ref) = do
+destroySprite (Sprite _ _tmod ref _) = do
   now <- queryNow
   liftST $
     modifySTRef ref $ \(ttl, render) ->
@@ -236,19 +256,19 @@ destroySprite (Sprite _ _tmod ref) = do
 
 -- | Low-level frame modifier.
 spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
-spriteModify (Sprite born _tmod ref) modFn = liftST $
+spriteModify (Sprite born _tmod ref _) modFn = liftST $
   modifySTRef ref $ \(ttl, renderGen) ->
     ( ttl,
       do
         render <- renderGen
         modRender <- unFrame modFn
-        return $ \relD relT ->
-          let absT = relT + born in modRender absT relD relT . render relD relT
+        return $ \absD relD relT ->
+          let absT = relT + born in modRender absD absT relD relT . render absD relD relT
     )
 
 -- | Apply easing function before rendering sprite.
 signalS :: Sprite s -> Duration -> Signal -> Scene s ()
-signalS (Sprite _born tmod _ref) dur signal = do
+signalS (Sprite _born tmod _ref _) dur signal = do
   now <- queryNow
   let modify_t t
         | t < now     = t
@@ -271,7 +291,7 @@ signalS (Sprite _born tmod _ref) dur signal = do
 --
 --   <<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
@@ -289,7 +309,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
@@ -331,15 +351,15 @@ spriteVar sprite def fn = do
 --
 --   <<docs/gifs/doc_spriteE.gif>>
 spriteE :: Sprite s -> Effect -> Scene s ()
-spriteE (Sprite born _tmod ref) effect = do
+spriteE (Sprite born _tmod ref _) effect = do
   now <- queryNow
   liftST $
     modifySTRef ref $ \(ttl, renderGen) ->
       ( ttl,
         do
           render <- renderGen
-          return $ \d t svg ->
-            let (svg', z) = render d t svg
+          return $ \ad d t svg ->
+            let (svg', z) = render ad d t svg
              in (delayE (max 0 $ now - born) effect d t svg', z)
       )
 
@@ -357,15 +377,15 @@ spriteE (Sprite born _tmod ref) effect = do
 --
 --   <<docs/gifs/doc_spriteZ.gif>>
 spriteZ :: Sprite s -> ZIndex -> Scene s ()
-spriteZ (Sprite born _tmod ref) zindex = do
+spriteZ (Sprite born _tmod ref _) zindex = do
   now <- queryNow
   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)
+          return $ \ad d t svg ->
+            let (svg', z) = render ad d t svg in (svg', if t < now - born then z else zindex)
       )
 
 -- | Destroy all local sprites at the end of a scene.