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