never executed always true always false
1 {-# LANGUAGE RankNTypes #-}
2
3 module Reanimate.Scene.Core where
4
5 import Control.Monad.Fix (MonadFix (..))
6 import Control.Monad.ST
7 import Data.List
8 import Reanimate.Animation
9 import Reanimate.Svg.Constructors
10
11 -- | The ZIndex property specifies the stack order of sprites and animations. Elements
12 -- with a higher ZIndex will be drawn on top of elements with a lower index.
13 type ZIndex = Int
14
15 -- (seq duration, par duration)
16 -- [(Time, Animation, ZIndex)]
17 -- Map Time [(Animation, ZIndex)]
18 type Gen s = ST s (Duration -> Time -> (SVG, ZIndex))
19
20 -- | A 'Scene' represents a sequence of animations and variables
21 -- that change over time.
22 newtype Scene s a = M {unM :: Time -> ST s (a, Duration, Duration, [Gen s])}
23
24 instance Functor (Scene s) where
25 fmap f action = M $ \t -> do
26 (a, d1, d2, gens) <- unM action t
27 return (f a, d1, d2, gens)
28
29 instance Applicative (Scene s) where
30 pure a = M $ \_ -> return (a, 0, 0, [])
31 f <*> g = M $ \t -> do
32 (f', s1, p1, gen1) <- unM f t
33 (g', s2, p2, gen2) <- unM g (t + s1)
34 return (f' g', s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
35
36 instance Monad (Scene s) where
37 return = pure
38 f >>= g = M $ \t -> do
39 (a, s1, p1, gen1) <- unM f t
40 (b, s2, p2, gen2) <- unM (g a) (t + s1)
41 return (b, s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
42
43 instance MonadFix (Scene s) where
44 mfix fn = M $ \t -> mfix (\v -> let (a, _s, _p, _gens) = v in unM (fn a) t)
45
46 -- | Lift ST action into the Scene monad.
47 liftST :: ST s a -> Scene s a
48 liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, [])
49
50 -- | Evaluate the value of a scene.
51 evalScene :: (forall s. Scene s a) -> a
52 evalScene action = runST $ do
53 (val, _, _, _) <- unM action 0
54 return val
55
56 -- | Render a 'Scene' to an 'Animation'.
57 scene :: (forall s. Scene s a) -> Animation
58 scene action =
59 runST
60 ( do
61 (_, s, p, gens) <- unM action 0
62 let dur = max s p
63 genFns <- sequence gens
64 return $
65 mkAnimation
66 dur
67 ( \t ->
68 mkGroup $
69 map fst $
70 sortOn
71 snd
72 [spriteRender dur (t * dur) | spriteRender <- genFns]
73 )
74 )
75
76 -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before
77 -- all forked actions have completed.
78 --
79 -- Example:
80 --
81 -- @
82 -- do 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
83 -- 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
84 -- @
85 --
86 -- <<docs/gifs/doc_fork.gif>>
87 fork :: Scene s a -> Scene s a
88 fork (M action) = M $ \t -> do
89 (a, s, p, gens) <- action t
90 return (a, 0, max s p, gens)
91
92 -- | Query the current clock timestamp.
93 --
94 -- Example:
95 --
96 -- @
97 -- do now \<- 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow'
98 -- 'Reanimate.Scene.play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $
99 -- 'mkText' $ "Now=" <> T.pack (show now)
100 -- @
101 --
102 -- <<docs/gifs/doc_queryNow.gif>>
103 queryNow :: Scene s Time
104 queryNow = M $ \t -> return (t, 0, 0, [])
105
106 -- | Advance the clock by a given number of seconds.
107 --
108 -- Example:
109 --
110 -- @
111 -- do 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
112 -- 'wait' 1
113 -- 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
114 -- @
115 --
116 -- <<docs/gifs/doc_wait.gif>>
117 wait :: Duration -> Scene s ()
118 wait d = M $ \_ -> return ((), d, 0, [])
119
120 -- | Wait until the clock is equal to the given timestamp.
121 waitUntil :: Time -> Scene s ()
122 waitUntil tNew = do
123 now <- queryNow
124 wait (max 0 (tNew - now))
125
126 -- | Wait until all forked and sequential animations have finished.
127 --
128 -- Example:
129 --
130 -- @
131 -- do 'waitOn' $ 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
132 -- 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
133 -- @
134 --
135 -- <<docs/gifs/doc_waitOn.gif>>
136 waitOn :: Scene s a -> Scene s a
137 waitOn (M action) = M $ \t -> do
138 (a, s, p, gens) <- action t
139 return (a, max s p, 0, gens)
140
141 -- | Change the ZIndex of a scene.
142 adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
143 adjustZ fn (M action) = M $ \t -> do
144 (a, s, p, gens) <- action t
145 return (a, s, p, map genFn gens)
146 where
147 genFn gen = do
148 frameGen <- gen
149 return $ \d t -> let (svg, z) = frameGen d t in (svg, fn z)
150
151 -- | Query the duration of a scene.
152 withSceneDuration :: Scene s () -> Scene s Duration
153 withSceneDuration s = do
154 t1 <- queryNow
155 s
156 t2 <- queryNow
157 return (t2 - t1)
158
159 addGen :: Gen s -> Scene s ()
160 addGen gen = M $ \_ -> return ((), 0, 0, [gen])