never executed always true always false
1 {-# LANGUAGE ApplicativeDo #-}
2 {-# LANGUAGE ExistentialQuantification #-}
3 {-# LANGUAGE RankNTypes #-}
4 {-# LANGUAGE RecordWildCards #-}
5 {-|
6 Module : Reanimate.Scene
7 Copyright : Written by David Himmelstrup
8 License : Unlicense
9 Maintainer : lemmih@gmail.com
10 Stability : experimental
11 Portability : POSIX
12
13 Scenes are an imperative way of defining animations.
14
15 -}
16 module Reanimate.Scene
17 ( -- * Scenes
18 Scene
19 , ZIndex
20 , scene -- :: (forall s. Scene s a) -> Animation
21 , sceneAnimation -- :: (forall s. Scene s a) -> Animation
22 , play -- :: Animation -> Scene s ()
23 , fork -- :: Scene s a -> Scene s a
24 , queryNow -- :: Scene s Time
25 , wait -- :: Duration -> Scene s ()
26 , waitUntil -- :: Time -> Scene s ()
27 , waitOn -- :: Scene s a -> Scene s a
28 , adjustZ -- :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
29 , withSceneDuration -- :: Scene s () -> Scene s Duration
30 -- * Variables
31 , Var
32 , newVar -- :: a -> Scene s (Var s a)
33 , readVar -- :: Var s a -> Scene s a
34 , writeVar -- :: Var s a -> a -> Scene s ()
35 , modifyVar -- :: Var s a -> (a -> a) -> Scene s ()
36 , tweenVar -- :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
37 , tweenVarUnclamped -- :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
38 , simpleVar -- :: (a -> SVG) -> a -> Scene s (Var s a)
39 , findVar -- :: (a -> Bool) -> [Var s a] -> Scene s (Var s a)
40 -- * Sprites
41 , Sprite
42 , Frame
43 , unVar -- :: Var s a -> Frame s a
44 , spriteT -- :: Frame s Time
45 , spriteDuration -- :: Frame s Duration
46 , newSprite -- :: Frame s SVG -> Scene s (Sprite s)
47 , newSprite_ -- :: Frame s SVG -> Scene s ()
48 , newSpriteA -- :: Animation -> Scene s (Sprite s)
49 , newSpriteA' -- :: Sync -> Animation -> Scene s (Sprite s)
50 , newSpriteSVG -- :: SVG -> Scene s (Sprite s)
51 , newSpriteSVG_ -- :: SVG -> Scene s ()
52 , destroySprite -- :: Sprite s -> Scene s ()
53 , applyVar -- :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
54 , spriteModify -- :: Sprite s -> Frame s ((SVG,ZIndex) -> (SVG, ZIndex)) -> Scene s ()
55 , spriteMap -- :: Sprite s -> (SVG -> SVG) -> Scene s ()
56 , spriteTween -- :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
57 , spriteVar -- :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a)
58 , spriteE -- :: Sprite s -> Effect -> Scene s ()
59 , spriteZ -- :: Sprite s -> ZIndex -> Scene s ()
60 , spriteScope -- :: Scene s a -> Scene s a
61
62 -- * Object API
63 , Object
64 , ObjectData
65 , oNew
66 , newObject
67 , oModify
68 , oModifyS
69 , oRead
70 , oTween
71 , oTweenS
72 , oTweenV
73 , oTweenVS
74 , Renderable(..)
75 -- ** Object Properties
76 , oTranslate
77 , oSVG
78 , oContext
79 , oMargin
80 , oMarginTop
81 , oMarginRight
82 , oMarginBottom
83 , oMarginLeft
84 , oBB
85 , oBBMinX
86 , oBBMinY
87 , oBBWidth
88 , oBBHeight
89 , oOpacity
90 , oShown
91 , oZIndex
92 , oEasing
93 , oScale
94 , oScaleOrigin
95 , oTopY
96 , oBottomY
97 , oLeftX
98 , oRightX
99 , oCenterXY
100 , oValue
101
102 -- ** Graphics object methods
103 , oShow
104 , oHide
105 , oFadeIn
106 , oFadeOut
107 , oGrow
108 , oShrink
109 , oTransform
110
111 -- ** Pre-defined objects
112 , Circle(..)
113 , circleRadius
114 , Rectangle(..)
115 , rectWidth
116 , rectHeight
117 , Morph(..)
118 , morphDelta
119 , morphSrc
120 , morphDst
121 , Camera(..)
122 , cameraAttach
123 , cameraFocus
124 , cameraSetZoom
125 , cameraZoom
126 , cameraSetPan
127 , cameraPan
128
129 -- * ST internals
130 , liftST
131 , transitionO
132 , evalScene
133 )
134 where
135
136 import Control.Lens
137 import Control.Monad (void)
138 import Control.Monad.Fix
139 import Control.Monad.ST
140 import Control.Monad.State (execState, State)
141 import Data.List
142 import Data.STRef
143 import Graphics.SvgTree (Tree (None))
144 import Reanimate.Animation
145 import Reanimate.Ease (Signal, curveS, fromToS)
146 import Reanimate.Effect
147 import Reanimate.Svg.Constructors
148 import Reanimate.Svg.BoundingBox
149 import Reanimate.Transition
150 import Reanimate.Morph.Common (morph)
151 import Reanimate.Morph.Linear (linear)
152
153 -- | The ZIndex property specifies the stack order of sprites and animations. Elements
154 -- with a higher ZIndex will be drawn on top of elements with a lower index.
155 type ZIndex = Int
156
157
158 -- (seq duration, par duration)
159 -- [(Time, Animation, ZIndex)]
160 -- Map Time [(Animation, ZIndex)]
161 type Gen s = ST s (Duration -> Time -> (SVG, ZIndex))
162 -- | A 'Scene' represents a sequence of animations and variables
163 -- that change over time.
164 newtype Scene s a = M { unM :: Time -> ST s (a, Duration, Duration, [Gen s]) }
165
166 instance Functor (Scene s) where
167 fmap f action = M $ \t -> do
168 (a, d1, d2, gens) <- unM action t
169 return (f a, d1, d2, gens)
170
171 instance Applicative (Scene s) where
172 pure a = M $ \_ -> return (a, 0, 0, [])
173 f <*> g = M $ \t -> do
174 (f', s1, p1, gen1) <- unM f t
175 (g', s2, p2, gen2) <- unM g (t + s1)
176 return (f' g', s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
177
178 instance Monad (Scene s) where
179 return = pure
180 f >>= g = M $ \t -> do
181 (a, s1, p1, gen1) <- unM f t
182 (b, s2, p2, gen2) <- unM (g a) (t + s1)
183 return (b, s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
184
185 instance MonadFix (Scene s) where
186 mfix fn = M $ \t -> mfix (\v -> let (a, _s, _p, _gens) = v in unM (fn a) t)
187
188 -- | Lift an ST action into the Scene monad.
189 liftST :: ST s a -> Scene s a
190 liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, [])
191
192 -- | Evaluate the value of a scene.
193 evalScene :: (forall s . Scene s a) -> a
194 evalScene action = runST $ do
195 (val, _, _ , _) <- unM action 0
196 return val
197
198 -- | Render a 'Scene' to an 'Animation'.
199 scene :: (forall s . Scene s a) -> Animation
200 scene = sceneAnimation
201
202 -- | Render a 'Scene' to an 'Animation'.
203 sceneAnimation :: (forall s . Scene s a) -> Animation
204 sceneAnimation action = runST
205 (do
206 (_, s, p, gens) <- unM action 0
207 let dur = max s p
208 genFns <- sequence gens
209 return $ mkAnimation
210 dur
211 (\t -> mkGroup $ map fst $ sortOn
212 snd
213 [ spriteRender dur (t * dur) | spriteRender <- genFns ]
214 )
215 )
216
217 -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before
218 -- all forked actions have completed.
219 --
220 -- Example:
221 --
222 -- @
223 -- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'
224 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle'
225 -- @
226 --
227 -- <<docs/gifs/doc_fork.gif>>
228 fork :: Scene s a -> Scene s a
229 fork (M action) = M $ \t -> do
230 (a, s, p, gens) <- action t
231 return (a, 0, max s p, gens)
232
233 -- | Play an animation once and then remove it. This advances the clock by the duration of the
234 -- animation.
235 --
236 -- Example:
237 --
238 -- @
239 -- do 'play' 'Reanimate.Builtin.Documentation.drawBox'
240 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle'
241 -- @
242 --
243 -- <<docs/gifs/doc_play.gif>>
244 play :: Animation -> Scene s ()
245 play ani = newSpriteA ani >>= destroySprite
246
247 -- | Query the current clock timestamp.
248 --
249 -- Example:
250 --
251 -- @
252 -- do now \<- 'play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow'
253 -- 'play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $
254 -- 'mkText' $ "Now=" <> T.pack (show now)
255 -- @
256 --
257 -- <<docs/gifs/doc_queryNow.gif>>
258 queryNow :: Scene s Time
259 queryNow = M $ \t -> return (t, 0, 0, [])
260
261 -- | Advance the clock by a given number of seconds.
262 --
263 -- Example:
264 --
265 -- @
266 -- do 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'
267 -- 'wait' 1
268 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle'
269 -- @
270 --
271 -- <<docs/gifs/doc_wait.gif>>
272 wait :: Duration -> Scene s ()
273 wait d = M $ \_ -> return ((), d, 0, [])
274
275 -- | Wait until the clock is equal to the given timestamp.
276 waitUntil :: Time -> Scene s ()
277 waitUntil tNew = do
278 now <- queryNow
279 wait (max 0 (tNew - now))
280
281 -- | Wait until all forked and sequential animations have finished.
282 --
283 -- Example:
284 --
285 -- @
286 -- do 'waitOn' $ 'fork' $ 'play' 'Reanimate.Builtin.Documentation.drawBox'
287 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle'
288 -- @
289 --
290 -- <<docs/gifs/doc_waitOn.gif>>
291 waitOn :: Scene s a -> Scene s a
292 waitOn (M action) = M $ \t -> do
293 (a, s, p, gens) <- action t
294 return (a, max s p, 0, gens)
295
296 -- | Change the ZIndex of a scene.
297 adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
298 adjustZ fn (M action) = M $ \t -> do
299 (a, s, p, gens) <- action t
300 return (a, s, p, map genFn gens)
301 where
302 genFn gen = do
303 frameGen <- gen
304 return $ \d t -> let (svg, z) = frameGen d t in (svg, fn z)
305
306 -- | Query the duration of a scene.
307 withSceneDuration :: Scene s () -> Scene s Duration
308 withSceneDuration s = do
309 t1 <- queryNow
310 s
311 t2 <- queryNow
312 return (t2 - t1)
313
314 addGen :: Gen s -> Scene s ()
315 addGen gen = M $ \_ -> return ((), 0, 0, [gen])
316
317 -- | Time dependent variable.
318 newtype Var s a = Var (STRef s (Time -> a))
319
320 -- | Create a new variable with a default value.
321 -- Variables always have a defined value even if they are read at a timestamp that is
322 -- earlier than when the variable was created. For example:
323 --
324 -- @
325 -- do v \<- 'fork' ('wait' 10 \>\> 'newVar' 0) -- Create a variable at timestamp '10'.
326 -- 'readVar' v -- Read the variable at timestamp '0'.
327 -- -- The value of the variable will be '0'.
328 -- @
329 newVar :: a -> Scene s (Var s a)
330 newVar def = Var <$> liftST (newSTRef (const def))
331
332 -- | Read the value of a variable at the current timestamp.
333 readVar :: Var s a -> Scene s a
334 readVar (Var ref) = liftST (readSTRef ref) <*> queryNow
335
336 -- | Write the value of a variable at the current timestamp.
337 --
338 -- Example:
339 --
340 -- @
341 -- do v \<- 'newVar' 0
342 -- 'newSprite' $ 'mkCircle' \<$\> 'unVar' v
343 -- 'writeVar' v 1; 'wait' 1
344 -- 'writeVar' v 2; 'wait' 1
345 -- 'writeVar' v 3; 'wait' 1
346 -- @
347 --
348 -- <<docs/gifs/doc_writeVar.gif>>
349 writeVar :: Var s a -> a -> Scene s ()
350 writeVar var val = modifyVar var (const val)
351
352 -- | Modify the value of a variable at the current timestamp and all future timestamps.
353 modifyVar :: Var s a -> (a -> a) -> Scene s ()
354 modifyVar (Var ref) fn = do
355 now <- queryNow
356 liftST $ modifySTRef ref $ \prev t -> if t < now then prev t else fn (prev t)
357
358 -- | Modify a variable between @now@ and @now+duration@.
359 -- Note: The modification function is invoked for past timestamps (with a time value of 0) and
360 -- for timestamps after @now+duration@ (with a time value of 1). See 'tweenVarUnclamped'.
361 tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
362 tweenVar (Var ref) dur fn = do
363 now <- queryNow
364 liftST $ modifySTRef ref $ \prev t ->
365 if t < now
366 then prev t
367 else fn (prev t) (max 0 (min dur $ t - now) / dur)
368 wait dur
369
370 -- | Modify a variable between @now@ and @now+duration@.
371 -- Note: The modification function is invoked for past timestamps (with a negative time value) and
372 -- for timestamps after @now+duration@ (with a time value greater than 1).
373 tweenVarUnclamped :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
374 tweenVarUnclamped (Var ref) dur fn = do
375 now <- queryNow
376 liftST $ modifySTRef ref $ \prev t -> fn (prev t) ((t - now) / dur)
377 wait dur
378
379 -- | Create and render a variable. The rendering will be born at the current timestamp
380 -- and will persist until the end of the scene.
381 --
382 -- Example:
383 --
384 -- @
385 -- do var \<- 'simpleVar' 'mkCircle' 0
386 -- 'tweenVar' var 2 $ \val -> 'fromToS' val ('Reanimate.Constants.screenHeight'/2)
387 -- @
388 --
389 -- <<docs/gifs/doc_simpleVar.gif>>
390 simpleVar :: (a -> SVG) -> a -> Scene s (Var s a)
391 simpleVar render def = do
392 v <- newVar def
393 _ <- newSprite $ render <$> unVar v
394 return v
395
396 -- | Helper function for filtering variables.
397 findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a)
398 findVar _cond [] = error "Variable not found."
399 findVar cond (v : vs) = do
400 val <- readVar v
401 if cond val then return v else findVar cond vs
402
403 -- | Sprites are animations with a given time of birth as well as a time of death.
404 -- They can be controlled using variables, tweening, and effects.
405 data Sprite s = Sprite Time (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex))))
406
407 -- | Sprite frame generator. Generates frames over time in a stateful environment.
408 newtype Frame s a = Frame { unFrame :: ST s (Time -> Duration -> Time -> a) }
409
410 instance Functor (Frame s) where
411 fmap fn (Frame gen) = Frame $ do
412 m <- gen
413 return (\real_t d t -> fn $ m real_t d t)
414
415 instance Applicative (Frame s) where
416 pure v = Frame $ return (\_ _ _ -> v)
417 Frame f <*> Frame g = Frame $ do
418 m1 <- f
419 m2 <- g
420 return $ \real_t d t -> m1 real_t d t (m2 real_t d t)
421
422 -- | Dereference a variable as a Sprite frame.
423 --
424 -- Example:
425 --
426 -- @
427 -- do v \<- 'newVar' 0
428 -- 'newSprite' $ 'mkCircle' \<$\> 'unVar' v
429 -- 'tweenVar' v 1 $ \val -> 'fromToS' val 3
430 -- 'tweenVar' v 1 $ \val -> 'fromToS' val 0
431 -- @
432 --
433 -- <<docs/gifs/doc_unVar.gif>>
434 unVar :: Var s a -> Frame s a
435 unVar (Var ref) = Frame $ do
436 fn <- readSTRef ref
437 return $ \real_t _d _t -> fn real_t
438
439
440 -- | Dereference seconds since sprite birth.
441 spriteT :: Frame s Time
442 spriteT = Frame $ return (\_real_t _d t -> t)
443
444 -- | Dereference duration of the current sprite.
445 spriteDuration :: Frame s Duration
446 spriteDuration = Frame $ return (\_real_t d _t -> d)
447
448 -- | Create new sprite defined by a frame generator. Unless otherwise specified using
449 -- 'destroySprite', the sprite will die at the end of the scene.
450 --
451 -- Example:
452 --
453 -- @
454 -- do 'newSprite' $ 'mkCircle' \<$\> 'spriteT' -- Circle sprite where radius=time.
455 -- 'wait' 2
456 -- @
457 --
458 -- <<docs/gifs/doc_newSprite.gif>>
459 newSprite :: Frame s SVG -> Scene s (Sprite s)
460 newSprite render = do
461 now <- queryNow
462 ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0))
463 addGen $ do
464 fn <- unFrame render
465 (spriteDur, spriteEffectGen) <- readSTRef ref
466 spriteEffect <- spriteEffectGen
467 return $ \d absT ->
468 let relD = (if spriteDur < 0 then d else spriteDur) - now
469 relT = absT - now
470 -- Sprite is live [now;duration[
471 -- If we're at the end of a scene, sprites
472 -- are live: [now;duration]
473 -- This behavior is difficult to get right. See the 'bug_*' examples for
474 -- automated tests.
475 inTimeSlice = relT >= 0 && relT < relD
476 isLastFrame = d==absT && relT == relD
477 in if inTimeSlice || isLastFrame
478 then spriteEffect relD relT (fn absT relD relT)
479 else (None, 0)
480 return $ Sprite now ref
481
482 -- | Create new sprite defined by a frame generator. The sprite will die at
483 -- the end of the scene.
484 newSprite_ :: Frame s SVG -> Scene s ()
485 newSprite_ = void . newSprite
486
487 -- | Create a new sprite from an animation. This advances the clock by the
488 -- duration of the animation. Unless otherwise specified using
489 -- 'destroySprite', the sprite will die at the end of the scene.
490 --
491 -- Note: If the scene doesn't end immediately after the duration of the
492 -- animation, the animation will be stretched to match the lifetime of the
493 -- sprite. See 'newSpriteA'' and 'play'.
494 --
495 -- Example:
496 --
497 -- @
498 -- do 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
499 -- 'play' 'Reanimate.Builtin.Documentation.drawBox'
500 -- 'play' $ 'reverseA' 'Reanimate.Builtin.Documentation.drawBox'
501 -- @
502 --
503 -- <<docs/gifs/doc_newSpriteA.gif>>
504 newSpriteA :: Animation -> Scene s (Sprite s)
505 newSpriteA = newSpriteA' SyncStretch
506
507 -- | Create a new sprite from an animation and specify the synchronization policy. This advances
508 -- the clock by the duration of the animation.
509 --
510 -- Example:
511 --
512 -- @
513 -- do 'fork' $ 'newSpriteA'' 'SyncFreeze' 'Reanimate.Builtin.Documentation.drawCircle'
514 -- 'play' 'Reanimate.Builtin.Documentation.drawBox'
515 -- 'play' $ 'reverseA' 'Reanimate.Builtin.Documentation.drawBox'
516 -- @
517 --
518 -- <<docs/gifs/doc_newSpriteA'.gif>>
519 newSpriteA' :: Sync -> Animation -> Scene s (Sprite s)
520 newSpriteA' sync animation =
521 newSprite (getAnimationFrame sync animation <$> spriteT <*> spriteDuration)
522 <* wait (duration animation)
523
524 -- | Create a sprite from a static SVG image.
525 --
526 -- Example:
527 --
528 -- @
529 -- do 'newSpriteSVG' $ 'mkBackground' "lightblue"
530 -- 'play' 'Reanimate.Builtin.Documentation.drawCircle'
531 -- @
532 --
533 -- <<docs/gifs/doc_newSpriteSVG.gif>>
534 newSpriteSVG :: SVG -> Scene s (Sprite s)
535 newSpriteSVG = newSprite . pure
536
537 -- | Create a permanent sprite from a static SVG image. Same as `newSpriteSVG`
538 -- but the sprite isn't returned and thus cannot be destroyed.
539 newSpriteSVG_ :: SVG -> Scene s ()
540 newSpriteSVG_ = void . newSpriteSVG
541
542 -- | Change the rendering of a sprite using data from a variable. If data from several variables
543 -- is needed, use a frame generator instead.
544 --
545 -- Example:
546 --
547 -- @
548 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox'
549 -- v \<- 'newVar' 0
550 -- 'applyVar' v s 'rotate'
551 -- 'tweenVar' v 2 $ \val -> 'fromToS' val 90
552 -- @
553 --
554 -- <<docs/gifs/doc_applyVar.gif>>
555 applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
556 applyVar var sprite fn = spriteModify sprite $ do
557 varFn <- unVar var
558 return $ \(svg, zindex) -> (fn varFn svg, zindex)
559
560 -- | Destroy a sprite, preventing it from being rendered in the future of the scene.
561 -- If 'destroySprite' is invoked multiple times, the earliest time-of-death is used.
562 --
563 -- Example:
564 --
565 -- @
566 -- do s <- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'mkCircle' 1
567 -- 'fork' $ 'wait' 1 \>\> 'destroySprite' s
568 -- 'play' 'Reanimate.Builtin.Documentation.drawBox'
569 -- @
570 --
571 -- <<docs/gifs/doc_destroySprite.gif>>
572 destroySprite :: Sprite s -> Scene s ()
573 destroySprite (Sprite _ ref) = do
574 now <- queryNow
575 liftST $ modifySTRef ref $ \(ttl, render) ->
576 (if ttl < 0 then now else min ttl now, render)
577
578 -- | Low-level frame modifier.
579 spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
580 spriteModify (Sprite born ref) modFn = liftST $ modifySTRef ref $ \(ttl, renderGen) ->
581 ( ttl
582 , do
583 render <- renderGen
584 modRender <- unFrame modFn
585 return $ \relD relT ->
586 let absT = relT + born in modRender absT relD relT . render relD relT
587 )
588
589 -- | Map the SVG output of a sprite.
590 --
591 -- Example:
592 --
593 -- @
594 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
595 -- 'wait' 1
596 -- 'spriteMap' s 'flipYAxis'
597 -- @
598 --
599 -- <<docs/gifs/doc_spriteMap.gif>>
600 spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
601 spriteMap sprite@(Sprite born _) fn = do
602 now <- queryNow
603 let tDelta = now - born
604 spriteModify sprite $ do
605 t <- spriteT
606 return $ \(svg, zindex) -> (if (t - tDelta) < 0 then svg else fn svg, zindex)
607
608 -- | Modify the output of a sprite between @now@ and @now+duration@.
609 --
610 -- Example:
611 --
612 -- @
613 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
614 -- 'spriteTween' s 1 $ \val -> 'translate' ('Reanimate.Constants.screenWidth'*0.3*val) 0
615 -- @
616 --
617 -- <<docs/gifs/doc_spriteTween.gif>>
618 spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
619 spriteTween sprite@(Sprite born _) dur fn = do
620 now <- queryNow
621 let tDelta = now - born
622 spriteModify sprite $ do
623 t <- spriteT
624 return $ \(svg, zindex) -> (fn (clamp 0 1 $ (t - tDelta) / dur) svg, zindex)
625 wait dur
626 where
627 clamp a b v | v < a = a
628 | v > b = b
629 | otherwise = v
630
631 -- | Create a new variable and apply it to a sprite.
632 --
633 -- Example:
634 --
635 -- @
636 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox'
637 -- v \<- 'spriteVar' s 0 'rotate'
638 -- 'tweenVar' v 2 $ \val -> 'fromToS' val 90
639 -- @
640 --
641 -- <<docs/gifs/doc_spriteVar.gif>>
642 spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a)
643 spriteVar sprite def fn = do
644 v <- newVar def
645 applyVar v sprite fn
646 return v
647
648 -- | Apply an effect to a sprite.
649 --
650 -- Example:
651 --
652 -- @
653 -- do s <- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
654 -- 'spriteE' s $ 'overBeginning' 1 'fadeInE'
655 -- 'spriteE' s $ 'overEnding' 0.5 'fadeOutE'
656 -- @
657 --
658 -- <<docs/gifs/doc_spriteE.gif>>
659 spriteE :: Sprite s -> Effect -> Scene s ()
660 spriteE (Sprite born ref) effect = do
661 now <- queryNow
662 liftST $ modifySTRef ref $ \(ttl, renderGen) ->
663 ( ttl
664 , do
665 render <- renderGen
666 return $ \d t svg ->
667 let (svg', z) = render d t svg
668 in (delayE (max 0 $ now - born) effect d t svg', z)
669 )
670
671 -- | Set new ZIndex of a sprite.
672 --
673 -- Example:
674 --
675 -- @
676 -- do s1 \<- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'withFillColor' "blue" $ 'mkCircle' 3
677 -- 'newSpriteSVG' $ 'withFillOpacity' 1 $ 'withFillColor' "red" $ 'mkRect' 8 3
678 -- 'wait' 1
679 -- 'spriteZ' s1 1
680 -- 'wait' 1
681 -- @
682 --
683 -- <<docs/gifs/doc_spriteZ.gif>>
684 spriteZ :: Sprite s -> ZIndex -> Scene s ()
685 spriteZ (Sprite born ref) zindex = do
686 now <- queryNow
687 liftST $ modifySTRef ref $ \(ttl, renderGen) ->
688 ( ttl
689 , do
690 render <- renderGen
691 return $ \d t svg ->
692 let (svg', z) = render d t svg in (svg', if t < now - born then z else zindex)
693 )
694
695 -- | Destroy all local sprites at the end of a scene.
696 --
697 -- Example:
698 --
699 -- @
700 -- do -- the rect lives through the entire 3s animation
701 -- 'newSpriteSVG_' $ 'translate' (-3) 0 $ 'mkRect' 4 4
702 -- 'wait' 1
703 -- 'spriteScope' $ do
704 -- -- the circle only lives for 1 second.
705 -- local \<- 'newSpriteSVG' $ 'translate' 3 0 $ 'mkCircle' 2
706 -- 'spriteE' local $ 'overBeginning' 0.3 'fadeInE'
707 -- 'spriteE' local $ 'overEnding' 0.3 'fadeOutE'
708 -- 'wait' 1
709 -- 'wait' 1
710 -- @
711 --
712 -- <<docs/gifs/doc_spriteScope.gif>>
713 spriteScope :: Scene s a -> Scene s a
714 spriteScope (M action) = M $ \t -> do
715 (a, s, p, gens) <- action t
716 return (a, s, p, map (genFn (t+max s p)) gens)
717 where
718 genFn maxT gen = do
719 frameGen <- gen
720 return $ \_ t ->
721 if t < maxT
722 then frameGen maxT t
723 else (None, 0)
724
725 asAnimation :: (forall s'. Scene s' a) -> Scene s Animation
726 asAnimation s = do
727 now <- queryNow
728 return $ dropA now (sceneAnimation (wait now >> s))
729
730 -- | Apply a transformation with a given overlap. This makes sure
731 -- to keep timestamps intact such that events can still be timed
732 -- by transcripts.
733 transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s ()
734 transitionO t o a b = do
735 aA <- asAnimation a
736 bA <- fork $ do
737 wait (duration aA - o)
738 asAnimation b
739 play $ overlapT o t aA bA
740
741
742
743
744 -------------------------------------------------------
745 -- Objects
746
747 -- | Objects can be any Haskell structure as long as it can be rendered to SVG.
748 class Renderable a where
749 toSVG :: a -> SVG
750
751 instance Renderable Tree where
752 toSVG = id
753
754 -- | Objects are SVG nodes (represented as Haskell values) with
755 -- identity, location, and several other properties that can
756 -- change over time.
757 data Object s a = Object
758 { objectSprite :: Sprite s
759 , objectData :: Var s (ObjectData a)
760 }
761
762 -- | Container for object properties.
763 data ObjectData a = ObjectData
764 { _oTranslate :: (Double, Double)
765 , _oValueRef :: a
766 , _oSVG :: SVG
767 , _oContext :: SVG -> SVG
768 , _oMargin :: (Double, Double, Double, Double)
769 -- ^ Top, right, bottom, left
770 , _oBB :: (Double,Double,Double,Double)
771 , _oOpacity :: Double
772 , _oShown :: Bool
773 , _oZIndex :: Int
774 , _oEasing :: Signal
775 , _oScale :: Double
776 , _oScaleOrigin :: (Double, Double)
777 }
778
779 -- Basic lenses
780
781 -- FIXME: Maybe 'position' is a better name.
782 -- | Object position. Default: \<0,0\>
783 oTranslate :: Lens' (ObjectData a) (Double, Double)
784 oTranslate = lens _oTranslate $ \obj val -> obj { _oTranslate = val }
785
786 -- | Rendered SVG node of an object. Does not include context
787 -- or object properties. Read-only.
788 oSVG :: Getter (ObjectData a) SVG
789 oSVG = to _oSVG
790
791 -- | Custom render context. Is applied to the object for every
792 -- frame that it is shown.
793 oContext :: Lens' (ObjectData a) (SVG -> SVG)
794 oContext = lens _oContext $ \obj val -> obj { _oContext = val }
795
796 -- | Object margins (top, right, bottom, left) in local units.
797 oMargin :: Lens' (ObjectData a) (Double, Double, Double, Double)
798 oMargin = lens _oMargin $ \obj val -> obj { _oMargin = val }
799
800 -- | Object bounding-box (minimal X-coordinate, minimal Y-coordinate,
801 -- width, height). Uses `Reanimate.Svg.BoundingBox.boundingBox`
802 -- and has the same limitations.
803 oBB :: Getter (ObjectData a) (Double, Double, Double, Double)
804 oBB = to _oBB
805
806 -- | Object opacity. Default: 1
807 oOpacity :: Lens' (ObjectData a) Double
808 oOpacity = lens _oOpacity $ \obj val -> obj { _oOpacity = val }
809
810 -- | Toggle for whether or not the object should be rendered.
811 -- Default: False
812 oShown :: Lens' (ObjectData a) Bool
813 oShown = lens _oShown $ \obj val -> obj { _oShown = val }
814
815 -- | Object's z-index.
816 oZIndex :: Lens' (ObjectData a) Int
817 oZIndex = lens _oZIndex $ \obj val -> obj { _oZIndex = val }
818
819 -- | Easing function used when modifying object properties.
820 -- Default: @'Reanimate.Ease.curveS' 2@
821 oEasing :: Lens' (ObjectData a) Signal
822 oEasing = lens _oEasing $ \obj val -> obj { _oEasing = val }
823
824 -- | Object's scale. Default: 1
825 oScale :: Lens' (ObjectData a) Double
826 oScale = lens _oScale $ \obj val -> obj { _oScale = val }
827
828 -- | Origin point for scaling. Default: \<0,0\>
829 oScaleOrigin :: Lens' (ObjectData a) (Double, Double)
830 oScaleOrigin = lens _oScaleOrigin $ \obj val -> obj { _oScaleOrigin = val }
831
832 -- Smart lenses
833
834 -- | Lens for the source value contained in an object.
835 oValue :: Renderable a => Lens' (ObjectData a) a
836 oValue = lens _oValueRef $ \obj newVal ->
837 let svg = toSVG newVal
838 in obj
839 { _oValueRef = newVal
840 , _oSVG = svg
841 , _oBB = boundingBox svg }
842
843 -- | Derived location of the top-most point of an object + margin.
844 oTopY :: Lens' (ObjectData a) Double
845 oTopY = lens getter setter
846 where
847 getter obj =
848 let top = obj ^. oMarginTop
849 miny = obj ^. oBBMinY
850 h = obj ^. oBBHeight
851 dy = obj ^. oTranslate . _2
852 in dy+miny+h+top
853 setter obj val =
854 obj & (oTranslate . _2) +~ val-getter obj
855
856 -- | Derived location of the bottom-most point of an object + margin.
857 oBottomY :: Lens' (ObjectData a) Double
858 oBottomY = lens getter setter
859 where
860 getter obj =
861 let bot = obj ^. oMarginBottom
862 miny = obj ^. oBBMinY
863 dy = obj ^. oTranslate . _2
864 in dy+miny-bot
865 setter obj val =
866 obj & (oTranslate . _2) +~ val-getter obj
867
868 -- | Derived location of the left-most point of an object + margin.
869 oLeftX :: Lens' (ObjectData a) Double
870 oLeftX = lens getter setter
871 where
872 getter obj =
873 let left = obj ^. oMarginLeft
874 minx = obj ^. oBBMinX
875 dx = obj ^. oTranslate . _1
876 in dx+minx-left
877 setter obj val =
878 obj & (oTranslate . _1) +~ val-getter obj
879
880 -- | Derived location of the right-most point of an object + margin.
881 oRightX :: Lens' (ObjectData a) Double
882 oRightX = lens getter setter
883 where
884 getter obj =
885 let right = obj ^. oMarginRight
886 minx = obj ^. oBBMinX
887 w = obj ^. oBBWidth
888 dx = obj ^. oTranslate . _1
889 in dx+minx+w+right
890 setter obj val =
891 obj & (oTranslate . _1) +~ val-getter obj
892
893 -- | Derived location of an object's center point.
894 oCenterXY :: Lens' (ObjectData a) (Double, Double)
895 oCenterXY = lens getter setter
896 where
897 getter obj =
898 let minx = obj ^. oBBMinX
899 miny = obj ^. oBBMinY
900 w = obj ^. oBBWidth
901 h = obj ^. oBBHeight
902 (dx,dy) = obj ^. oTranslate
903 in (dx+minx+w/2, dy+miny+h/2)
904 setter obj (dx, dy) =
905 let (x,y) = getter obj in
906 obj & (oTranslate . _1) +~ dx-x
907 & (oTranslate . _2) +~ dy-y
908
909 -- | Object's top margin.
910 oMarginTop :: Lens' (ObjectData a) Double
911 oMarginTop = oMargin . _1
912
913 -- | Object's right margin.
914 oMarginRight :: Lens' (ObjectData a) Double
915 oMarginRight = oMargin . _2
916
917 -- | Object's bottom margin.
918 oMarginBottom :: Lens' (ObjectData a) Double
919 oMarginBottom = oMargin . _3
920
921 -- | Object's left margin.
922 oMarginLeft :: Lens' (ObjectData a) Double
923 oMarginLeft = oMargin . _4
924
925 -- | Object's minimal X-coordinate..
926 oBBMinX :: Getter (ObjectData a) Double
927 oBBMinX = oBB . _1
928
929 -- | Object's minimal Y-coordinate..
930 oBBMinY :: Getter (ObjectData a) Double
931 oBBMinY = oBB . _2
932
933 -- | Object's width without margin.
934 oBBWidth :: Getter (ObjectData a) Double
935 oBBWidth = oBB . _3
936
937 -- | Object's height without margin.
938 oBBHeight :: Getter (ObjectData a) Double
939 oBBHeight = oBB . _4
940
941 -------------------------------------------------------------------------------
942 -- Object modifiers
943
944 -- | Modify object properties.
945 oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s ()
946 oModify o fn = modifyVar (objectData o) fn
947
948 -- | Modify object properties using a stateful API.
949 oModifyS :: Object s a -> (State (ObjectData a) b) -> Scene s ()
950 oModifyS o fn = oModify o (execState fn)
951
952 -- | Query object property.
953 oRead :: Object s a -> Getting b (ObjectData a) b -> Scene s b
954 oRead o l = view l <$> readVar (objectData o)
955
956 -- | Modify object properties over a set duration.
957 oTween :: Object s a -> Duration -> (Double -> ObjectData a -> ObjectData a) -> Scene s ()
958 oTween o d fn = do
959 -- Read 'easing' var here instead of taking it from 'v'.
960 -- This allows different easing functions even at the same timestamp.
961 ease <- oRead o oEasing
962 tweenVar (objectData o) d (\v t -> fn (ease t) v)
963
964 -- | Modify object properties over a set duration using a stateful API.
965 oTweenS :: Object s a -> Duration -> (Double -> State (ObjectData a) b) -> Scene s ()
966 oTweenS o d fn = oTween o d (\t -> execState (fn t))
967
968 -- | Modify object value over a set duration. This is a convenience function
969 -- for modifying `oValue`.
970 oTweenV :: Renderable a => Object s a -> Duration -> (Double -> a -> a) -> Scene s ()
971 oTweenV o d fn = oTween o d (\t -> oValue %~ fn t)
972
973 -- | Modify object value over a set duration using a stateful API. This is a
974 -- convenience function for modifying `oValue`.
975 oTweenVS :: Renderable a => Object s a -> Duration -> (Double -> State a b) -> Scene s ()
976 oTweenVS o d fn = oTween o d (\t -> oValue %~ execState (fn t))
977
978 -- | Create new object.
979 oNew :: Renderable a => a -> Scene s (Object s a)
980 oNew = newObject
981
982 -- | Create new object.
983 newObject :: Renderable a => a -> Scene s (Object s a)
984 newObject val = do
985 ref <- newVar ObjectData
986 { _oTranslate = (0,0)
987 , _oValueRef = val
988 , _oSVG = svg
989 , _oContext = id
990 , _oMargin = (0.5,0.5,0.5,0.5)
991 , _oBB = boundingBox svg
992 , _oOpacity = 1
993 , _oShown = False
994 , _oZIndex = 1
995 , _oEasing = curveS 2
996 , _oScale = 1
997 , _oScaleOrigin = (0,0)
998 }
999 sprite <- newSprite $ do
1000 ~ObjectData{..} <- unVar ref
1001 pure $
1002 if _oShown
1003 then
1004 uncurry translate _oTranslate $
1005 uncurry translate (_oScaleOrigin & both %~ negate) $
1006 scale _oScale $
1007 uncurry translate _oScaleOrigin $
1008 withGroupOpacity _oOpacity $
1009 _oContext _oSVG
1010 else None
1011 spriteModify sprite $ do
1012 ~ObjectData{_oZIndex=z} <- unVar ref
1013 pure $ \(img,_) -> (img,z)
1014 return Object
1015 { objectSprite = sprite
1016 , objectData = ref }
1017 where
1018 svg = toSVG val
1019
1020 -------------------------------------------------------------------------------
1021 -- Graphical transformations
1022
1023 -- | Instantly show object.
1024 oShow :: Object s a -> Scene s ()
1025 oShow o = oModify o $ oShown .~ True
1026
1027 -- | Instantly hide object.
1028 oHide :: Object s a -> Scene s ()
1029 oHide o = oModify o $ oShown .~ False
1030
1031 -- | Fade in object over a set duration.
1032 oFadeIn :: Object s a -> Duration -> Scene s ()
1033 oFadeIn o d = do
1034 oModify o $
1035 oShown .~ True
1036 oTweenS o d $ \t ->
1037 oOpacity *= t
1038
1039 -- | Fade out object over a set duration.
1040 oFadeOut :: Object s a -> Duration -> Scene s ()
1041 oFadeOut o d = do
1042 oModify o $
1043 oShown .~ True
1044 oTweenS o d $ \t ->
1045 oOpacity *= 1-t
1046
1047 -- | Scale in object over a set duration.
1048 oGrow :: Object s a -> Duration -> Scene s ()
1049 oGrow o d = do
1050 oModify o $
1051 oShown .~ True
1052 oTweenS o d $ \t ->
1053 oScale *= t
1054
1055 -- | Scale out object over a set duration.
1056 oShrink :: Object s a -> Duration -> Scene s ()
1057 oShrink o d =
1058 oTweenS o d $ \t ->
1059 oScale *= 1-t
1060
1061 -- FIXME: Also transform attributes: 'opacity', 'scale', 'scaleOrigin'.
1062 -- | Morph source object into target object over a set duration.
1063 oTransform :: Object s a -> Object s b -> Duration -> Scene s ()
1064 oTransform src dst d = do
1065 srcSvg <- oRead src oSVG
1066 srcCtx <- oRead src oContext
1067 srcEase <- oRead src oEasing
1068 srcLoc <- oRead src oTranslate
1069 oModify src $ oShown .~ False
1070
1071 dstSvg <- oRead dst oSVG
1072 dstCtx <- oRead dst oContext
1073 dstLoc <- oRead dst oTranslate
1074
1075 m <- newObject $ Morph 0 (srcCtx srcSvg) (dstCtx dstSvg)
1076 oModifyS m $ do
1077 oShown .= True
1078 oEasing .= srcEase
1079 oTranslate .= srcLoc
1080 fork $ oTween m d $ \t -> oTranslate %~ moveTo t dstLoc
1081 oTweenV m d $ \t -> morphDelta .~ t
1082 oModify m $ oShown .~ False
1083 oModify dst $ oShown .~ True
1084 where
1085 moveTo t (dstX, dstY) (srcX, srcY) =
1086 (fromToS srcX dstX t, fromToS srcY dstY t)
1087
1088
1089 -------------------------------------------------------------------------------
1090 -- Built-in objects
1091
1092 -- | Basic object mapping to \<circle\/\> in SVG.
1093 newtype Circle = Circle {_circleRadius :: Double}
1094
1095 -- | Circle radius in local units.
1096 circleRadius :: Lens' Circle Double
1097 circleRadius = iso _circleRadius Circle
1098
1099 instance Renderable Circle where
1100 toSVG (Circle r) = mkCircle r
1101
1102 -- | Basic object mapping to \<rect\/\> in SVG.
1103 data Rectangle = Rectangle { _rectWidth :: Double, _rectHeight :: Double }
1104
1105 -- | Rectangle width in local units.
1106 rectWidth :: Lens' Rectangle Double
1107 rectWidth = lens _rectWidth $ \obj val -> obj{_rectWidth=val}
1108
1109 -- | Rectangle height in local units.
1110 rectHeight :: Lens' Rectangle Double
1111 rectHeight = lens _rectHeight $ \obj val -> obj{_rectHeight=val}
1112
1113 instance Renderable Rectangle where
1114 toSVG (Rectangle w h) = mkRect w h
1115
1116 -- | Object representing an interpolation between SVG nodes.
1117 data Morph = Morph { _morphDelta :: Double, _morphSrc :: SVG, _morphDst :: SVG }
1118
1119 -- | Control variable for the interpolation. A value of 0 gives the
1120 -- source SVG and 1 gives the target svg.
1121 morphDelta :: Lens' Morph Double
1122 morphDelta = lens _morphDelta $ \obj val -> obj{_morphDelta = val}
1123
1124 -- | Source shape.
1125 morphSrc :: Lens' Morph SVG
1126 morphSrc = lens _morphSrc $ \obj val -> obj{_morphSrc = val}
1127
1128 -- | Target shape.
1129 morphDst :: Lens' Morph SVG
1130 morphDst = lens _morphDst $ \obj val -> obj{_morphDst = val}
1131
1132 instance Renderable Morph where
1133 toSVG (Morph t src dst) = morph linear src dst t
1134
1135 -- | Cameras can take control of objects and manipulate them
1136 -- with convenient pan and zoom operations.
1137 data Camera = Camera
1138 instance Renderable Camera where
1139 toSVG Camera = None
1140
1141 -- | Connect an object to a camera such that
1142 -- camera settings (position, zoom, and rotation) is
1143 -- applied to the object.
1144 --
1145 -- Example
1146 --
1147 -- @
1148 -- do cam \<- 'newObject' 'Camera'
1149 -- circ \<- 'newObject' $ 'Circle' 2
1150 -- 'oModifyS' circ $
1151 -- 'oContext' .= 'withFillOpacity' 1 . 'withFillColor' "blue"
1152 -- 'oShow' circ
1153 -- 'cameraAttach' cam circ
1154 -- 'cameraZoom' cam 1 2
1155 -- 'cameraZoom' cam 1 1
1156 -- @
1157 --
1158 -- <<docs/gifs/doc_cameraAttach.gif>>
1159 cameraAttach :: Object s Camera -> Object s a -> Scene s ()
1160 cameraAttach cam obj =
1161 spriteModify (objectSprite obj) $ do
1162 camData <- unVar (objectData cam)
1163 return $ \(svg,zindex) ->
1164 let (x,y) = camData^.oTranslate
1165 ctx =
1166 translate (-x) (-y) .
1167 uncurry translate (camData^.oScaleOrigin) .
1168 scale (camData^.oScale) .
1169 uncurry translate (camData^.oScaleOrigin & both %~ negate)
1170 in (ctx svg, zindex)
1171
1172 -- |
1173 --
1174 -- Example
1175 --
1176 -- @
1177 -- do cam \<- 'newObject' 'Camera'
1178 -- circ \<- 'newObject' $ 'Circle' 2; 'oShow' circ
1179 -- 'oModify' circ $ 'oTranslate' .~ (-3,0)
1180 -- box \<- 'newObject' $ 'Rectangle' 4 4; 'oShow' box
1181 -- 'oModify' box $ 'oTranslate' .~ (3,0)
1182 -- 'cameraAttach' cam circ
1183 -- 'cameraAttach' cam box
1184 -- 'cameraFocus' cam (-3,0)
1185 -- 'cameraZoom' cam 2 2 -- Zoom in
1186 -- 'cameraZoom' cam 2 1 -- Zoom out
1187 -- 'cameraFocus' cam (3,0)
1188 -- 'cameraZoom' cam 2 2 -- Zoom in
1189 -- 'cameraZoom' cam 2 1 -- Zoom out
1190 -- @
1191 --
1192 -- <<docs/gifs/doc_cameraFocus.gif>>
1193 cameraFocus :: Object s Camera -> (Double, Double) -> Scene s ()
1194 cameraFocus cam (x,y) = do
1195 (ox, oy) <- oRead cam oScaleOrigin
1196 (tx, ty) <- oRead cam oTranslate
1197 s <- oRead cam oScale
1198 let newLocation = (x-((x-ox)*s+ox-tx), y-((y-oy)*s+oy-ty))
1199 oModifyS cam $ do
1200 oTranslate .= newLocation
1201 oScaleOrigin .= (x,y)
1202
1203 -- | Instantaneously set camera zoom level.
1204 cameraSetZoom :: Object s Camera -> Double -> Scene s ()
1205 cameraSetZoom cam s =
1206 oModifyS cam $
1207 oScale .= s
1208
1209 -- | Change camera zoom level over a set duration.
1210 cameraZoom :: Object s Camera -> Duration -> Double -> Scene s ()
1211 cameraZoom cam d s =
1212 oTweenS cam d $ \t ->
1213 oScale %= \v -> fromToS v s t
1214
1215 -- | Instantaneously set camera location.
1216 cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s ()
1217 cameraSetPan cam location =
1218 oModifyS cam $ do
1219 oTranslate .= location
1220
1221 -- | Change camera location over a set duration.
1222 cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s ()
1223 cameraPan cam d (x,y) =
1224 oTweenS cam d $ \t -> do
1225 oTranslate._1 %= \v -> fromToS v x t
1226 oTranslate._2 %= \v -> fromToS v y t