never executed always true always false
1 {-# LANGUAGE LambdaCase #-}
2 {-# LANGUAGE RecordWildCards #-}
3
4 module Reanimate.Scene.Var where
5
6 import Control.Monad.ST (ST)
7 import qualified Data.Map as M
8 import Data.STRef
9 import Reanimate.Animation (Duration, Time)
10 import Reanimate.Scene.Core (Scene, liftST, queryNow, wait)
11
12 -- | Time dependent variable.
13 newtype Var s a = Var (STRef s (VarData a))
14
15 -- Note: We must ensure that upon transforming an VarData,
16 -- 1. evarDefault old == evarDefault new
17 -- 2. isNothing (evarLastTime old) || isJust (evarLastTime new) i.e. once evarLastValue has a Just value,
18 -- it shouldn't be Nothing again.
19 -- 3. isNothing (evarLastTime var) => M.null (evarTimeline var)
20 data VarData a = VarData
21 { evarDefault :: a,
22 evarTimeline :: Timeline a,
23 evarLastTime :: Maybe Time,
24 evarLastValue :: a
25 }
26
27 data Modifier a = StaticValue a | TweenValue Duration (a -> Time -> a)
28
29 type Timeline a = M.Map Time (Modifier a)
30
31 -- | Create a new variable with a default value.
32 -- Variables always have a defined value even if they are read at a timestamp that is
33 -- earlier than when the variable was created. For example:
34 --
35 -- @
36 -- do v \<- 'Reanimate.Scene.fork' ('wait' 10 \>\> 'newVar' 0) -- Create a variable at timestamp '10'.
37 -- 'readVar' v -- Read the variable at timestamp '0'.
38 -- -- The value of the variable will be '0'.
39 -- @
40 newVar :: a -> Scene s (Var s a)
41 newVar def = Var <$> liftST (newSTRef $ VarData def M.empty Nothing def)
42
43 -- | Read the value of a variable at the current timestamp.
44 readVar :: Var s a -> Scene s a
45 readVar (Var ref) = readVarData <$> liftST (readSTRef ref) <*> queryNow
46
47 unpackVar :: Var s a -> ST s (Time -> a)
48 unpackVar (Var ref) = readVarData <$> readSTRef ref
49
50 -- | Write the value of a variable at the current timestamp.
51 --
52 -- Example:
53 --
54 -- @
55 -- do v \<- 'newVar' 0
56 -- 'Reanimate.Scene.newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'Reanimate.Scene.unVar' v
57 -- 'writeVar' v 1; 'wait' 1
58 -- 'writeVar' v 2; 'wait' 1
59 -- 'writeVar' v 3; 'wait' 1
60 -- @
61 --
62 -- <<docs/gifs/doc_writeVar.gif>>
63 writeVar :: Var s a -> a -> Scene s ()
64 writeVar (Var ref) val = do
65 now <- queryNow
66 liftST $ modifySTRef ref $ writeVarData now val
67
68 -- | Modify the value of a variable at the current timestamp and all future timestamps.
69 modifyVar :: Var s a -> (a -> a) -> Scene s ()
70 modifyVar (Var ref) fn = do
71 now <- queryNow
72 liftST $ modifySTRef ref $ modifyVarData now fn
73
74 -- | Modify a variable between @now@ and @now+duration@.
75 tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
76 tweenVar _ dur _ | dur < 0 = error "Reanimate.tweenVar: durations must be non-negative"
77 tweenVar (Var ref) dur fn = do
78 now <- queryNow
79 liftST $ modifySTRef ref $ tweenVarData now dur fn
80 wait dur
81
82 readVarData :: VarData a -> Time -> a
83 readVarData (VarData def _ Nothing _) _ = def
84 readVarData (VarData def timeline (Just lastTime) lastValue) now
85 | now < lastTime = lookupTimeline timeline def now
86 | otherwise = lastValue
87
88 lookupTimeline :: Timeline a -> a -> Time -> a
89 lookupTimeline timeline def now = case M.lookupLE now timeline of
90 Just (_, StaticValue sVal) -> sVal
91 Just (t, TweenValue dur f)
92 | t + dur > now -> f def now
93 _ -> def
94
95 writeVarData :: Time -> a -> VarData a -> VarData a
96 writeVarData now x var =
97 let before = keepBefore now var
98 after = VarData (evarDefault var) M.empty (Just now) x
99 in after `elseVar` before
100
101 modifyVarData :: Time -> (a -> a) -> VarData a -> VarData a
102 modifyVarData now fn var =
103 let before = keepBefore now var
104 after = keepFrom now var
105 timeline = flip M.map (evarTimeline after) $ \case
106 StaticValue s -> StaticValue $ fn s
107 TweenValue dur f -> TweenValue dur $ \a t -> fn (f a t)
108 in after {evarTimeline = timeline, evarLastValue = fn $ evarLastValue after} `elseVar` before
109
110 -- Note: The function passed here takes time on the scale 0 to 1
111 -- while the function in `TweenValue` takes time on an absolute scale.
112 tweenVarData :: Time -> Duration -> (a -> Time -> a) -> VarData a -> VarData a
113 tweenVarData st dur fn var@VarData {..} =
114 let nd = st + dur
115 before = keepBefore st var
116 during = keepInRange (Just st) (Just nd) var
117 tweenFn a t =
118 let idx = (t - st) / dur
119 idx' = if isNaN idx then 1 else idx
120 in fn (readVarData (during {evarDefault = a}) t) idx'
121 valueTweenEnd = tweenFn evarDefault nd -- we'll never use the def here, replace with error?
122 after = VarData evarDefault (M.singleton st $ TweenValue dur tweenFn) (Just nd) valueTweenEnd
123 in after `elseVar` before
124
125 -- Returns the union of two vars such that we use the second var if first var doesn't have a value.
126 -- Assumes both vars have same default value.
127 elseVar :: VarData a -> VarData a -> VarData a
128 elseVar var1 var2
129 | Just t <- evarLastTime var1 =
130 let afterTimeline = evarTimeline var1
131 joinAt = maybe t fst $ M.lookupMin afterTimeline
132 beforeTimeline = case keepBefore joinAt var2 of
133 x
134 | Just lastTime <- evarLastTime x, lastTime < joinAt -> M.insert lastTime (StaticValue $ evarLastValue x) $ evarTimeline x
135 | otherwise -> evarTimeline x
136 in var1 {evarTimeline = M.union afterTimeline beforeTimeline}
137 | otherwise = var2
138
139 -- Restrict a var to a given time interval.
140 keepInRange :: Maybe Time -> Maybe Time -> VarData a -> VarData a
141 keepInRange st nd = maybe id keepFrom st . maybe id keepBefore nd
142
143 -- Restrict a var to start at given timestamp.
144 keepFrom :: Time -> VarData a -> VarData a
145 keepFrom st VarData {..} =
146 let timeline' = M.dropWhileAntitone (< st) evarTimeline
147 -- if there is no modifier in timeline starting at st,
148 -- we must get the modifier that starts before and truncate it to start at st.
149 timeline'' = case M.lookupLE st evarTimeline of
150 Just (t, val@(StaticValue _))
151 | t < st -> M.insert st val timeline'
152 Just (t, TweenValue dur fn)
153 | t < st, t + dur > st -> M.insert st (TweenValue (t + dur - st) fn) timeline'
154 _ -> timeline'
155 in VarData evarDefault timeline'' (max evarLastTime $ Just st) evarLastValue
156
157 -- Restrict a var to end(clamp) at given timestamp.
158 keepBefore :: Time -> VarData a -> VarData a
159 keepBefore nd var@VarData {..} =
160 let timeline' = M.takeWhileAntitone (< nd) evarTimeline
161 lastModifier = M.lookupMax timeline'
162 timeline'' = case lastModifier of
163 Just (t, TweenValue dur fn)
164 | t + dur > nd -> M.insert t (TweenValue (nd - t) fn) timeline'
165 _ -> timeline'
166 lastTime = case lastModifier of
167 Just (t, TweenValue dur _) -> Just $ min nd (t + dur)
168 _ -> min nd <$> evarLastTime
169 in VarData evarDefault timeline'' lastTime (maybe evarDefault (readVarData var) lastTime)