content: {-# LANGUAGE RankNTypes #-}
  
  module Reanimate.Scene.Core where
  
  import           Control.Monad.Fix          (MonadFix (..))
  import           Control.Monad.ST           (ST, runST)
  import           Data.List                  (sortOn)
  import           Reanimate.Animation        (Animation, Duration, SVG, Time, mkAnimation)
  import           Reanimate.Svg.Constructors (mkGroup)
  
  -- | The ZIndex property specifies the stack order of sprites and animations. Elements
  --   with a higher ZIndex will be drawn on top of elements with a lower index.
  type ZIndex = Int
  
  -- (seq duration, par duration)
  -- [(Time, Animation, ZIndex)]
  -- Map Time [(Animation, ZIndex)]
  type Gen s = ST s (Duration -> Time -> (SVG, ZIndex))
  
  -- | A 'Scene' represents a sequence of animations and variables
  --   that change over time.
  newtype Scene s a = M {unM :: Time -> ST s (a, Duration, Duration, [Gen s])}
  
  instance Functor (Scene s) where
    fmap f action = M $ \t -> do
      (a, d1, d2, gens) <- unM action t
      return (f a, d1, d2, gens)
  
  instance Applicative (Scene s) where
    pure a = M $ \_ -> return (a, 0, 0, [])
    f <*> g = M $ \t -> do
      (f', s1, p1, gen1) <- unM f t
      (g', s2, p2, gen2) <- unM g (t + s1)
      return (f' g', s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
  
  instance Monad (Scene s) where
    return = pure
    f >>= g = M $ \t -> do
      (a, s1, p1, gen1) <- unM f t
      (b, s2, p2, gen2) <- unM (g a) (t + s1)
      return (b, s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
  
  instance MonadFix (Scene s) where
    mfix fn = M $ \t -> mfix (\v -> let (a, _s, _p, _gens) = v in unM (fn a) t)
  
  -- | Lift ST action into the Scene monad.
  liftST :: ST s a -> Scene s a
  liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, [])
  
  -- | Evaluate the value of a scene.
  evalScene :: (forall s. Scene s a) -> a
  evalScene action = runST $ do
    (val, _, _, _) <- unM action 0
    return val
  
  -- | Render a 'Scene' to an 'Animation'.
  scene :: (forall s. Scene s a) -> Animation
  scene action =
    runST
      ( do
          (_, s, p, gens) <- unM action 0
          let dur = max s p
          genFns <- sequence gens
          return $
            mkAnimation
              dur
              ( \t ->
                  mkGroup $
                    map fst $
                      sortOn
                        snd
                        [spriteRender dur (t * dur) | spriteRender <- genFns]
              )
      )
  
  -- -- | 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.
  --
  --   Example:
  --
  -- @
  -- do 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
  --    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
  -- @
  --
  --   <<docs/gifs/doc_fork.gif>>
  fork :: Scene s a -> Scene s a
  fork (M action) = M $ \t -> do
    (a, s, p, gens) <- action t
    return (a, 0, max s p, gens)
  
  -- | Query the current clock timestamp.
  --
  --   Example:
  --
  -- @
  -- do now \<- 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow'
  --    'Reanimate.Scene.play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $
  --      'mkText' $ "Now=" <> T.pack (show now)
  -- @
  --
  --   <<docs/gifs/doc_queryNow.gif>>
  queryNow :: Scene s Time
  queryNow = M $ \t -> return (t, 0, 0, [])
  
  -- | Advance the clock by a given number of seconds.
  --
  --   Example:
  --
  -- @
  -- do 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
  --    'wait' 1
  --    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
  -- @
  --
  --   <<docs/gifs/doc_wait.gif>>
  wait :: Duration -> Scene s ()
  wait d = M $ \_ -> return ((), d, 0, [])
  
  -- | Wait until the clock is equal to the given timestamp.
  waitUntil :: Time -> Scene s ()
  waitUntil tNew = do
    now <- queryNow
    wait (max 0 (tNew - now))
  
  -- | Wait until all forked and sequential animations have finished.
  --
  --   Example:
  --
  -- @
  -- do 'waitOn' $ 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
  --    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
  -- @
  --
  --   <<docs/gifs/doc_waitOn.gif>>
  waitOn :: Scene s a -> Scene s a
  waitOn (M action) = M $ \t -> do
    (a, s, p, gens) <- action t
    return (a, max s p, 0, gens)
  
  -- | Change the ZIndex of a scene.
  adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
  adjustZ fn (M action) = M $ \t -> do
    (a, s, p, gens) <- action t
    return (a, s, p, map genFn gens)
    where
      genFn gen = do
        frameGen <- gen
        return $ \d t -> let (svg, z) = frameGen d t in (svg, fn z)
  
  -- | Query the duration of a scene.
  withSceneDuration :: Scene s () -> Scene s Duration
  withSceneDuration s = do
    t1 <- queryNow
    s
    t2 <- queryNow
    return (t2 - t1)
  
  addGen :: Gen s -> Scene s ()
  addGen gen = M $ \_ -> return ((), 0, 0, [gen])
  