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