{-# LANGUAGE ApplicativeDo   #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes      #-}

module Reanimate.Scene.Sprite where

import           Control.Monad        (void)
import           Control.Monad.ST     (ST)
import           Data.Bifunctor       (Bifunctor (first))
import           Data.STRef           (STRef, modifySTRef, newSTRef, readSTRef)
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,
                                       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.
--
--   Example:
--
-- @
-- do var \<- 'simpleVar' 'Reanimate.Svg.Constructors.mkCircle' 0
--    'Reanimate.Scene.tweenVar' var 2 $ \\val -> 'Reanimate.fromToS' val ('Reanimate.Constants.screenHeight'/2)
-- @
--
--   <<docs/gifs/doc_simpleVar.gif>>
simpleVar :: (a -> SVG) -> a -> Scene s (Var s a)
simpleVar :: (a -> SVG) -> a -> Scene s (Var s a)
simpleVar a -> SVG
render a
def = do
  Var s a
v <- a -> Scene s (Var s a)
forall a s. a -> Scene s (Var s a)
newVar a
def
  Sprite s
_ <- Frame s SVG -> Scene s (Sprite s)
forall s. Frame s SVG -> Scene s (Sprite s)
newSprite (Frame s SVG -> Scene s (Sprite s))
-> Frame s SVG -> Scene s (Sprite s)
forall a b. (a -> b) -> a -> b
$ a -> SVG
render (a -> SVG) -> Frame s a -> Frame s SVG
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Var s a -> Frame s a
forall s a. Var s a -> Frame s a
unVar Var s a
v
  return Var s a
v

-- | Helper function for filtering variables.
findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a)
findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a)
findVar a -> Bool
_cond [] = [Char] -> Scene s (Var s a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Variable not found."
findVar a -> Bool
cond (Var s a
v : [Var s a]
vs) = do
  a
val <- Var s a -> Scene s a
forall s a. Var s a -> Scene s a
readVar Var s a
v
  if a -> Bool
cond a
val then Var s a -> Scene s (Var s a)
forall (m :: * -> *) a. Monad m => a -> m a
return Var s a
v else (a -> Bool) -> [Var s a] -> Scene s (Var s a)
forall a s. (a -> Bool) -> [Var s a] -> Scene s (Var s a)
findVar a -> Bool
cond [Var s a]
vs

-- | Play an animation once and then remove it. This advances the clock by the duration of the
--   animation.
--
--   Example:
--
-- @
-- do 'play' 'Reanimate.Builtin.Documentation.drawBox'
--    'play' 'Reanimate.Builtin.Documentation.drawCircle'
-- @
--
--   <<docs/gifs/doc_play.gif>>
play :: Animation -> Scene s ()
play :: Animation -> Scene s ()
play Animation
ani = Animation -> Scene s (Sprite s)
forall s. Animation -> Scene s (Sprite s)
newSpriteA Animation
ani Scene s (Sprite s) -> (Sprite s -> Scene s ()) -> Scene s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sprite s -> Scene s ()
forall s. Sprite s -> Scene s ()
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))))

-- | Sprite frame generator. Generates frames over time in a stateful environment.
newtype Frame s a = Frame {Frame s a -> ST s (Time -> Time -> Time -> a)
unFrame :: ST s (Time -> Duration -> Time -> a)}

instance Functor (Frame s) where
  fmap :: (a -> b) -> Frame s a -> Frame s b
fmap a -> b
fn (Frame ST s (Time -> Time -> Time -> a)
gen) = ST s (Time -> Time -> Time -> b) -> Frame s b
forall s a. ST s (Time -> Time -> Time -> a) -> Frame s a
Frame (ST s (Time -> Time -> Time -> b) -> Frame s b)
-> ST s (Time -> Time -> Time -> b) -> Frame s b
forall a b. (a -> b) -> a -> b
$ do
    Time -> Time -> Time -> a
