{-# 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 (Gen, 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)
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
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 :: 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
data Sprite s = Sprite Time (STRef s (Time -> Time)) (STRef s (Duration, ST s (Duration -> Duration -> Time -> SVG -> (SVG, ZIndex)))) (Gen s)
newtype Frame s a = Frame {Frame s a
-> ST s (Duration -> Duration -> Duration -> Duration -> a)
unFrame :: ST s (Duration -> 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 (Duration -> Duration -> Duration -> Duration -> a)
gen) = ST s (Duration -> Duration -> Duration -> Duration -> b)
-> Frame s b
forall s a.
ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
Frame (ST s (Duration -> Duration -> Duration -> Duration -> b)
-> Frame s b)
-> ST s (Duration -> Duration -> Duration -> Duration -> b)
-> Frame s b
forall a b. (a -> b) -> a -> b
$ do
Duration -> Duration -> Duration -> Duration -> a
m <- ST s (Duration -> Duration -> Duration -> Duration -> a)
gen
return (\Duration
scene_d Duration
real_t Duration
d Duration
t -> a -> b
fn (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Duration -> Duration -> Duration -> Duration -> a
m Duration
scene_d Duration
real_t Duration
d Duration
t)
instance Applicative (Frame s) where
pure :: a -> Frame s a
pure a
v = ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
forall s a.
ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
Frame (ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a)
-> ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
forall a b. (a -> b) -> a -> b
$ (Duration -> Duration -> Duration -> Duration -> a)
-> ST s (Duration -> Duration -> Duration -> Duration -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Duration
_ Duration
_ Duration
_ Duration
_ -> a
v)
Frame ST s (Duration -> Duration -> Duration -> Duration -> a -> b)
f <*> :: Frame s (a -> b) -> Frame s a -> Frame s b
<*> Frame ST s (Duration -> Duration -> Duration -> Duration -> a)
g = ST s (Duration -> Duration -> Duration -> Duration -> b)
-> Frame s b
forall s a.
ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
Frame (ST s (Duration -> Duration -> Duration -> Duration -> b)
-> Frame s b)
-> ST s (Duration -> Duration -> Duration -> Duration -> b)
-> Frame s b
forall a b. (a -> b) -> a -> b
$ do
Duration -> Duration -> Duration -> Duration -> a -> b
m1 <- ST s (Duration -> Duration -> Duration -> Duration -> a -> b)
f
Duration -> Duration -> Duration -> Duration -> a
m2 <- ST s (Duration -> Duration -> Duration -> Duration -> a)
g
return $ \Duration
scene_d Duration
real_t Duration
d Duration
t -> Duration -> Duration -> Duration -> Duration -> a -> b
m1 Duration
scene_d Duration
real_t Duration
d Duration
t (Duration -> Duration -> Duration -> Duration -> a
m2 Duration
scene_d Duration
real_t Duration
d Duration
t)
unVar :: Var s a -> Frame s a
unVar :: Var s a -> Frame s a
unVar Var s a
var = ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
forall s a.
ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
Frame (ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a)
-> ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
forall a b. (a -> b) -> a -> b
$ do
Duration -> a
fn <- Var s a -> ST s (Duration -> a)
forall s a. Var s a -> ST s (Duration -> a)
unpackVar Var s a
var
return $ \Duration
_scene_d Duration
real_t Duration
_d Duration
_t -> Duration -> a
fn Duration
real_t
spriteT :: Frame s Time
spriteT :: Frame s Duration
spriteT = ST s (Duration -> Duration -> Duration -> Duration -> Duration)
-> Frame s Duration
forall s a.
ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
Frame (ST s (Duration -> Duration -> Duration -> Duration -> Duration)
-> Frame s Duration)
-> ST s (Duration -> Duration -> Duration -> Duration -> Duration)
-> Frame s Duration
forall a b. (a -> b) -> a -> b
$ (Duration -> Duration -> Duration -> Duration -> Duration)
-> ST s (Duration -> Duration -> Duration -> Duration -> Duration)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Duration
_scene_d Duration
_real_t Duration
_d Duration
t -> Duration
t)
spriteDuration :: Frame s Duration
spriteDuration :: Frame s Duration
spriteDuration = ST s (Duration -> Duration -> Duration -> Duration -> Duration)
-> Frame s Duration
forall s a.
ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
Frame (ST s (Duration -> Duration -> Duration -> Duration -> Duration)
-> Frame s Duration)
-> ST s (Duration -> Duration -> Duration -> Duration -> Duration)
-> Frame s Duration
forall a b. (a -> b) -> a -> b
$ (Duration -> Duration -> Duration -> Duration -> Duration)
-> ST s (Duration -> Duration -> Duration -> Duration -> Duration)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Duration
_scene_d Duration
_real_t Duration
d Duration
_t -> Duration
d)
newSprite :: Frame s SVG -> Scene s (Sprite s)
newSprite :: Frame s SVG -> Scene s (Sprite s)
newSprite Frame s SVG
render = do
Sprite s
s <- Frame s SVG -> Scene s (Sprite s)
forall s. Frame s SVG -> Scene s (Sprite s)
newSpritePart Frame s SVG
render
Sprite s -> Scene s ()
forall s. Sprite s -> Scene s ()
addPartToScene Sprite s
s
return Sprite s
s
newSpritePart :: Frame s SVG -> Scene s (Sprite s)
newSpritePart :: Frame s SVG -> Scene s (Sprite s)
newSpritePart Frame s SVG
render = do
Duration
now <- Scene s Duration
forall s. Scene s Duration
queryNow
STRef s (Duration -> Duration)
tmod <- ST s (STRef s (Duration -> Duration))
-> Scene s (STRef s (Duration -> Duration))
forall s a. ST s a -> Scene s a
liftST (ST s (STRef s (Duration -> Duration))
-> Scene s (STRef s (Duration -> Duration)))
-> ST s (STRef s (Duration -> Duration))
-> Scene s (STRef s (Duration -> Duration))
forall a b. (a -> b) -> a -> b
$ (Duration -> Duration) -> ST s (STRef s (Duration -> Duration))
forall a s. a -> ST s (STRef s a)
newSTRef Duration -> Duration
forall a. a -> a
id
STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref <- ST
s
(STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> Scene
s
(STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
forall s a. ST s a -> Scene s a
liftST (ST
s
(STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> Scene
s
(STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))))
-> ST
s
(STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> Scene
s
(STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
forall a b. (a -> b) -> a -> b
$ (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> ST
s
(STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
forall a s. a -> ST s (STRef s a)
newSTRef (-Duration
1, (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
-> ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
-> ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
-> ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
forall a b. (a -> b) -> a -> b
$ \Duration
_ad Duration
_d Duration
_t SVG
svg -> (SVG
svg, ZIndex
0))
return $ Duration
-> STRef s (Duration -> Duration)
-> STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> Gen s
-> Sprite s
forall s.
Duration
-> STRef s (Duration -> Duration)
-> STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> Gen s
-> Sprite s
Sprite Duration
now STRef s (Duration -> Duration)
tmod STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref (Gen s -> Sprite s) -> Gen s -> Sprite s
forall a b. (a -> b) -> a -> b
$ do
Duration -> Duration -> Duration -> Duration -> SVG
fn <- Frame s SVG
-> ST s (Duration -> Duration -> Duration -> Duration -> SVG)
forall s a.
Frame s a
-> ST s (Duration -> Duration -> Duration -> Duration -> a)
unFrame Frame s SVG
render
Duration -> Duration
time_fn <- STRef s (Duration -> Duration) -> ST s (Duration -> Duration)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Duration -> Duration)
tmod
(Duration
spriteDur, ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
spriteEffectGen) <- STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> ST
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
forall s a. STRef s a -> ST s a
readSTRef STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref
Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)
spriteEffect <- ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
spriteEffectGen
return $ \Duration
absD Duration
absT_ ->
let absT :: Duration
absT = Duration -> Duration
time_fn Duration
absT_
relD :: Duration
relD = (if Duration
spriteDur Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
< Duration
0 then Duration
absD else Duration
spriteDur) Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
now
relT :: Duration
relT = Duration
absT Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
now
inTimeSlice :: Bool
inTimeSlice = Duration
relT Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
>= Duration
0 Bool -> Bool -> Bool
&& Duration
relT Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
< Duration
relD
isLastFrame :: Bool
isLastFrame = Duration
absD Duration -> Duration -> Bool
forall a. Eq a => a -> a -> Bool
== Duration
absT Bool -> Bool -> Bool
&& Duration
relT Duration -> Duration -> Bool
forall a. Eq a => a -> a -> Bool
== Duration
relD
in if Bool
inTimeSlice Bool -> Bool -> Bool
|| Bool
isLastFrame
then Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)
spriteEffect Duration
absD Duration
relD Duration
relT (Duration -> Duration -> Duration -> Duration -> SVG
fn Duration
absD Duration
absT Duration
relD Duration
relT)
else (SVG
None, ZIndex
0)
addPartToScene :: Sprite s -> Scene s ()
addPartToScene :: Sprite s -> Scene s ()
addPartToScene (Sprite Duration
_ STRef s (Duration -> Duration)
_ STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
_ Gen s
gen) = Gen s -> Scene s ()
forall s. Gen s -> Scene s ()
addGen Gen s
gen
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
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
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 -> Duration -> Duration -> SVG
getAnimationFrame Sync
sync Animation
animation (Duration -> Duration -> SVG)
-> Frame s Duration -> Frame s (Duration -> SVG)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Frame s Duration
forall s. Frame s Duration
spriteT Frame s (Duration -> SVG) -> Frame s Duration -> Frame s SVG
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Frame s Duration
forall s. Frame s Duration
spriteDuration)
Scene s (Sprite s) -> Scene s () -> Scene s (Sprite s)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Duration -> Scene s ()
forall s. Duration -> Scene s ()
wait (Animation -> Duration
duration Animation
animation)
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
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
renderSprite :: Sprite s -> Frame s SVG
renderSprite :: Sprite s -> Frame s SVG
renderSprite (Sprite Duration
_ STRef s (Duration -> Duration)
_ STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
_ Gen s
gen) =
ST s (Duration -> Duration -> Duration -> Duration -> SVG)
-> Frame s SVG
forall s a.
ST s (Duration -> Duration -> Duration -> Duration -> a)
-> Frame s a
Frame (ST s (Duration -> Duration -> Duration -> Duration -> SVG)
-> Frame s SVG)
-> ST s (Duration -> Duration -> Duration -> Duration -> SVG)
-> Frame s SVG
forall a b. (a -> b) -> a -> b
$ do
Duration -> Duration -> (SVG, ZIndex)
genFn <- Gen s
gen
return (\Duration
absD Duration
absT Duration
_ Duration
_ -> (SVG, ZIndex) -> SVG
forall a b. (a, b) -> a
fst ((SVG, ZIndex) -> SVG) -> (SVG, ZIndex) -> SVG
forall a b. (a -> b) -> a -> b
$ Duration -> Duration -> (SVG, ZIndex)
genFn Duration
absD Duration
absT)
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
destroySprite :: Sprite s -> Scene s ()
destroySprite :: Sprite s -> Scene s ()
destroySprite (Sprite Duration
_ STRef s (Duration -> Duration)
_tmod STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref Gen s
_) = do
Duration
now <- Scene s Duration
forall s. Scene s Duration
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
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> ((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref (((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ())
-> ((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Duration
ttl, ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
render) ->
(if Duration
ttl Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
< Duration
0 then Duration
now else Duration -> Duration -> Duration
forall a. Ord a => a -> a -> a
min Duration
ttl Duration
now, ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
render)
spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
spriteModify (Sprite Duration
born STRef s (Duration -> Duration)
_tmod STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref Gen s
_) 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
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> ((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref (((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ())
-> ((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Duration
ttl, ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
renderGen) ->
( Duration
ttl,
do
Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)
render <- ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
renderGen
Duration
-> Duration
-> Duration
-> Duration
-> (SVG, ZIndex)
-> (SVG, ZIndex)
modRender <- Frame s ((SVG, ZIndex) -> (SVG, ZIndex))
-> ST
s
(Duration
-> Duration
-> Duration
-> Duration
-> (SVG, ZIndex)
-> (SVG, ZIndex))
forall s a.
Frame s a
-> ST s (Duration -> Duration -> Duration -> Duration -> a)
unFrame Frame s ((SVG, ZIndex) -> (SVG, ZIndex))
modFn
return $ \Duration
absD Duration
relD Duration
relT ->
let absT :: Duration
absT = Duration
relT Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
+ Duration
born in Duration
-> Duration
-> Duration
-> Duration
-> (SVG, ZIndex)
-> (SVG, ZIndex)
modRender Duration
absD Duration
absT Duration
relD Duration
relT ((SVG, ZIndex) -> (SVG, ZIndex))
-> (SVG -> (SVG, ZIndex)) -> SVG -> (SVG, ZIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)
render Duration
absD Duration
relD Duration
relT
)
signalS :: Sprite s -> Duration -> Signal -> Scene s ()
signalS :: Sprite s -> Duration -> (Duration -> Duration) -> Scene s ()
signalS (Sprite Duration
_born STRef s (Duration -> Duration)
tmod STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
_ref Gen s
_) Duration
dur Duration -> Duration
signal = do
Duration
now <- Scene s Duration
forall s. Scene s Duration
queryNow
let modify_t :: Duration -> Duration
modify_t Duration
t
| Duration
t Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
< Duration
now = Duration
t
| Duration
t Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
> Duration
nowDuration -> Duration -> Duration
forall a. Num a => a -> a -> a
+Duration
dur = Duration
t
| Bool
otherwise = Duration
now Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
+ Duration -> Duration
signal ((Duration
tDuration -> Duration -> Duration
forall a. Num a => a -> a -> a
-Duration
now) Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
dur) Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Duration
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 (Duration -> Duration)
-> ((Duration -> Duration) -> Duration -> Duration) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (Duration -> Duration)
tmod (((Duration -> Duration) -> Duration -> Duration) -> ST s ())
-> ((Duration -> Duration) -> Duration -> Duration) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Duration -> Duration
fn -> Duration -> Duration
modify_t (Duration -> Duration)
-> (Duration -> Duration) -> Duration -> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Duration
fn
spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
spriteMap sprite :: Sprite s
sprite@(Sprite Duration
born STRef s (Duration -> Duration)
_ STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
_ Gen s
_) SVG -> SVG
fn = do
Duration
now <- Scene s Duration
forall s. Scene s Duration
queryNow
let tDelta :: Duration
tDelta = Duration
now Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
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
Duration
t <- Frame s Duration
forall s. Frame s Duration
spriteT
return $ \(SVG
svg, ZIndex
zindex) -> (if (Duration
t Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
tDelta) Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
< Duration
0 then SVG
svg else SVG -> SVG
fn SVG
svg, ZIndex
zindex)
spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
spriteTween :: Sprite s -> Duration -> (Duration -> SVG -> SVG) -> Scene s ()
spriteTween sprite :: Sprite s
sprite@(Sprite Duration
born STRef s (Duration -> Duration)
_ STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
_ Gen s
_) Duration
dur Duration -> SVG -> SVG
fn = do
Duration
now <- Scene s Duration
forall s. Scene s Duration
queryNow
let tDelta :: Duration
tDelta = Duration
now Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
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
Duration
t <- Frame s Duration
forall s. Frame s Duration
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 -> Duration -> SVG -> SVG
fn (Duration -> Duration -> Duration -> Duration
forall a. Ord a => a -> a -> a -> a
clamp Duration
0 Duration
1 (Duration -> Duration) -> Duration -> Duration
forall a b. (a -> b) -> a -> b
$ (Duration
t Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
tDelta) Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
dur) SVG
svg
Duration -> Scene s ()
forall s. Duration -> Scene s ()
wait Duration
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
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
spriteE :: Sprite s -> Effect -> Scene s ()
spriteE :: Sprite s -> Effect -> Scene s ()
spriteE (Sprite Duration
born STRef s (Duration -> Duration)
_tmod STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref Gen s
_) Effect
effect = do
Duration
now <- Scene s Duration
forall s. Scene s Duration
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
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> ((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref (((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ())
-> ((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Duration
ttl, ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
renderGen) ->
( Duration
ttl,
do
Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)
render <- ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
renderGen
return $ \Duration
ad Duration
d Duration
t SVG
svg ->
let (SVG
svg', ZIndex
z) = Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)
render Duration
ad Duration
d Duration
t SVG
svg
in (Duration -> Effect -> Effect
delayE (Duration -> Duration -> Duration
forall a. Ord a => a -> a -> a
max Duration
0 (Duration -> Duration) -> Duration -> Duration
forall a b. (a -> b) -> a -> b
$ Duration
now Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
born) Effect
effect Duration
d Duration
t SVG
svg', ZIndex
z)
)
spriteZ :: Sprite s -> ZIndex -> Scene s ()
spriteZ :: Sprite s -> ZIndex -> Scene s ()
spriteZ (Sprite Duration
born STRef s (Duration -> Duration)
_tmod STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref Gen s
_) ZIndex
zindex = do
Duration
now <- Scene s Duration
forall s. Scene s Duration
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
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> ((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef
s
(Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
ref (((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ())
-> ((Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)))
-> (Duration,
ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))))
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Duration
ttl, ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
renderGen) ->
( Duration
ttl,
do
Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)
render <- ST s (Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex))
renderGen
return $ \Duration
ad Duration
d Duration
t SVG
svg ->
let (SVG
svg', ZIndex
z) = Duration -> Duration -> Duration -> SVG -> (SVG, ZIndex)
render Duration
ad Duration
d Duration
t SVG
svg in (SVG
svg', if Duration
t Duration -> Duration -> Bool
forall a. Ord a => a -> a -> Bool
< Duration
now Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
born then ZIndex
z else ZIndex
zindex)
)
spriteScope :: Scene s a -> Scene s a
spriteScope :: Scene s a -> Scene s a
spriteScope (M Duration -> ST s (a, Duration, Duration, [Gen s])
action) = (Duration -> ST s (a, Duration, Duration, [Gen s])) -> Scene s a
forall s a.
(Duration -> ST s (a, Duration, Duration, [Gen s])) -> Scene s a
M ((Duration -> ST s (a, Duration, Duration, [Gen s])) -> Scene s a)
-> (Duration -> ST s (a, Duration, Duration, [Gen s])) -> Scene s a
forall a b. (a -> b) -> a -> b
$ \Duration
t -> do
(a
a, Duration
s, Duration
p, [Gen s]
gens) <- Duration -> ST s (a, Duration, Duration, [Gen s])
action Duration
t
(a, Duration, Duration, [Gen s])
-> ST s (a, Duration, Duration, [Gen s])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Duration
s, Duration
p, (Gen s -> Gen s) -> [Gen s] -> [Gen s]
forall a b. (a -> b) -> [a] -> [b]
map (Duration -> 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 (Duration
t Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
+ Duration -> Duration -> Duration
forall a. Ord a => a -> a -> a
max Duration
s Duration
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
Duration
now <- Scene s Duration
forall s. Scene s Duration
queryNow
return $ Duration -> Animation -> Animation
dropA Duration
now ((forall s'. Scene s' a) -> Animation
forall a. (forall s. Scene s a) -> Animation
scene (Duration -> Scene s ()
forall s. Duration -> Scene s ()
wait Duration
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))
transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s ()
transitionO :: Transition
-> Duration
-> (forall s'. Scene s' a)
-> (forall s'. Scene s' b)
-> Scene s ()
transitionO Transition
t Duration
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
Duration -> Scene s ()
forall s. Duration -> Scene s ()
wait (Animation -> Duration
duration Animation
aA Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Duration
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
$ Duration -> Transition -> Transition
overlapT Duration
o Transition
t Animation
aA Animation
bA