{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Reanimate.Scene.Var where
import Control.Monad.ST (ST)
import qualified Data.Map as M
import Data.STRef (STRef, modifySTRef, newSTRef, readSTRef)
import Reanimate.Animation (Duration, Time)
import Reanimate.Scene.Core (Scene, liftST, queryNow, wait)
newtype Var s a = Var (STRef s (VarData a))
data VarData a = VarData
{ VarData a -> a
evarDefault :: a,
VarData a -> Timeline a
evarTimeline :: Timeline a,
VarData a -> Maybe Time
evarLastTime :: Maybe Time,
VarData a -> a
evarLastValue :: a
}
data Modifier a = StaticValue a | TweenValue Duration (a -> Time -> a)
type Timeline a = M.Map Time (Modifier a)
newVar :: a -> Scene s (Var s a)
newVar :: a -> Scene s (Var s a)
newVar a
def = STRef s (VarData a) -> Var s a
forall s a. STRef s (VarData a) -> Var s a
Var (STRef s (VarData a) -> Var s a)
-> Scene s (STRef s (VarData a)) -> Scene s (Var s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ST s (STRef s (VarData a)) -> Scene s (STRef s (VarData a))
forall s a. ST s a -> Scene s a
liftST (VarData a -> ST s (STRef s (VarData a))
forall a s. a -> ST s (STRef s a)
newSTRef (VarData a -> ST s (STRef s (VarData a)))
-> VarData a -> ST s (STRef s (VarData a))
forall a b. (a -> b) -> a -> b
$ a -> Timeline a -> Maybe Time -> a -> VarData a
forall a. a -> Timeline a -> Maybe Time -> a -> VarData a
VarData a
def Timeline a
forall k a. Map k a
M.empty Maybe Time
forall a. Maybe a
Nothing a
def)
readVar :: Var s a -> Scene s a
readVar :: Var s a -> Scene s a
readVar (Var STRef s (VarData a)
ref) = VarData a -> Time -> a
forall a. VarData a -> Time -> a
readVarData (VarData a -> Time -> a)
-> Scene s (VarData a) -> Scene s (Time -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ST s (VarData a) -> Scene s (VarData a)
forall s a. ST s a -> Scene s a
liftST (STRef s (VarData a) -> ST s (VarData a)
forall s a. STRef s a -> ST s a
readSTRef STRef s (VarData a)
ref) Scene s (Time -> a) -> Scene s Time -> Scene s a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Scene s Time
forall s. Scene s Time
queryNow
unpackVar :: Var s a -> ST s (Time -> a)
unpackVar :: Var s a -> ST s (Time -> a)
unpackVar (Var STRef s (VarData a)
ref) = VarData a -> Time -> a
forall a. VarData a -> Time -> a
readVarData (VarData a -> Time -> a) -> ST s (VarData a) -> ST s (Time -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s (VarData a) -> ST s (VarData a)
forall s a. STRef s a -> ST s a
readSTRef STRef s (VarData a)
ref
writeVar :: Var s a -> a -> Scene s ()
writeVar :: Var s a -> a -> Scene s ()
writeVar (Var STRef s (VarData a)
ref) a
val = 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 (VarData a) -> (VarData a -> VarData a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (VarData a)
ref ((VarData a -> VarData a) -> ST s ())
-> (VarData a -> VarData a) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Time -> a -> VarData a -> VarData a
forall a. Time -> a -> VarData a -> VarData a
writeVarData Time
now a
val
modifyVar :: Var s a -> (a -> a) -> Scene s ()
modifyVar :: Var s a -> (a -> a) -> Scene s ()
modifyVar (Var STRef s (VarData a)
ref) a -> a
fn = 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 (VarData a) -> (VarData a -> VarData a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (VarData a)
ref ((VarData a -> VarData a) -> ST s ())
-> (VarData a -> VarData a) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Time -> (a -> a) -> VarData a -> VarData a
forall a. Time -> (a -> a) -> VarData a -> VarData a
modifyVarData Time
now a -> a
fn
tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
tweenVar :: Var s a -> Time -> (a -> Time -> a) -> Scene s ()
tweenVar Var s a
_ Time
dur a -> Time -> a
_ | Time
dur Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0 = [Char] -> Scene s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Reanimate.tweenVar: durations must be non-negative"
tweenVar (Var STRef s (VarData a)
ref) Time
dur a -> Time -> a
fn = 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 (VarData a) -> (VarData a -> VarData a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (VarData a)
ref ((VarData a -> VarData a) -> ST s ())
-> (VarData a -> VarData a) -> ST s ()
forall a b. (a -> b) -> a -> b
$ Time -> Time -> (a -> Time -> a) -> VarData a -> VarData a
forall a.
Time -> Time -> (a -> Time -> a) -> VarData a -> VarData a
tweenVarData Time
now Time
dur a -> Time -> a
fn
Time -> Scene s ()
forall s. Time -> Scene s ()
wait Time
dur
readVarData :: VarData a -> Time -> a
readVarData :: VarData a -> Time -> a
readVarData (VarData a
def Timeline a
_ Maybe Time
Nothing a
_) Time
_ = a
def
readVarData (VarData a
def Timeline a
timeline (Just Time
lastTime) a
lastValue) Time
now
| Time
now Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
lastTime = Timeline a -> a -> Time -> a
forall a. Timeline a -> a -> Time -> a
lookupTimeline Timeline a
timeline a
def Time
now
| Bool
otherwise = a
lastValue
lookupTimeline :: Timeline a -> a -> Time -> a
lookupTimeline :: Timeline a -> a -> Time -> a
lookupTimeline Timeline a
timeline a
def Time
now = case Time -> Timeline a -> Maybe (Time, Modifier a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
M.lookupLE Time
now Timeline a
timeline of
Just (Time
_, StaticValue a
sVal) -> a
sVal
Just (Time
t, TweenValue Time
dur a -> Time -> a
f)
| Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dur Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
now -> a -> Time -> a
f a
def Time
now
Maybe (Time, Modifier a)
_ -> a
def
writeVarData :: Time -> a -> VarData a -> VarData a
writeVarData :: Time -> a -> VarData a -> VarData a
writeVarData Time
now a
x VarData a
var =
let before :: VarData a
before = Time -> VarData a -> VarData a
forall a. Time -> VarData a -> VarData a
keepBefore Time
now VarData a
var
after :: VarData a
after = a -> Timeline a -> Maybe Time -> a -> VarData a
forall a. a -> Timeline a -> Maybe Time -> a -> VarData a
VarData (VarData a -> a
forall a. VarData a -> a
evarDefault VarData a
var) Timeline a
forall k a. Map k a
M.empty (Time -> Maybe Time
forall a. a -> Maybe a
Just Time
now) a
x
in VarData a
after VarData a -> VarData a -> VarData a
forall a. VarData a -> VarData a -> VarData a
`elseVar` VarData a
before
modifyVarData :: Time -> (a -> a) -> VarData a -> VarData a
modifyVarData :: Time -> (a -> a) -> VarData a -> VarData a
modifyVarData Time
now a -> a
fn VarData a
var =
let before :: VarData a
before = Time -> VarData a -> VarData a
forall a. Time -> VarData a -> VarData a
keepBefore Time
now VarData a
var
after :: VarData a
after = Time -> VarData a -> VarData a
forall a. Time -> VarData a -> VarData a
keepFrom Time
now VarData a
var
timeline :: Map Time (Modifier a)
timeline = ((Modifier a -> Modifier a)
-> Map Time (Modifier a) -> Map Time (Modifier a))
-> Map Time (Modifier a)
-> (Modifier a -> Modifier a)
-> Map Time (Modifier a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Modifier a -> Modifier a)
-> Map Time (Modifier a) -> Map Time (Modifier a)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (VarData a -> Map Time (Modifier a)
forall a. VarData a -> Timeline a
evarTimeline VarData a
after) ((Modifier a -> Modifier a) -> Map Time (Modifier a))
-> (Modifier a -> Modifier a) -> Map Time (Modifier a)
forall a b. (a -> b) -> a -> b
$ \case
StaticValue a
s -> a -> Modifier a
forall a. a -> Modifier a
StaticValue (a -> Modifier a) -> a -> Modifier a
forall a b. (a -> b) -> a -> b
$ a -> a
fn a
s
TweenValue Time
dur a -> Time -> a
f -> Time -> (a -> Time -> a) -> Modifier a
forall a. Time -> (a -> Time -> a) -> Modifier a
TweenValue Time
dur ((a -> Time -> a) -> Modifier a) -> (a -> Time -> a) -> Modifier a
forall a b. (a -> b) -> a -> b
$ \a
a Time
t -> a -> a
fn (a -> Time -> a
f a
a Time
t)
in VarData a
after {evarTimeline :: Map Time (Modifier a)
evarTimeline = Map Time (Modifier a)
timeline, evarLastValue :: a
evarLastValue = a -> a
fn (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ VarData a -> a
forall a. VarData a -> a
evarLastValue VarData a
after} VarData a -> VarData a -> VarData a
forall a. VarData a -> VarData a -> VarData a
`elseVar` VarData a
before
tweenVarData :: Time -> Duration -> (a -> Time -> a) -> VarData a -> VarData a
tweenVarData :: Time -> Time -> (a -> Time -> a) -> VarData a -> VarData a
tweenVarData Time
st Time
dur a -> Time -> a
fn var :: VarData a
var@VarData {a
Maybe Time
Timeline a
evarLastValue :: a
evarLastTime :: Maybe Time
evarTimeline :: Timeline a
evarDefault :: a
evarLastValue :: forall a. VarData a -> a
evarLastTime :: forall a. VarData a -> Maybe Time
evarTimeline :: forall a. VarData a -> Timeline a
evarDefault :: forall a. VarData a -> a
..} =
let nd :: Time
nd = Time
st Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dur
before :: VarData a
before = Time -> VarData a -> VarData a
forall a. Time -> VarData a -> VarData a
keepBefore Time
st VarData a
var
during :: VarData a
during = Maybe Time -> Maybe Time -> VarData a -> VarData a
forall a. Maybe Time -> Maybe Time -> VarData a -> VarData a
keepInRange (Time -> Maybe Time
forall a. a -> Maybe a
Just Time
st) (Time -> Maybe Time
forall a. a -> Maybe a
Just Time
nd) VarData a
var
tweenFn :: a -> Time -> a
tweenFn a
a Time
t =
let idx :: Time
idx = (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
st) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
dur
idx' :: Time
idx' = if Time -> Bool
forall a. RealFloat a => a -> Bool
isNaN Time
idx then Time
1 else Time
idx
in a -> Time -> a
fn (VarData a -> Time -> a
forall a. VarData a -> Time -> a
readVarData (VarData a
during {evarDefault :: a
evarDefault = a
a}) Time
t) Time
idx'
valueTweenEnd :: a
valueTweenEnd = a -> Time -> a
tweenFn a
evarDefault Time
nd
after :: VarData a
after = a -> Timeline a -> Maybe Time -> a -> VarData a
forall a. a -> Timeline a -> Maybe Time -> a -> VarData a
VarData a
evarDefault (Time -> Modifier a -> Timeline a
forall k a. k -> a -> Map k a
M.singleton Time
st (Modifier a -> Timeline a) -> Modifier a -> Timeline a
forall a b. (a -> b) -> a -> b
$ Time -> (a -> Time -> a) -> Modifier a
forall a. Time -> (a -> Time -> a) -> Modifier a
TweenValue Time
dur a -> Time -> a
tweenFn) (Time -> Maybe Time
forall a. a -> Maybe a
Just Time
nd) a
valueTweenEnd
in VarData a
after VarData a -> VarData a -> VarData a
forall a. VarData a -> VarData a -> VarData a
`elseVar` VarData a
before
elseVar :: VarData a -> VarData a -> VarData a
elseVar :: VarData a -> VarData a -> VarData a
elseVar VarData a
var1 VarData a
var2
| Just Time
t <- VarData a -> Maybe Time
forall a. VarData a -> Maybe Time
evarLastTime VarData a
var1 =
let afterTimeline :: Timeline a
afterTimeline = VarData a -> Timeline a
forall a. VarData a -> Timeline a
evarTimeline VarData a
var1
joinAt :: Time
joinAt = Time
-> ((Time, Modifier a) -> Time) -> Maybe (Time, Modifier a) -> Time
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Time
t (Time, Modifier a) -> Time
forall a b. (a, b) -> a
fst (Maybe (Time, Modifier a) -> Time)
-> Maybe (Time, Modifier a) -> Time
forall a b. (a -> b) -> a -> b
$ Timeline a -> Maybe (Time, Modifier a)
forall k a. Map k a -> Maybe (k, a)
M.lookupMin Timeline a
afterTimeline
beforeTimeline :: Timeline a
beforeTimeline = case Time -> VarData a -> VarData a
forall a. Time -> VarData a -> VarData a
keepBefore Time
joinAt VarData a
var2 of
VarData a
x
| Just Time
lastTime <- VarData a -> Maybe Time
forall a. VarData a -> Maybe Time
evarLastTime VarData a
x, Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
joinAt -> Time -> Modifier a -> Timeline a -> Timeline a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Time
lastTime (a -> Modifier a
forall a. a -> Modifier a
StaticValue (a -> Modifier a) -> a -> Modifier a
forall a b. (a -> b) -> a -> b
$ VarData a -> a
forall a. VarData a -> a
evarLastValue VarData a
x) (Timeline a -> Timeline a) -> Timeline a -> Timeline a
forall a b. (a -> b) -> a -> b
$ VarData a -> Timeline a
forall a. VarData a -> Timeline a
evarTimeline VarData a
x
| Bool
otherwise -> VarData a -> Timeline a
forall a. VarData a -> Timeline a
evarTimeline VarData a
x
in VarData a
var1 {evarTimeline :: Timeline a
evarTimeline = Timeline a -> Timeline a -> Timeline a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Timeline a
afterTimeline Timeline a
beforeTimeline}
| Bool
otherwise = VarData a
var2
keepInRange :: Maybe Time -> Maybe Time -> VarData a -> VarData a
keepInRange :: Maybe Time -> Maybe Time -> VarData a -> VarData a
keepInRange Maybe Time
st Maybe Time
nd = (VarData a -> VarData a)
-> (Time -> VarData a -> VarData a)
-> Maybe Time
-> VarData a
-> VarData a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VarData a -> VarData a
forall a. a -> a
id Time -> VarData a -> VarData a
forall a. Time -> VarData a -> VarData a
keepFrom Maybe Time
st (VarData a -> VarData a)
-> (VarData a -> VarData a) -> VarData a -> VarData a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarData a -> VarData a)
-> (Time -> VarData a -> VarData a)
-> Maybe Time
-> VarData a
-> VarData a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe VarData a -> VarData a
forall a. a -> a
id Time -> VarData a -> VarData a
forall a. Time -> VarData a -> VarData a
keepBefore Maybe Time
nd
keepFrom :: Time -> VarData a -> VarData a
keepFrom :: Time -> VarData a -> VarData a
keepFrom Time
st VarData {a
Maybe Time
Timeline a
evarLastValue :: a
evarLastTime :: Maybe Time
evarTimeline :: Timeline a
evarDefault :: a
evarLastValue :: forall a. VarData a -> a
evarLastTime :: forall a. VarData a -> Maybe Time
evarTimeline :: forall a. VarData a -> Timeline a
evarDefault :: forall a. VarData a -> a
..} =
let timeline' :: Timeline a
timeline' = (Time -> Bool) -> Timeline a -> Timeline a
forall k a. (k -> Bool) -> Map k a -> Map k a
M.dropWhileAntitone (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
st) Timeline a
evarTimeline
timeline'' :: Timeline a
timeline'' = case Time -> Timeline a -> Maybe (Time, Modifier a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
M.lookupLE Time
st Timeline a
evarTimeline of
Just (Time
t, val :: Modifier a
val@(StaticValue a
_))
| Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
st -> Time -> Modifier a -> Timeline a -> Timeline a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Time
st Modifier a
val Timeline a
timeline'
Just (Time
t, TweenValue Time
dur a -> Time -> a
fn)
| Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
st, Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dur Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
st -> Time -> Modifier a -> Timeline a -> Timeline a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Time
st (Time -> (a -> Time -> a) -> Modifier a
forall a. Time -> (a -> Time -> a) -> Modifier a
TweenValue (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dur Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
st) a -> Time -> a
fn) Timeline a
timeline'
Maybe (Time, Modifier a)
_ -> Timeline a
timeline'
in a -> Timeline a -> Maybe Time -> a -> VarData a
forall a. a -> Timeline a -> Maybe Time -> a -> VarData a
VarData a
evarDefault Timeline a
timeline'' (Maybe Time -> Maybe Time -> Maybe Time
forall a. Ord a => a -> a -> a
max Maybe Time
evarLastTime (Maybe Time -> Maybe Time) -> Maybe Time -> Maybe Time
forall a b. (a -> b) -> a -> b
$ Time -> Maybe Time
forall a. a -> Maybe a
Just Time
st) a
evarLastValue
keepBefore :: Time -> VarData a -> VarData a
keepBefore :: Time -> VarData a -> VarData a
keepBefore Time
nd var :: VarData a
var@VarData {a
Maybe Time
Timeline a
evarLastValue :: a
evarLastTime :: Maybe Time
evarTimeline :: Timeline a
evarDefault :: a
evarLastValue :: forall a. VarData a -> a
evarLastTime :: forall a. VarData a -> Maybe Time
evarTimeline :: forall a. VarData a -> Timeline a
evarDefault :: forall a. VarData a -> a
..} =
let timeline' :: Timeline a
timeline' = (Time -> Bool) -> Timeline a -> Timeline a
forall k a. (k -> Bool) -> Map k a -> Map k a
M.takeWhileAntitone (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
nd) Timeline a
evarTimeline
lastModifier :: Maybe (Time, Modifier a)
lastModifier = Timeline a -> Maybe (Time, Modifier a)
forall k a. Map k a -> Maybe (k, a)
M.lookupMax Timeline a
timeline'
timeline'' :: Timeline a
timeline'' = case Maybe (Time, Modifier a)
lastModifier of
Just (Time
t, TweenValue Time
dur a -> Time -> a
fn)
| Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dur Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
nd -> Time -> Modifier a -> Timeline a -> Timeline a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Time
t (Time -> (a -> Time -> a) -> Modifier a
forall a. Time -> (a -> Time -> a) -> Modifier a
TweenValue (Time
nd Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
t) a -> Time -> a
fn) Timeline a
timeline'
Maybe (Time, Modifier a)
_ -> Timeline a
timeline'
lastTime :: Maybe Time
lastTime = case Maybe (Time, Modifier a)
lastModifier of
Just (Time
t, TweenValue Time
dur a -> Time -> a
_) -> Time -> Maybe Time
forall a. a -> Maybe a
Just (Time -> Maybe Time) -> Time -> Maybe Time
forall a b. (a -> b) -> a -> b
$ Time -> Time -> Time
forall a. Ord a => a -> a -> a
min Time
nd (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
dur)
Maybe (Time, Modifier a)
_ -> Time -> Time -> Time
forall a. Ord a => a -> a -> a
min Time
nd (Time -> Time) -> Maybe Time -> Maybe Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Time
evarLastTime
in a -> Timeline a -> Maybe Time -> a -> VarData a
forall a. a -> Timeline a -> Maybe Time -> a -> VarData a
VarData a
evarDefault Timeline a
timeline'' Maybe Time
lastTime (a -> (Time -> a) -> Maybe Time -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
evarDefault (VarData a -> Time -> a
forall a. VarData a -> Time -> a
readVarData VarData a
var) Maybe Time
lastTime)