m <- ST s (Time -> Time -> Time -> a)
gen
    return (\Time
real_t Time
d Time
t -> a -> b
fn (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Time -> Time -> Time -> a
m Time
real_t Time
d Time
t)

instance Applicative (Frame s) where
  pure :: a -> Frame s a
pure a
v = ST s (Time -> Time -> Time -> a) -> Frame s a
forall s a. ST s (Time -> Time -> Time -> a) -> Frame s a
Frame (ST s (Time -> Time -> Time -> a) -> Frame s a)
-> ST s (Time -> Time -> Time -> a) -> Frame s a
forall a b. (a -> b) -> a -> b
$ (Time -> Time -> Time -> a) -> ST s (Time -> Time -> Time -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Time
_ Time
_ Time
_ -> a
v)
  Frame ST s (Time -> Time -> Time -> a -> b)
f <*> :: Frame s (a -> b) -> Frame s a -> Frame s b
<*> Frame ST s (Time -> Time -> Time -> a)
g = ST s (Time -> Time -> Time -> b) -> Frame s b
forall s a. ST s (Time -> Time -> Time -> a) -> Frame s a
Frame (ST s (Time -> Time -> Time -> b) -> Frame s b)
-> ST s (Time -> Time -> Time -> b) -> Frame s b
forall a b. (a -> b) -> a -> b
$ do
    Time -> Time -> Time -> a -> b
m1 <- ST s (Time -> Time -> Time -> a -> b)
f
    Time -> Time -> Time -> a
m2 <- ST s (Time -> Time -> Time -> a)
g
    return $ \Time
real_t Time
d Time
t -> Time -> Time -> Time -> a -> b
m1 Time
real_t Time
d Time
t (Time -> Time -> Time -> a
m2 Time
real_t Time
d Time
t)

-- | Dereference a variable as a Sprite frame.
--
--   Example:
--
-- @
-- do v \<- 'newVar' 0
--    'newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'unVar' v
--    'Reanimate.Scene.tweenVar' v 1 $ \\val -> 'Reanimate.fromToS' val 3
--    'Reanimate.Scene.tweenVar' v 1 $ \\val -> 'Reanimate.fromToS' val 0
-- @
--
--   <<docs/gifs/doc_unVar.gif>>
unVar :: Var s a -> Frame s a
unVar :: Var s a -> Frame s a
unVar Var s a
var = ST s (Time -> Time -> Time -> a) -> Frame s a
forall s a. ST s (Time -> Time -> Time -> a) -> Frame s a
Frame (ST s (Time -> Time -> Time -> a) -> Frame s a)
-> ST s (Time -> Time -> Time -> a) -> Frame s a
forall a b. (a -> b) -> a -> b
$ do
  Time -> a
fn <- Var s a -> ST s (Time -> a)
forall s a. Var s a -> ST s (Time -> a)
unpackVar Var s a
var
  return $ \Time
real_t Time
_d Time
_t -> Time -> a
fn Time
real_t

-- | Dereference seconds since sprite birth.
spriteT :: Frame s Time
spriteT :: Frame s Time
spriteT = ST s (Time -> Time -> Time -> Time) -> Frame s Time
forall s a. ST s (Time -> Time -> Time -> a) -> Frame s a
Frame (ST s (Time -> Time -> Time -> Time) -> Frame s Time)
-> ST s (Time -> Time -> Time -> Time) -> Frame s Time
forall a b. (a -> b) -> a -> b
$ (Time -> Time -> Time -> Time)
-> ST s (Time -> Time -> Time -> Time)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Time
_real_t Time
_d Time
t -> Time
t)

-- | Dereference duration of the current sprite.
spriteDuration :: Frame s Duration
spriteDuration :: Frame s Time
spriteDuration = ST s (Time -> Time -> Time -> Time) -> Frame s Time
forall s a. ST s (Time -> Time -> Time -> a) -> Frame s a
Frame (ST s (Time -> Time -> Time -> Time) -> Frame s Time)
-> ST s (Time -> Time -> Time -> Time) -> Frame s Time
forall a b. (a -> b) -> a -> b
$ (Time -> Time -> Time -> Time)
-> ST s (Time -> Time -> Time -> Time)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Time
_real_t Time
d Time
_t -> Time
d)

-- | Create new sprite defined by a frame generator. Unless otherwise specified using
--   'destroySprite', the sprite will die at the end of the scene.
--
--   Example:
--
-- @
-- do 'newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'spriteT' -- Circle sprite where radius=time.
--    'wait' 2
-- @
--
--   <<docs/gifs/doc_newSprite.gif>>
newSprite :: Frame s SVG -> Scene s (Sprite s)
newSprite :: Frame s SVG -> Scene s (Sprite s)
newSprite Frame s SVG
render = do
  Time
