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 liftST :: ST s a -> Scene s a
47 liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, [])
48
49 -- | Evaluate the value of a scene.
50 evalScene :: (forall s. Scene s a) -> a
51 evalScene action = runST $ do
52 (val, _, _, _) <- unM action 0
53 return val
54
55 -- | Render a 'Scene' to an 'Animation'.
56 scene :: (forall s. Scene s a) -> Animation
57 scene = sceneAnimation
58
59 -- | Render a 'Scene' to an 'Animation'.
60 sceneAnimation :: (forall s. Scene s a) -> Animation
61 sceneAnimation action =
62 runST
63 ( do
64 (_, s, p, gens) <- unM action 0
65 let dur = max s p
66 genFns <- sequence gens
67 return $
68 mkAnimation
69 dur
70 ( \t ->
71 mkGroup $
72 map fst $
73 sortOn
74 snd
75 [spriteRender dur (t * dur) | spriteRender <- genFns]
76 )
77 )
78
79 -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before
80 -- all forked actions have completed.
81 --
82 -- Example:
83 --
84 -- @
85 -- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'
86 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle'
87 -- @
88 --
89 -- <<docs/gifs/doc_fork.gif>>
90 fork :: Scene s a -> Scene s a
91 fork (M action) = M $ \t -> do
92 (a, s, p, gens) <- action t
93 return (a, 0, max s p, gens)
94
95 -- | Query the current clock timestamp.
96 --
97 -- Example:
98 --
99 -- @
100 -- do now \<- 'play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow'
101 -- 'play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $
102 -- 'mkText' $ "Now=" <> T.pack (show now)
103 -- @
104 --
105 -- <<docs/gifs/doc_queryNow.gif>>
106 queryNow :: Scene s Time
107 queryNow = M $ \t -> return (t, 0, 0, [])
108
109 -- | Advance the clock by a given number of seconds.
110 --
111 -- Example:
112 --
113 -- @
114 -- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'
115 -- 'wait' 1
116 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle'
117 -- @
118 --
119 -- <<docs/gifs/doc_wait.gif>>
120 wait :: Duration -> Scene s ()
121 wait d = M $ \_ -> return ((), d, 0, [])
122
123 -- | Wait until the clock is equal to the given timestamp.
124 waitUntil :: Time -> Scene s ()
125 waitUntil tNew = do
126 now <- queryNow
127 wait (max 0 (tNew - now))
128
129 -- | Wait until all forked and sequential animations have finished.
130 --
131 -- Example:
132 --
133 -- @
134 -- do 'waitOn' $ 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'
135 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle'
136 -- @
137 --
138 -- <<docs/gifs/doc_waitOn.gif>>
139 waitOn :: Scene s a -> Scene s a
140 waitOn (M action) = M $ \t -> do
141 (a, s, p, gens) <- action t
142 return (a, max s p, 0, gens)
143
144 -- | Change the ZIndex of a scene.
145 adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
146 adjustZ fn (M action) = M $ \t -> do
147 (a, s, p, gens) <- action t
148 return (a, s, p, map genFn gens)
149 where
150 genFn gen = do
151 frameGen <- gen
152 return $ \d t -> let (svg, z) = frameGen d t in (svg, fn z)
153
154 -- | Query the duration of a scene.
155 withSceneDuration :: Scene s () -> Scene s Duration
156 withSceneDuration s = do
157 t1 <- queryNow
158 s
159 t2 <- queryNow
160 return (t2 - t1)
161
162 addGen :: Gen s -> Scene s ()
163 addGen gen = M $ \_ -> return ((), 0, 0, [gen])