now <- Scene s Time
forall s. Scene s Time
queryNow
  STRef s (Time -> Time)
tmod <- ST s (STRef s (Time -> Time)) -> Scene s (STRef s (Time -> Time))
forall s a. ST s a -> Scene s a
liftST (ST s (STRef s (Time -> Time)) -> Scene s (STRef s (Time -> Time)))
-> ST s (STRef s (Time -> Time))
-> Scene s (STRef s (Time -> Time))
forall a b. (a -> b) -> a -> b
$ (Time -> Time) -> ST s (STRef s (Time -> Time))
forall a s. a -> ST s (STRef s a)
newSTRef Time -> Time
forall a. a -> a
id
  STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref <- ST s (STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> Scene
     s (STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
forall s a. ST s a -> Scene s a
liftST (ST s (STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
 -> Scene
      s (STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))))
-> ST
     s (STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> Scene
     s (STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
forall a b. (a -> b) -> a -> b
$ (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> ST
     s (STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
forall a s. a -> ST s (STRef s a)
newSTRef (-Time
1, (Time -> Time -> SVG -> (SVG, ZIndex))
-> ST s (Time -> Time -> SVG -> (SVG, ZIndex))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Time -> Time -> SVG -> (SVG, ZIndex))
 -> ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> (Time -> Time -> SVG -> (SVG, ZIndex))
-> ST s (Time -> Time -> SVG -> (SVG, ZIndex))
forall a b. (a -> b) -> a -> b
$ \Time
_d Time
_t SVG
svg -> (SVG
svg, ZIndex
0))
  Gen s -> Scene s ()
forall s. Gen s -> Scene s ()
addGen (Gen s -> Scene s ()) -> Gen s -> Scene s ()
forall a b. (a -> b) -> a -> b
$ do
    Time -> Time -> Time -> SVG
fn <- Frame s SVG -> ST s (Time -> Time -> Time -> SVG)
forall s a. Frame s a -> ST s (Time -> Time -> Time -> a)
unFrame Frame s SVG
render
    Time -> Time
time_fn <- STRef s (Time -> Time) -> ST s (Time -> Time)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Time -> Time)
tmod
    (Time
spriteDur, ST s (Time -> Time -> SVG -> (SVG, ZIndex))
spriteEffectGen) <- STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> ST s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
forall s a. STRef s a -> ST s a
readSTRef STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref
    Time -> Time -> SVG -> (SVG, ZIndex)
spriteEffect <- ST s (Time -> Time -> SVG -> (SVG, ZIndex))
spriteEffectGen
    return $ \Time
d Time
absT_ ->
      let absT :: Time
absT = Time -> Time
time_fn Time
absT_
          relD :: Time
relD = (if Time
spriteDur Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 then Time
d else Time
spriteDur) Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
now
          relT :: Time
relT = Time
absT Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
now
          -- Sprite is live [now;duration[
          -- If we're at the end of a scene, sprites
          -- are live: [now;duration]
          -- This behavior is difficult to get right. See the 'bug_*' examples for
          -- automated tests.
          inTimeSlice :: Bool
inTimeSlice = Time
relT Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
0 Bool -> Bool -> Bool
&& Time
relT Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
relD
          isLastFrame :: Bool
isLastFrame = Time
d Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
absT Bool -> Bool -> Bool
&& Time
relT Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
relD
       in if Bool
inTimeSlice Bool -> Bool -> Bool
|| Bool
isLastFrame
            then Time -> Time -> SVG -> (SVG, ZIndex)
spriteEffect Time
relD Time
relT (Time -> Time -> Time -> SVG
fn Time
absT Time
relD Time
relT)
            else (SVG
None, ZIndex
0)
  return $ Time
-> STRef s (Time -> Time)
-> STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> Sprite s
forall s.
Time
-> STRef s (Time -> Time)
-> STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> Sprite s
Sprite Time
now STRef s (Time -> Time)
tmod STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref

-- | Create new sprite defined by a frame generator. The sprite will die at
--   the end of the scene.
newSprite_ :: Frame s SVG -> Scene s ()
newSprite_ :: Frame s SVG -> Scene s ()
newSprite_ = Scene s (Sprite s) -> Scene s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Scene s (Sprite s) -> Scene s ())
-> (Frame s SVG -> Scene s (Sprite s)) -> Frame s SVG -> Scene s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame s SVG -> Scene s (Sprite s)
forall s. Frame s SVG -> Scene s (Sprite s)
newSprite

-- | Create a new sprite from an animation. This advances the clock by the
--   duration of the animation. Unless otherwise specified using
--   'destroySprite', the sprite will die at the end of the scene.
--
--   Note: If the scene doesn't end immediately after the duration of the
--   animation, the animation will be stretched to match the lifetime of the
--   sprite. See 'newSpriteA'' and 'play'.
--
--   Example:
--
-- @
-- do 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
--    'play' 'Reanimate.Builtin.Documentation.drawBox'
--    'play' $ 'Reanimate.Animation.reverseA' 'Reanimate.Builtin.Documentation.drawBox'
-- @
--
--   <<docs/gifs/doc_newSpriteA.gif>>
newSpriteA :: Animation -> Scene s (Sprite s)
newSpriteA :: Animation -> Scene s (Sprite s)
newSpriteA = Sync -> Animation -> Scene s (Sprite s)
forall s. Sync -> Animation -> Scene s (Sprite s)
newSpriteA' Sync
SyncStretch

-- | Create a new sprite from an animation and specify the synchronization policy. This advances
--   the clock by the duration of the animation.
--
--   Example:
--
-- @
-- do 'fork' $ 'newSpriteA'' 'Reanimate.Animation.SyncFreeze' 'Reanimate.Builtin.Documentation.drawCircle'
--    'play' 'Reanimate.Builtin.Documentation.drawBox'
--    'play' $ 'Reanimate.Animation.reverseA' 'Reanimate.Builtin.Documentation.drawBox'
-- @
--
--   <<docs/gifs/doc_newSpriteA'.gif>>
newSpriteA' :: Sync -> Animation -> Scene s (Sprite s)
newSpriteA' :: Sync -> Animation -> Scene s (Sprite s)
newSpriteA' Sync
sync Animation
animation =
  Frame s SVG -> Scene s (Sprite s)
forall s. Frame s SVG -> Scene s (Sprite s)
newSprite (Sync -> Animation -> Time -> Time -> SVG
getAnimationFrame Sync
sync Animation
animation (Time -> Time -> SVG) -> Frame s Time -> Frame s (Time -> SVG)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Frame s Time
forall s. Frame s Time
spriteT Frame s (Time -> SVG) -> Frame s Time -> Frame s SVG
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Frame s Time
forall s. Frame s Time
spriteDuration)
    Scene s (Sprite s) -> Scene s () -> Scene s (Sprite s)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Time -> Scene s ()
forall s. Time -> Scene s ()
wait (Animation -> Time
duration Animation
animation)

-- | Create a sprite from a static SVG image.
--
--   Example:
--
-- @
-- do 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.mkBackground' "lightblue"
--    'play' 'Reanimate.Builtin.Documentation.drawCircle'
-- @
--
--   <<docs/gifs/doc_newSpriteSVG.gif>>
newSpriteSVG :: SVG -> Scene s (Sprite s)
newSpriteSVG :: SVG -> Scene s (Sprite s)
newSpriteSVG = Frame s SVG -> Scene s (Sprite s)
forall s. Frame s SVG -> Scene s (Sprite s)
newSprite (Frame s SVG -> Scene s (Sprite s))
-> (SVG -> Frame s SVG) -> SVG -> Scene s (Sprite s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SVG -> Frame s SVG
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Create a permanent sprite from a static SVG image. Same as `newSpriteSVG`
--   but the sprite isn't returned and thus cannot be destroyed.
newSpriteSVG_ :: SVG -> Scene s ()
newSpriteSVG_ :: SVG -> Scene s ()
newSpriteSVG_ = Scene s (Sprite s) -> Scene s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Scene s (Sprite s) -> Scene s ())
-> (SVG -> Scene s (Sprite s)) -> SVG -> Scene s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SVG -> Scene s (Sprite s)
forall s. SVG -> Scene s (Sprite s)
newSpriteSVG

-- | Change the rendering of a sprite using data from a variable. If data from several variables
--   is needed, use a frame generator instead.
--
--   Example:
--
-- @
-- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox'
--    v \<- 'newVar' 0
--    'applyVar' v s 'Reanimate.Svg.Constructors.rotate'
--    'Reanimate.Scene.tweenVar' v 2 $ \\val -> 'Reanimate.fromToS' val 90
-- @
--
--   <<docs/gifs/doc_applyVar.gif>>
applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
applyVar Var s a
var Sprite s
sprite a -> SVG -> SVG
fn = Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
forall s.
Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
spriteModify Sprite s
sprite (Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ())
-> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
forall a b. (a -> b) -> a -> b
$ do
  a
varFn <- Var s a -> Frame s a
forall s a. Var s a -> Frame s a
unVar Var s a
var
  return $ (SVG -> SVG) -> (SVG, ZIndex) -> (SVG, ZIndex)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((SVG -> SVG) -> (SVG, ZIndex) -> (SVG, ZIndex))
-> (SVG -> SVG) -> (SVG, ZIndex) -> (SVG, ZIndex)
forall a b. (a -> b) -> a -> b
$ a -> SVG -> SVG
fn a
varFn

-- | Destroy a sprite, preventing it from being rendered in the future of the scene.
--   If 'destroySprite' is invoked multiple times, the earliest time-of-death is used.
--
--   Example:
--
-- @
-- do s <- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.mkCircle' 1
--    'fork' $ 'wait' 1 \>\> 'destroySprite' s
--    'play' 'Reanimate.Builtin.Documentation.drawBox'
-- @
--
--   <<docs/gifs/doc_destroySprite.gif>>
destroySprite :: Sprite s -> Scene s ()
destroySprite :: Sprite s -> Scene s ()
destroySprite (Sprite Time
_ STRef s (Time -> Time)
_tmod STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref) = do
  Time
now <- Scene s Time
forall s. Scene s Time
queryNow
  ST s () -> Scene s ()
forall s a. ST s a -> Scene s a
liftST (ST s () -> Scene s ()) -> ST s () -> Scene s ()
forall a b. (a -> b) -> a -> b
$
    STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> ((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
    -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref (((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
  -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
 -> ST s ())
-> ((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
    -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Time
ttl, ST s (Time -> Time -> SVG -> (SVG, ZIndex))
render) ->
      (if Time
ttl Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 then Time
now else Time -> Time -> Time
forall a. Ord a => a -> a -> a
min Time
ttl Time
now, ST s (Time -> Time -> SVG -> (SVG, ZIndex))
render)

-- | Low-level frame modifier.
spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
spriteModify (Sprite Time
born STRef s (Time -> Time)
_tmod STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref) Frame s ((SVG, ZIndex) -> (SVG, ZIndex))
modFn = ST s () -> Scene s ()
forall s a. ST s a -> Scene s a
liftST (ST s () -> Scene s ()) -> ST s () -> Scene s ()
forall a b. (a -> b) -> a -> b
$
  STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> ((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
    -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref (((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
  -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
 -> ST s ())
-> ((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
    -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Time
ttl, ST s (Time -> Time -> SVG -> (SVG, ZIndex))
renderGen) ->
    ( Time
ttl,
      do
        Time -> Time -> SVG -> (SVG, ZIndex)
render <- ST s (Time -> Time -> SVG -> (SVG, ZIndex))
renderGen
        Time -> Time -> Time -> (SVG, ZIndex) -> (SVG, ZIndex)
modRender <- Frame s ((SVG, ZIndex) -> (SVG, ZIndex))
-> ST s (Time -> Time -> Time -> (SVG, ZIndex) -> (SVG, ZIndex))
forall s a. Frame s a -> ST s (Time -> Time -> Time -> a)
unFrame Frame s ((SVG, ZIndex) -> (SVG, ZIndex))
modFn
        return $ \Time
relD Time
relT ->
          let absT :: Time
absT = Time
relT Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
born in Time -> Time -> Time -> (SVG, ZIndex) -> (SVG, ZIndex)
modRender Time
absT Time
relD Time
relT ((SVG, ZIndex) -> (SVG, ZIndex))
-> (SVG -> (SVG, ZIndex)) -> SVG -> (SVG, ZIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Time -> SVG -> (SVG, ZIndex)
render Time
relD Time
relT
    )

-- | Apply easing function before rendering sprite.
signalS :: Sprite s -> Duration -> Signal -> Scene s ()
signalS :: Sprite s -> Time -> (Time -> Time) -> Scene s ()
signalS (Sprite Time
_born STRef s (Time -> Time)
tmod STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
_ref) Time
dur Time -> Time
signal = do
  Time
now <- Scene s Time
forall s. Scene s Time
queryNow
  let modify_t :: Time -> Time
modify_t Time
t
        | Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
now     = Time
t
        | Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
nowTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
dur = Time
t
        | Bool
otherwise   = Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time -> Time
signal ((Time
tTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
now) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
dur) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
dur
  ST s () -> Scene s ()
forall s a. ST s a -> Scene s a
liftST (ST s () -> Scene s ()) -> ST s () -> Scene s ()
forall a b. (a -> b) -> a -> b
$
    STRef s (Time -> Time)
-> ((Time -> Time) -> Time -> Time) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Time -> Time)
tmod (((Time -> Time) -> Time -> Time) -> ST s ())
-> ((Time -> Time) -> Time -> Time) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Time -> Time
fn -> Time -> Time
modify_t (Time -> Time) -> (Time -> Time) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Time
fn
    


-- | Map the SVG output of a sprite.
--
--   Example:
--
-- @
-- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
--    'wait' 1
--    'spriteMap' s 'Reanimate.Svg.Constructors.flipYAxis'
-- @
--
--   <<docs/gifs/doc_spriteMap.gif>>
spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
spriteMap sprite :: Sprite s
sprite@(Sprite Time
born STRef s (Time -> Time)
_ STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
_) SVG -> SVG
fn = do
  Time
now <- Scene s Time
forall s. Scene s Time
queryNow
  let tDelta :: Time
tDelta = Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
born
  Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
forall s.
Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
spriteModify Sprite s
sprite (Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ())
-> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
forall a b. (a -> b) -> a -> b
$ do
    Time
t <- Frame s Time
forall s. Frame s Time
spriteT
    return $ \(SVG
svg, ZIndex
zindex) -> (if (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
tDelta) Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 then SVG
svg else SVG -> SVG
fn SVG
svg, ZIndex
zindex)

-- | Modify the output of a sprite between @now@ and @now+duration@.
--
--   Example:
--
-- @
-- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
--    'spriteTween' s 1 $ \\val -> 'Reanimate.Svg.Constructors.translate' ('Reanimate.Constants.screenWidth'*0.3*val) 0
-- @
--
--   <<docs/gifs/doc_spriteTween.gif>>
spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
spriteTween :: Sprite s -> Time -> (Time -> SVG -> SVG) -> Scene s ()
spriteTween sprite :: Sprite s
sprite@(Sprite Time
born STRef s (Time -> Time)
_ STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
_) Time
dur Time -> SVG -> SVG
fn = do
  Time
now <- Scene s Time
forall s. Scene s Time
queryNow
  let tDelta :: Time
tDelta = Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
born
  Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
forall s.
Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
spriteModify Sprite s
sprite (Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ())
-> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
forall a b. (a -> b) -> a -> b
$ do
    Time
t <- Frame s Time
forall s. Frame s Time
spriteT
    return $ (SVG -> SVG) -> (SVG, ZIndex) -> (SVG, ZIndex)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((SVG -> SVG) -> (SVG, ZIndex) -> (SVG, ZIndex))
-> (SVG -> SVG) -> (SVG, ZIndex) -> (SVG, ZIndex)
forall a b. (a -> b) -> a -> b
$ \SVG
svg -> Time -> SVG -> SVG
fn (Time -> Time -> Time -> Time
forall a. Ord a => a -> a -> a -> a
clamp Time
0 Time
1 (Time -> Time) -> Time -> Time
forall a b. (a -> b) -> a -> b
$ (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
tDelta) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
dur) SVG
svg
  Time -> Scene s ()
forall s. Time -> Scene s ()
wait Time
dur
  where
    clamp :: a -> a -> a -> a
clamp a
a a
b a
v
      | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
a = a
a
      | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
b = a
b
      | Bool
otherwise = a
v

-- | Create a new variable and apply it to a sprite.
--
--   Example:
--
-- @
-- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox'
--    v \<- 'spriteVar' s 0 'Reanimate.Svg.Constructors.rotate'
--    'Reanimate.Scene.tweenVar' v 2 $ \\val -> 'Reanimate.fromToS' val 90
-- @
--
--   <<docs/gifs/doc_spriteVar.gif>>
spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a)
spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a)
spriteVar Sprite s
sprite a
def a -> SVG -> SVG
fn = do
  Var s a
v <- a -> Scene s (Var s a)
forall a s. a -> Scene s (Var s a)
newVar a
def
  Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
forall s a. Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
applyVar Var s a
v Sprite s
sprite a -> SVG -> SVG
fn
  return Var s a
v

-- | Apply an effect to a sprite.
--
--   Example:
--
-- @
-- do s <- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
--    'spriteE' s $ 'Reanimate.Effect.overBeginning' 1 'Reanimate.Effect.fadeInE'
--    'spriteE' s $ 'Reanimate.Effect.overEnding' 0.5 'Reanimate.Effect.fadeOutE'
-- @
--
--   <<docs/gifs/doc_spriteE.gif>>
spriteE :: Sprite s -> Effect -> Scene s ()
spriteE :: Sprite s -> Effect -> Scene s ()
spriteE (Sprite Time
born STRef s (Time -> Time)
_tmod STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref) Effect
effect = do
  Time
now <- Scene s Time
forall s. Scene s Time
queryNow
  ST s () -> Scene s ()
forall s a. ST s a -> Scene s a
liftST (ST s () -> Scene s ()) -> ST s () -> Scene s ()
forall a b. (a -> b) -> a -> b
$
    STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> ((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
    -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref (((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
  -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
 -> ST s ())
-> ((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
    -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Time
ttl, ST s (Time -> Time -> SVG -> (SVG, ZIndex))
renderGen) ->
      ( Time
ttl,
        do
          Time -> Time -> SVG -> (SVG, ZIndex)
render <- ST s (Time -> Time -> SVG -> (SVG, ZIndex))
renderGen
          return $ \Time
d Time
t SVG
svg ->
            let (SVG
svg', ZIndex
z) = Time -> Time -> SVG -> (SVG, ZIndex)
render Time
d Time
t SVG
svg
             in (Time -> Effect -> Effect
delayE (Time -> Time -> Time
forall a. Ord a => a -> a -> a
max Time
0 (Time -> Time) -> Time -> Time
forall a b. (a -> b) -> a -> b
$ Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
born) Effect
effect Time
d Time
t SVG
svg', ZIndex
z)
      )

-- | Set new ZIndex of a sprite.
--
--   Example:
--
-- @
-- do s1 \<- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.withFillColor' "blue" $ 'Reanimate.Svg.Constructors.mkCircle' 3
--    'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.withFillColor' "red" $ 'Reanimate.Svg.Constructors.mkRect' 8 3
--    'wait' 1
--    'spriteZ' s1 1
--    'wait' 1
-- @
--
--   <<docs/gifs/doc_spriteZ.gif>>
spriteZ :: Sprite s -> ZIndex -> Scene s ()
spriteZ :: Sprite s -> ZIndex -> Scene s ()
spriteZ (Sprite Time
born STRef s (Time -> Time)
_tmod STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref) ZIndex
zindex = do
  Time
now <- Scene s Time
forall s. Scene s Time
queryNow
  ST s () -> Scene s ()
forall s a. ST s a -> Scene s a
liftST (ST s () -> Scene s ()) -> ST s () -> Scene s ()
forall a b. (a -> b) -> a -> b
$
    STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
-> ((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
    -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
ref (((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
  -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
 -> ST s ())
-> ((Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex)))
    -> (Time, ST s (Time -> Time -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Time
ttl, ST s (Time -> Time -> SVG -> (SVG, ZIndex))
renderGen) ->
      ( Time
ttl,
        do
          Time -> Time -> SVG -> (SVG, ZIndex)
render <- ST s (Time -> Time -> SVG -> (SVG, ZIndex))
renderGen
          return $ \Time
d Time
t SVG
svg ->
            let (SVG
svg', ZIndex
z) = Time -> Time -> SVG -> (SVG, ZIndex)
render Time
d Time
t SVG
svg in (SVG
svg', if Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
now Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
born then ZIndex
z else ZIndex
zindex)
      )

-- | Destroy all local sprites at the end of a scene.
--
--   Example:
--
-- @
-- do -- the rect lives through the entire 3s animation
--    'newSpriteSVG_' $ 'Reanimate.Svg.Constructors.translate' (-3) 0 $ 'Reanimate.Svg.Constructors.mkRect' 4 4
--    'wait' 1
--    'spriteScope' $ do
--      -- the circle only lives for 1 second.
--      local \<- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.translate' 3 0 $ 'Reanimate.Svg.Constructors.mkCircle' 2
--      'spriteE' local $ 'Reanimate.Effect.overBeginning' 0.3 'Reanimate.Effect.fadeInE'
--      'spriteE' local $ 'Reanimate.Effect.overEnding' 0.3 'Reanimate.Effect.fadeOutE'
--      'wait' 1
--    'wait' 1
-- @
--
--   <<docs/gifs/doc_spriteScope.gif>>
spriteScope :: Scene s a -> Scene s a
spriteScope :: Scene s a -> Scene s a
spriteScope (M Time -> ST s (a, Time, Time, [Gen s])
action) = (Time -> ST s (a, Time, Time, [Gen s])) -> Scene s a
forall s a. (Time -> ST s (a, Time, Time, [Gen s])) -> Scene s a
M ((Time -> ST s (a, Time, Time, [Gen s])) -> Scene s a)
-> (Time -> ST s (a, Time, Time, [Gen s])) -> Scene s a
forall a b. (a -> b) -> a -> b
$ \Time
t -> do
  (a
a, Time
s, Time
p, [Gen s]
gens) <- Time -> ST s (a, Time, Time, [Gen s])
action Time
t
  (a, Time, Time, [Gen s]) -> ST s (a, Time, Time, [Gen s])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Time
s, Time
p, (Gen s -> Gen s) -> [Gen s] -> [Gen s]
forall a b. (a -> b) -> [a] -> [b]
map (Time -> Gen s -> Gen s
forall (f :: * -> *) t b p.
(Functor f, Ord t, Num b) =>
t -> f (t -> t -> (SVG, b)) -> f (p -> t -> (SVG, b))
genFn (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time -> Time -> Time
forall a. Ord a => a -> a -> a
max Time
s Time
p)) [Gen s]
gens)
  where
    genFn :: t -> f (t -> t -> (SVG, b)) -> f (p -> t -> (SVG, b))
genFn t
maxT f (t -> t -> (SVG, b))
gen = do
      t -> t -> (SVG, b)
frameGen <- f (t -> t -> (SVG, b))
gen
      return $ \p
_ t
t ->
        if t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
maxT
          then t -> t -> (SVG, b)
frameGen t
maxT t
t
          else (SVG
None, b
0)

asAnimation :: (forall s'. Scene s' a) -> Scene s Animation
asAnimation :: (forall s'. Scene s' a) -> Scene s Animation
asAnimation forall s'. Scene s' a
s = do
  Time
now <- Scene s Time
forall s. Scene s Time
queryNow
  return $ Time -> Animation -> Animation
dropA Time
now ((forall s'. Scene s' a) -> Animation
forall a. (forall s. Scene s a) -> Animation
scene (Time -> Scene s ()
forall s. Time -> Scene s ()
wait Time
now Scene s () -> Scene s a -> Scene s a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scene s a
forall s'. Scene s' a
s))

-- | Apply a transformation with a given overlap. This makes sure
--   to keep timestamps intact such that events can still be timed
--   by transcripts.
transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s ()
transitionO :: Transition
-> Time
-> (forall s'. Scene s' a)
-> (forall s'. Scene s' b)
-> Scene s ()
transitionO Transition
t Time
o forall s'. Scene s' a
a forall s'. Scene s' b
b = do
  Animation
aA <- (forall s'. Scene s' a) -> Scene s Animation
forall a s. (forall s'. Scene s' a) -> Scene s Animation
asAnimation forall s'. Scene s' a
a
  Animation
bA <- Scene s Animation -> Scene s Animation
forall s a. Scene s a -> Scene s a
fork (Scene s Animation -> Scene s Animation)
-> Scene s Animation -> Scene s Animation
forall a b. (a -> b) -> a -> b
$ do
    Time -> Scene s ()
forall s. Time -> Scene s ()
wait (Animation -> Time
duration Animation
aA Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
o)
    (forall s'. Scene s' b) -> Scene s Animation
forall a s. (forall s'. Scene s' a) -> Scene s Animation
asAnimation forall s'. Scene s' b
b
  Animation -> Scene s ()
forall s. Animation -> Scene s ()
play (Animation -> Scene s ()) -> Animation -> Scene s ()
forall a b. (a -> b) -> a -> b
$ Time -> Transition -> Transition
overlapT Time
o Transition
t Animation
aA Animation
bA