From d37e71ca9464b71719892e1ab666f6f38eadaf02 Mon Sep 17 00:00:00 2001 From: David Himmelstrup Date: Sat, 19 Sep 2020 22:17:51 +0800 Subject: [PATCH] Use V2 instead of tuples and rename 'sceneAnimation' to 'scene'. (#165) --- examples/bug_play1.hs | 2 +- examples/bug_play2.hs | 2 +- examples/bug_play3.hs | 2 +- examples/bug_quad.hs | 2 +- examples/demo_stars.hs | 2 +- examples/doc_applyVar.hs | 2 +- examples/doc_cameraAttach.hs | 2 +- examples/doc_cameraFocus.hs | 11 ++- examples/doc_destroySprite.hs | 2 +- examples/doc_fork.hs | 2 +- examples/doc_newSprite.hs | 2 +- examples/doc_newSpriteA'.hs | 2 +- examples/doc_newSpriteA.hs | 2 +- examples/doc_newSpriteSVG.hs | 2 +- examples/doc_play.hs | 2 +- examples/doc_queryNow.hs | 2 +- examples/doc_simpleVar.hs | 2 +- examples/doc_spriteE.hs | 2 +- examples/doc_spriteMap.hs | 2 +- examples/doc_spriteScope.hs | 2 +- examples/doc_spriteTween.hs | 2 +- examples/doc_spriteVar.hs | 2 +- examples/doc_spriteZ.hs | 2 +- examples/doc_unVar.hs | 2 +- examples/doc_wait.hs | 2 +- examples/doc_waitOn.hs | 2 +- examples/doc_writeVar.hs | 2 +- examples/fe_bleed.hs | 2 +- examples/fe_morph.hs | 2 +- examples/intro_canvas.hs | 2 +- examples/intro_canvas_square.hs | 2 +- examples/knock_knock.hs | 2 +- examples/latex_wheel.hs | 2 +- examples/morphology_closest.hs | 2 +- examples/morphology_color.hs | 2 +- examples/morphology_intro.hs | 2 +- examples/morphology_linear.hs | 2 +- examples/morphology_object_correspondence.hs | 2 +- examples/morphology_point_correspondence.hs | 2 +- examples/morphology_rotational.hs | 2 +- examples/morphology_rotational_intro.hs | 2 +- examples/scene_camera.hs | 97 +------------------- examples/tut_glue_blender.hs | 6 +- examples/tut_glue_fourier.hs | 2 +- examples/tut_glue_keyframe.hs | 2 +- examples/tut_glue_latex.hs | 4 +- examples/tut_glue_potrace.hs | 2 +- examples/tut_glue_povray.hs | 6 +- examples/tut_glue_povray_ortho.hs | 6 +- examples/voice_advanced.hs | 2 +- examples/voice_fake.hs | 2 +- examples/voice_transcript.hs | 2 +- examples/voice_triggers.hs | 2 +- playground/snippets/01_Composition.hs | 2 +- playground/snippets/02_Color Maps.hs | 2 +- playground/snippets/04_Basic Objects.hs | 2 +- playground/snippets/05_LaTeX.hs | 2 +- playground/snippets/06_Easing Functions.hs | 2 +- playground/snippets/07_Easing Graphs.hs | 2 +- playground/snippets/08_Object Positions.hs | 6 +- playground/snippets/09_Camera.hs | 4 +- src/Reanimate.hs | 2 +- src/Reanimate/Scene.hs | 5 +- src/Reanimate/Scene/Core.hs | 6 +- src/Reanimate/Scene/Object.hs | 83 ++++++++++------- src/Reanimate/Scene/Sprite.hs | 4 +- videos/color-theory/color-theory.hs | 2 +- videos/showcase/showcase.hs | 6 +- 68 files changed, 140 insertions(+), 214 deletions(-) diff --git a/examples/bug_play1.hs b/examples/bug_play1.hs index b5e24f1..424cca5 100755 --- a/examples/bug_play1.hs +++ b/examples/bug_play1.hs @@ -6,6 +6,6 @@ import Reanimate -- This should give circle. main :: IO () -main = reanimate $ signalA (constantS 0) $ sceneAnimation $ do +main = reanimate $ signalA (constantS 0) $ scene $ do play $ animate $ const $ mkCircle 1 play $ animate $ const $ mkRect 1 1 diff --git a/examples/bug_play2.hs b/examples/bug_play2.hs index eb5e950..3352409 100755 --- a/examples/bug_play2.hs +++ b/examples/bug_play2.hs @@ -6,6 +6,6 @@ import Reanimate -- This should give rect. main :: IO () -main = reanimate $ signalA (constantS 0.5) $ sceneAnimation $ do +main = reanimate $ signalA (constantS 0.5) $ scene $ do play $ animate $ const $ mkCircle 1 play $ animate $ const $ mkRect 1 1 diff --git a/examples/bug_play3.hs b/examples/bug_play3.hs index 7008775..ba12ba1 100755 --- a/examples/bug_play3.hs +++ b/examples/bug_play3.hs @@ -6,6 +6,6 @@ import Reanimate -- This should give rect. main :: IO () -main = reanimate $ signalA (constantS 1) $ sceneAnimation $ do +main = reanimate $ signalA (constantS 1) $ scene $ do play $ animate $ const $ mkCircle 1 play $ animate $ const $ mkRect 1 1 diff --git a/examples/bug_quad.hs b/examples/bug_quad.hs index b7c1e9d..a723677 100755 --- a/examples/bug_quad.hs +++ b/examples/bug_quad.hs @@ -8,7 +8,7 @@ import Reanimate.Morph.Common import Reanimate.Morph.Linear main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do play $ animate $ \t -> morph rawLinear src dst t where src = mkPathString "M 0 0 q 1 1, 2 0 z" diff --git a/examples/demo_stars.hs b/examples/demo_stars.hs index 710858b..b31b9ca 100755 --- a/examples/demo_stars.hs +++ b/examples/demo_stars.hs @@ -23,7 +23,7 @@ import Codec.Picture.Types import qualified Data.Vector as V main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor play $ trails 0.05 starAnimation diff --git a/examples/doc_applyVar.hs b/examples/doc_applyVar.hs index e7fcb09..b9456a9 100755 --- a/examples/doc_applyVar.hs +++ b/examples/doc_applyVar.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do s <- fork $ newSpriteA drawBox v <- newVar 0 applyVar v s rotate diff --git a/examples/doc_cameraAttach.hs b/examples/doc_cameraAttach.hs index cd00dc9..bd1b6dc 100755 --- a/examples/doc_cameraAttach.hs +++ b/examples/doc_cameraAttach.hs @@ -8,7 +8,7 @@ import Reanimate.Scene import Control.Lens main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do cam <- newObject Camera circ <- newObject $ Circle 2 oModifyS circ $ diff --git a/examples/doc_cameraFocus.hs b/examples/doc_cameraFocus.hs index ca80b97..f805438 100755 --- a/examples/doc_cameraFocus.hs +++ b/examples/doc_cameraFocus.hs @@ -6,20 +6,21 @@ import Reanimate import Reanimate.Builtin.Documentation import Reanimate.Scene import Control.Lens +import Linear.V2 main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do cam <- newObject Camera circ <- newObject $ Circle 2; oShow circ - oModify circ $ oTranslate .~ (-3,0) + oModify circ $ oTranslate .~ V2 (-3) 0 box <- newObject $ Rectangle 4 4; oShow box - oModify box $ oTranslate .~ (3,0) + oModify box $ oTranslate .~ V2 3 0 cameraAttach cam circ cameraAttach cam box - cameraFocus cam (-3,0) + cameraFocus cam (V2 (-3) 0) cameraZoom cam 2 2 cameraZoom cam 2 1 - cameraFocus cam (3,0) + cameraFocus cam (V2 3 0) cameraZoom cam 2 2 cameraZoom cam 2 1 diff --git a/examples/doc_destroySprite.hs b/examples/doc_destroySprite.hs index 0339983..c0686f9 100755 --- a/examples/doc_destroySprite.hs +++ b/examples/doc_destroySprite.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do s <- newSpriteSVG $ withFillOpacity 1 $ mkCircle 1 fork $ wait 1 >> destroySprite s play drawBox diff --git a/examples/doc_fork.hs b/examples/doc_fork.hs index 737a23e..2fbdcab 100755 --- a/examples/doc_fork.hs +++ b/examples/doc_fork.hs @@ -6,6 +6,6 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do fork $ play drawBox play drawCircle diff --git a/examples/doc_newSprite.hs b/examples/doc_newSprite.hs index 0914fd9..2b87ee2 100755 --- a/examples/doc_newSprite.hs +++ b/examples/doc_newSprite.hs @@ -6,6 +6,6 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do _ <- newSprite $ mkCircle <$> spriteT -- Circle sprite where radius=time. wait 2 diff --git a/examples/doc_newSpriteA'.hs b/examples/doc_newSpriteA'.hs index 8b08cca..f5295da 100755 --- a/examples/doc_newSpriteA'.hs +++ b/examples/doc_newSpriteA'.hs @@ -7,7 +7,7 @@ import Reanimate.Animation import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do _ <- fork $ newSpriteA' SyncFreeze drawCircle play drawBox play $ reverseA drawBox diff --git a/examples/doc_newSpriteA.hs b/examples/doc_newSpriteA.hs index f49b8ea..7679240 100755 --- a/examples/doc_newSpriteA.hs +++ b/examples/doc_newSpriteA.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do _ <- fork $ newSpriteA drawCircle play drawBox play $ reverseA drawBox diff --git a/examples/doc_newSpriteSVG.hs b/examples/doc_newSpriteSVG.hs index 51bcb9a..667b8c4 100755 --- a/examples/doc_newSpriteSVG.hs +++ b/examples/doc_newSpriteSVG.hs @@ -6,6 +6,6 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do _ <- newSpriteSVG $ mkBackground "lightblue" play drawCircle diff --git a/examples/doc_play.hs b/examples/doc_play.hs index 95a762c..b54bfe0 100755 --- a/examples/doc_play.hs +++ b/examples/doc_play.hs @@ -6,6 +6,6 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do play drawBox play drawCircle diff --git a/examples/doc_queryNow.hs b/examples/doc_queryNow.hs index 7fca8d7..8b9fbad 100755 --- a/examples/doc_queryNow.hs +++ b/examples/doc_queryNow.hs @@ -8,7 +8,7 @@ import Reanimate.Builtin.Documentation import qualified Data.Text as T main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do now <- play drawCircle *> queryNow play $ staticFrame 1 $ scale 2 $ withStrokeWidth 0.05 $ mkText $ "Now=" <> T.pack (show now) diff --git a/examples/doc_simpleVar.hs b/examples/doc_simpleVar.hs index d92911a..5fdbbaa 100755 --- a/examples/doc_simpleVar.hs +++ b/examples/doc_simpleVar.hs @@ -6,6 +6,6 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do var <- simpleVar mkCircle 0 tweenVar var 2 $ \val -> fromToS val (screenHeight/2) diff --git a/examples/doc_spriteE.hs b/examples/doc_spriteE.hs index 7ab1bd0..8f522f0 100755 --- a/examples/doc_spriteE.hs +++ b/examples/doc_spriteE.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do s <- fork $ newSpriteA drawCircle spriteE s $ overBeginning 1 fadeInE spriteE s $ overEnding 0.5 fadeOutE diff --git a/examples/doc_spriteMap.hs b/examples/doc_spriteMap.hs index 6759c90..9c6acc1 100755 --- a/examples/doc_spriteMap.hs +++ b/examples/doc_spriteMap.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do s <- fork $ newSpriteA drawCircle wait 1 spriteMap s flipYAxis diff --git a/examples/doc_spriteScope.hs b/examples/doc_spriteScope.hs index c7e87a5..8f3d150 100755 --- a/examples/doc_spriteScope.hs +++ b/examples/doc_spriteScope.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do -- the rect lives through the entire 3s animation newSpriteSVG_ $ translate (-3) 0 $ mkRect 4 4 wait 1 diff --git a/examples/doc_spriteTween.hs b/examples/doc_spriteTween.hs index dc87934..28a0d29 100755 --- a/examples/doc_spriteTween.hs +++ b/examples/doc_spriteTween.hs @@ -6,6 +6,6 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do s <- fork $ newSpriteA drawCircle spriteTween s 1 $ \val -> translate (screenWidth*0.3*val) 0 diff --git a/examples/doc_spriteVar.hs b/examples/doc_spriteVar.hs index eba6061..1feb5a4 100755 --- a/examples/doc_spriteVar.hs +++ b/examples/doc_spriteVar.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do s <- fork $ newSpriteA drawBox v <- spriteVar s 0 rotate tweenVar v 2 $ \val -> fromToS val 90 diff --git a/examples/doc_spriteZ.hs b/examples/doc_spriteZ.hs index 38a1100..98df34b 100755 --- a/examples/doc_spriteZ.hs +++ b/examples/doc_spriteZ.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do s1 <- newSpriteSVG $ withFillOpacity 1 $ withFillColor "blue" $ mkCircle 3 _ <- newSpriteSVG $ withFillOpacity 1 $ withFillColor "red" $ mkRect 8 3 wait 1 diff --git a/examples/doc_unVar.hs b/examples/doc_unVar.hs index e46f8d0..3493c34 100755 --- a/examples/doc_unVar.hs +++ b/examples/doc_unVar.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do v <- newVar 0 _ <- newSprite $ mkCircle <$> unVar v tweenVar v 1 $ \val -> fromToS val 3 diff --git a/examples/doc_wait.hs b/examples/doc_wait.hs index 3497b01..56a53f9 100755 --- a/examples/doc_wait.hs +++ b/examples/doc_wait.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do fork $ play drawBox wait 1 play drawCircle diff --git a/examples/doc_waitOn.hs b/examples/doc_waitOn.hs index fc56e40..e5027a7 100755 --- a/examples/doc_waitOn.hs +++ b/examples/doc_waitOn.hs @@ -6,6 +6,6 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do waitOn $ fork $ play drawBox play drawCircle diff --git a/examples/doc_writeVar.hs b/examples/doc_writeVar.hs index 826b865..a7bd92a 100755 --- a/examples/doc_writeVar.hs +++ b/examples/doc_writeVar.hs @@ -6,7 +6,7 @@ import Reanimate import Reanimate.Builtin.Documentation main :: IO () -main = reanimate $ docEnv $ sceneAnimation $ do +main = reanimate $ docEnv $ scene $ do v <- newVar 0 _ <- newSprite $ mkCircle <$> unVar v writeVar v 1; wait 1 diff --git a/examples/fe_bleed.hs b/examples/fe_bleed.hs index ec17817..d60d8f1 100755 --- a/examples/fe_bleed.hs +++ b/examples/fe_bleed.hs @@ -61,7 +61,7 @@ whiteGithub = withFillOpacity 1 $ withFillColor "white" $ scaleToHeight screenHeight $ center $ unpackImage githubIcon main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do newSpriteSVG_ $ mkBackground "white" -- newSpriteSVG_ $ -- mkClipPath "clip" $ diff --git a/examples/fe_morph.hs b/examples/fe_morph.hs index e5e38c1..f95ea1a 100755 --- a/examples/fe_morph.hs +++ b/examples/fe_morph.hs @@ -22,7 +22,7 @@ import Graphics.SvgTree import Reanimate main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do newSpriteSVG_ $ mkBackground "white" let circles = [ (900, 0.3) diff --git a/examples/intro_canvas.hs b/examples/intro_canvas.hs index 084cbb6..8749f3c 100644 --- a/examples/intro_canvas.hs +++ b/examples/intro_canvas.hs @@ -18,7 +18,7 @@ import Geom2D.CubicBezier.Linear import Text.Printf main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor newSpriteSVG_ static dotPath <- newVar (QuadBezier (V2 0 0) (V2 0 0) (V2 0 0)) diff --git a/examples/intro_canvas_square.hs b/examples/intro_canvas_square.hs index 99a53c1..0c6402b 100644 --- a/examples/intro_canvas_square.hs +++ b/examples/intro_canvas_square.hs @@ -22,7 +22,7 @@ newWidth = 8 newHeight = 8 main :: IO () -main = reanimate $ mapA squareViewBox $ sceneAnimation $ do +main = reanimate $ mapA squareViewBox $ scene $ do newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor newSpriteSVG_ static dotPath <- newVar (QuadBezier (V2 0 0) (V2 0 0) (V2 0 0)) diff --git a/examples/knock_knock.hs b/examples/knock_knock.hs index 993c30d..1856625 100755 --- a/examples/knock_knock.hs +++ b/examples/knock_knock.hs @@ -12,7 +12,7 @@ import Reanimate.LaTeX import Reanimate.Scene main :: IO () -main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do +main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ scene $ do line1 <- newLaTeX ["$>$ ", "knock!", " ", "knock!"] oModifyMany line1 $ oTopY .~ screenTop diff --git a/examples/latex_wheel.hs b/examples/latex_wheel.hs index 1590d04..75ddd20 100755 --- a/examples/latex_wheel.hs +++ b/examples/latex_wheel.hs @@ -15,7 +15,7 @@ main = reanimate $ bg `parA` mainScene bg = animate $ const $ mkBackground "black" mainScene :: Animation -mainScene = sceneAnimation $ mdo +mainScene = scene $ mdo play $ drawCircle & setDuration drawCircleT & applyE (constE $ scaleXY (-1) 1) diff --git a/examples/morphology_closest.hs b/examples/morphology_closest.hs index 988883d..963228e 100755 --- a/examples/morphology_closest.hs +++ b/examples/morphology_closest.hs @@ -23,7 +23,7 @@ main = reanimate $ mapA (withStrokeColor "black") $ mapA (withStrokeLineJoin JoinRound) $ mapA (withFillOpacity 1) $ - sceneAnimation $ do + scene $ do _ <- newSpriteSVG $ withStrokeWidth 0 $ translate (-4) 4 $ center $ latex "no-op" diff --git a/examples/morphology_color.hs b/examples/morphology_color.hs index b3966f5..bf84794 100755 --- a/examples/morphology_color.hs +++ b/examples/morphology_color.hs @@ -19,7 +19,7 @@ main = reanimate $ setDuration 5 $ mapA (withStrokeWidth 0) $ mapA (withFillOpacity 1) $ - sceneAnimation $ do + scene $ do doMorph yellow blue doMorph blue yellow where diff --git a/examples/morphology_intro.hs b/examples/morphology_intro.hs index 682114c..94c9b42 100755 --- a/examples/morphology_intro.hs +++ b/examples/morphology_intro.hs @@ -19,7 +19,7 @@ main = reanimate $ mapA (withStrokeWidth 0) $ mapA (withStrokeColor "black") $ mapA (withFillOpacity 1) $ - sceneAnimation $ do + scene $ do play $ step stage1 stage2 play $ step stage2 stage3 play $ step stage3 stage4 diff --git a/examples/morphology_linear.hs b/examples/morphology_linear.hs index d9c17c9..13498f7 100755 --- a/examples/morphology_linear.hs +++ b/examples/morphology_linear.hs @@ -22,7 +22,7 @@ main = reanimate $ mapA (withStrokeColor "black") $ mapA (withStrokeLineJoin JoinRound) $ mapA (withFillOpacity 1) $ - sceneAnimation $ + scene $ showPair (stages ++ take 1 stages) where showPair (from:to:rest) = diff --git a/examples/morphology_object_correspondence.hs b/examples/morphology_object_correspondence.hs index f428b62..231b647 100755 --- a/examples/morphology_object_correspondence.hs +++ b/examples/morphology_object_correspondence.hs @@ -19,7 +19,7 @@ main = reanimate $ mapA (withStrokeWidth 0) $ mapA (withStrokeColor "black") $ mapA (withFillOpacity 1) $ - sceneAnimation $ do + scene $ do let showLabel label = do fork $ play $ staticFrame 4 (center $ latex label) & mapA (translate 0 4) diff --git a/examples/morphology_point_correspondence.hs b/examples/morphology_point_correspondence.hs index 5ea85b8..87d459f 100755 --- a/examples/morphology_point_correspondence.hs +++ b/examples/morphology_point_correspondence.hs @@ -26,7 +26,7 @@ main = reanimate $ mapA (withStrokeWidth 0) $ mapA (withStrokeColor "black") $ mapA (withFillOpacity 1) $ - sceneAnimation $ do + scene $ do let pl1 = translate (-4) 0 $ mkGroup [ lowerTransformations $ scale 3 $ withFillOpacity 1 $ withStrokeColor "black" $ diff --git a/examples/morphology_rotational.hs b/examples/morphology_rotational.hs index 7662c8b..f2991e7 100755 --- a/examples/morphology_rotational.hs +++ b/examples/morphology_rotational.hs @@ -24,7 +24,7 @@ main = reanimate $ mapA (withStrokeColor "black") $ mapA (withStrokeLineJoin JoinRound) $ mapA (withFillOpacity 1) $ - sceneAnimation $ do + scene $ do _ <- newSpriteSVG $ withStrokeWidth 0 $ translate (-3) 4 $ center $ latex "linear" diff --git a/examples/morphology_rotational_intro.hs b/examples/morphology_rotational_intro.hs index f1dd8aa..66f5d3f 100755 --- a/examples/morphology_rotational_intro.hs +++ b/examples/morphology_rotational_intro.hs @@ -43,7 +43,7 @@ main = reanimate $ mapA (withStrokeColor "black") $ mapA (withStrokeLineJoin JoinRound) $ mapA (withFillOpacity 1) $ - sceneAnimation $ do + scene $ do _ <- newSpriteSVG $ withStrokeWidth 0 $ translate (-4) 4 $ center $ latex "linear" diff --git a/examples/scene_camera.hs b/examples/scene_camera.hs index 139a118..5105090 100755 --- a/examples/scene_camera.hs +++ b/examples/scene_camera.hs @@ -7,101 +7,10 @@ import Reanimate import Reanimate.Builtin.Documentation import Reanimate.Scene import Control.Lens +import Linear.V2 main :: IO () -{- -main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do - cam <- newObject Camera - - newSpriteSVG_ $ withStrokeWidth (defaultStrokeWidth*0.5) $ mkGroup - [ mkLine (0, screenBottom) (0, screenTop) - , mkLine (screenLeft, 0) (screenRight, 0) - ] - - box <- newObject $ Rectangle 1 1 - cameraAttach cam box - oModify box $ oContext .~ withFillColor "green" - oModify box $ oMargin .~ (0,0,0,0) - oModify box $ oLeftX .~ 0 - oModify box $ oBottomY .~ 0 - oModify box $ oContext .~ withStrokeWidth 0 - - box2 <- newObject $ Rectangle 1 1 - cameraAttach cam box2 - oModify box2 $ oContext .~ withFillColor "blue" - oModify box2 $ oMargin .~ (0,0,0,0) - oModify box2 $ oCenterXY .~ (-2,2) - oModify box2 $ oContext .~ withStrokeWidth 0 - - dot <- newObject $ Circle 0.05 - cameraAttach cam dot - oModify dot $ oContext .~ withFillColor "red" - oModify dot $ oMargin .~ (0,0,0,0) - oModify dot $ oCenterXY .~ (0.5,0.5) - oModify dot $ oContext .~ withStrokeWidth 0 - - dot2 <- newObject $ Circle 0.05 - cameraAttach cam dot2 - oModify dot2 $ oContext .~ withFillColor "red" - oModify dot2 $ oMargin .~ (0,0,0,0) - oModify dot2 $ oCenterXY .~ (-2,2) - oModify dot2 $ oContext .~ withStrokeWidth 0 - - oShow box - oShow box2 - oShow dot - oShow dot2 - - wait 1 - - cameraSetFocus cam (0.5, 0.5) - waitOn $ do - fork $ cameraPan cam 1 (0.5, 0.5) - fork $ cameraZoom cam 1 2 - wait 1 - cameraSetFocus cam (-2,2) - cameraZoom cam 0.5 1.5 - cameraZoom cam 0.5 2 - wait 1 - -- cameraSetFocus cam (-0.5,0.5) - waitOn $ do - fork $ cameraPan cam 1 (-2, 2) - fork $ cameraZoom cam 1 0.5 - -- oTweenS cam 2 $ \t -> do - -- oScale %= \v -> fromToS v 3 t - - -- cameraSetFocus cam (0.5,0.5) - - -- oTweenS cam 1 $ \t -> do - -- oScale %= \v -> fromToS v 1 t - -- wait 4 - -- oTweenS cam 2 $ \t -> do - -- oScaleOrigin .= (fromToS 0.5 (-2) t, fromToS 0.5 2 t) - -- oScale .= fromToS 2 1 t - -- oTranslate . _1 %= \v -> fromToS v (-2) t - -- oTranslate . _2 %= \v -> fromToS v 2 t - {- - Origin: (-2,2) - Translate: (3, -1) - New origin: (0.5, 0.5) - - (0.5, 0.5) - (0.5+2, 0.5-2) - (2.5, -1.5) origin move - (2.5*3, -1.5*3) - (7.5, -4.5) scale - (7.5-2, -4.5+2) - (5.5, -2.5) origin move back - (5.5-3, -2.5+1) - (2.5, -1.5) translate - - (0.5-2.5, 0.5-(-1.5)) - (-2, 2) - -} - - wait 1 --} -main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do +main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ scene $ do cam <- newObject Camera txt <- newObject $ center $ latex "Fixed (non-cam)" @@ -141,4 +50,4 @@ main = reanimate $ docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do waitOn $ do fork $ cameraZoom cam 3 1 waitOn $ do - fork $ cameraPan cam 1 (0,0) + fork $ cameraPan cam 1 (V2 0 0) diff --git a/examples/tut_glue_blender.hs b/examples/tut_glue_blender.hs index 1377079..0e775e5 100755 --- a/examples/tut_glue_blender.hs +++ b/examples/tut_glue_blender.hs @@ -22,7 +22,7 @@ import "random-shuffle" System.Random.Shuffle -- spritePercent = (/) <$> spriteT <*> spriteDur main :: IO () -main = seq texture $ reanimate $ pauseAtEnd 1 $ addStatic bg $ sceneAnimation $ do +main = seq texture $ reanimate $ pauseAtEnd 1 $ addStatic bg $ scene $ do bend <- newVar 0 trans <- newVar 0 rotX <- newVar 0 @@ -200,7 +200,7 @@ checker w h = latexExample :: Animation -latexExample = sceneAnimation $ do +latexExample = scene $ do -- Draw equation play $ drawAnimation strokedSvg sprites <- forM glyphs $ \(fn, _, elt) -> @@ -250,7 +250,7 @@ drawAnimation :: SVG -> Animation drawAnimation = drawAnimation' Nothing 0.5 0.3 drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation -drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do +drawAnimation' mbSeed fillDur step svg = scene $ do forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do let sWidth = case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of diff --git a/examples/tut_glue_fourier.hs b/examples/tut_glue_fourier.hs index 4cf72be..53b89f9 100755 --- a/examples/tut_glue_fourier.hs +++ b/examples/tut_glue_fourier.hs @@ -12,7 +12,7 @@ import Reanimate -- layer 3 main :: IO () -main = reanimate $ setDuration 30 $ sceneAnimation $ do +main = reanimate $ setDuration 30 $ scene $ do _ <- newSpriteSVG $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF) play $ fourierA (fromToS 0 5) -- Rotate 15 times & setDuration 50 diff --git a/examples/tut_glue_keyframe.hs b/examples/tut_glue_keyframe.hs index a01d269..5d2c276 100755 --- a/examples/tut_glue_keyframe.hs +++ b/examples/tut_glue_keyframe.hs @@ -21,7 +21,7 @@ main = reanimate $ bg `parA` mainScene bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF) mainScene :: Animation -mainScene = sceneAnimation $ mdo +mainScene = scene $ mdo play $ drawCircle & setDuration drawCircleT & applyE (constE flipXAxis) diff --git a/examples/tut_glue_latex.hs b/examples/tut_glue_latex.hs index 0c6b25c..04c7365 100755 --- a/examples/tut_glue_latex.hs +++ b/examples/tut_glue_latex.hs @@ -22,7 +22,7 @@ main = reanimate $ parA bg latexExample bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF) latexExample :: Animation -latexExample = sceneAnimation $ do +latexExample = scene $ do -- Draw equation play $ drawAnimation strokedSvg sprites <- forM glyphs $ \(fn, _, elt) -> @@ -72,7 +72,7 @@ drawAnimation :: SVG -> Animation drawAnimation = drawAnimation' Nothing 0.5 0.3 drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation -drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do +drawAnimation' mbSeed fillDur step svg = scene $ do forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do let sWidth = case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of diff --git a/examples/tut_glue_potrace.hs b/examples/tut_glue_potrace.hs index d118c1a..acfc46e 100755 --- a/examples/tut_glue_potrace.hs +++ b/examples/tut_glue_potrace.hs @@ -15,7 +15,7 @@ import qualified Data.Text as T import NeatInterpolation main :: IO () -main = reanimate $ parA bg $ sceneAnimation $ do +main = reanimate $ parA bg $ scene $ do play $ mkAnimation drawDuration $ \t -> partialSvg t (wireframe (-45) 220) xRot <- newVar (-45) yRot <- newVar 220 diff --git a/examples/tut_glue_povray.hs b/examples/tut_glue_povray.hs index faa733c..ae4957a 100755 --- a/examples/tut_glue_povray.hs +++ b/examples/tut_glue_povray.hs @@ -23,7 +23,7 @@ import "random-shuffle" System.Random.Shuffle main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do newSpriteSVG $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF zPos <- newVar 0 xRot <- newVar 0 @@ -93,7 +93,7 @@ polygon { latexExample :: Animation -latexExample = sceneAnimation $ do +latexExample = scene $ do -- Draw equation play $ drawAnimation strokedSvg sprites <- forM glyphs $ \(fn, _, elt) -> @@ -143,7 +143,7 @@ drawAnimation :: SVG -> Animation drawAnimation = drawAnimation' Nothing 0.5 0.3 drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation -drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do +drawAnimation' mbSeed fillDur step svg = scene $ do forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do let sWidth = case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of diff --git a/examples/tut_glue_povray_ortho.hs b/examples/tut_glue_povray_ortho.hs index 49bd52a..752c290 100755 --- a/examples/tut_glue_povray_ortho.hs +++ b/examples/tut_glue_povray_ortho.hs @@ -23,7 +23,7 @@ import "random-shuffle" System.Random.Shuffle main :: IO () -main = reanimate $ parA bg $ sceneAnimation $ do +main = reanimate $ parA bg $ scene $ do xRot <- newVar (-30) yRot <- newVar 180 zRot <- newVar 0 @@ -131,7 +131,7 @@ checker w h = latexExample :: Animation -latexExample = sceneAnimation $ do +latexExample = scene $ do -- Draw equation play $ drawAnimation strokedSvg sprites <- forM glyphs $ \(fn, _, elt) -> @@ -181,7 +181,7 @@ drawAnimation :: SVG -> Animation drawAnimation = drawAnimation' Nothing 0.5 0.3 drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation -drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do +drawAnimation' mbSeed fillDur step svg = scene $ do forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do let sWidth = case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of diff --git a/examples/voice_advanced.hs b/examples/voice_advanced.hs index a0016a3..e514d56 100644 --- a/examples/voice_advanced.hs +++ b/examples/voice_advanced.hs @@ -19,7 +19,7 @@ transcript :: Transcript transcript = loadTranscript "voice_advanced.txt" main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do bg <- newSpriteSVG $ mkBackgroundPixel rtfdBackgroundColor spriteZ bg (-100) newSpriteSVG_ $ mkGroup diff --git a/examples/voice_fake.hs b/examples/voice_fake.hs index 88b2d2b..06cfb6b 100644 --- a/examples/voice_fake.hs +++ b/examples/voice_fake.hs @@ -21,7 +21,7 @@ transcript = \during development" main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor waitOn $ forM_ (splitTranscript transcript) $ \(svg, tword) -> do highlighted <- newVar 0 diff --git a/examples/voice_transcript.hs b/examples/voice_transcript.hs index 879e7ee..331a2b0 100644 --- a/examples/voice_transcript.hs +++ b/examples/voice_transcript.hs @@ -15,7 +15,7 @@ transcript :: Transcript transcript = loadTranscript "voice_transcript.txt" main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor waitOn $ forM_ (splitTranscript transcript) $ \(svg, tword) -> fork $ do let render v = centerUsing (latex $ transcriptText transcript) $ masked diff --git a/examples/voice_triggers.hs b/examples/voice_triggers.hs index 760f10a..d935560 100644 --- a/examples/voice_triggers.hs +++ b/examples/voice_triggers.hs @@ -20,7 +20,7 @@ transformer = translate (-4) 0 . centerUsing (latex $ transcriptText transcript) main :: IO () -main = reanimate $ sceneAnimation $ do +main = reanimate $ scene $ do newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor waitOn $ forM_ (splitTranscript transcript) $ \(svg, tword) -> do let render v = transformer $ masked (wordKey tword) diff --git a/playground/snippets/01_Composition.hs b/playground/snippets/01_Composition.hs index 45c07f3..1fc4026 100644 --- a/playground/snippets/01_Composition.hs +++ b/playground/snippets/01_Composition.hs @@ -1,5 +1,5 @@ animation :: Animation -animation = docEnv $ sceneAnimation $ do +animation = docEnv $ scene $ do play $ drawBox `parA` drawCircle & label "parA" play $ drawBox `seqA` drawCircle diff --git a/playground/snippets/02_Color Maps.hs b/playground/snippets/02_Color Maps.hs index b2a4c8c..84bd720 100644 --- a/playground/snippets/02_Color Maps.hs +++ b/playground/snippets/02_Color Maps.hs @@ -1,5 +1,5 @@ animation :: Animation -animation = docEnv $ sceneAnimation $ do +animation = docEnv $ scene $ do play $ staticFrame 1 (showColorMap parula) & label "Parula" play $ staticFrame 1 (showColorMap viridis) diff --git a/playground/snippets/04_Basic Objects.hs b/playground/snippets/04_Basic Objects.hs index 0d95bb0..76b84e2 100644 --- a/playground/snippets/04_Basic Objects.hs +++ b/playground/snippets/04_Basic Objects.hs @@ -4,7 +4,7 @@ env = animation :: Animation animation = env $ - sceneAnimation $ do + scene $ do circ <- newObject $ Circle 3 oModify circ $ oContext .~ withFillColor "pink" diff --git a/playground/snippets/05_LaTeX.hs b/playground/snippets/05_LaTeX.hs index 9c68d3c..277e92e 100644 --- a/playground/snippets/05_LaTeX.hs +++ b/playground/snippets/05_LaTeX.hs @@ -4,7 +4,7 @@ env = animation :: Animation animation = env $ - sceneAnimation $ do + scene $ do drawLatex "e^{i\\pi}+1=0" drawLatex "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" drawLatex "\\sum_{k=1}^\\infty" diff --git a/playground/snippets/06_Easing Functions.hs b/playground/snippets/06_Easing Functions.hs index 647250f..598c534 100644 --- a/playground/snippets/06_Easing Functions.hs +++ b/playground/snippets/06_Easing Functions.hs @@ -1,5 +1,5 @@ animation :: Animation -animation = docEnv $ pauseAtEnd 1 $ sceneAnimation $ do +animation = docEnv $ pauseAtEnd 1 $ scene $ do showEasing 0 "curveS" (curveS 2) showEasing 1 "bellS" (bellS 2) showEasing 2 "constantS" (constantS 0.7) diff --git a/playground/snippets/07_Easing Graphs.hs b/playground/snippets/07_Easing Graphs.hs index 6ed9890..d6fc5f7 100644 --- a/playground/snippets/07_Easing Graphs.hs +++ b/playground/snippets/07_Easing Graphs.hs @@ -10,7 +10,7 @@ fns = ] animation :: Animation -animation = docEnv $ pauseAtEnd 1 $ sceneAnimation $ do +animation = docEnv $ pauseAtEnd 1 $ scene $ do newSpriteSVG_ $ mkBackground "white" play $ signalA (curveS 2) $ animate $ \t -> partialSvg t grid newSpriteSVG_ grid diff --git a/playground/snippets/08_Object Positions.hs b/playground/snippets/08_Object Positions.hs index 781395d..1b8ba04 100644 --- a/playground/snippets/08_Object Positions.hs +++ b/playground/snippets/08_Object Positions.hs @@ -4,7 +4,7 @@ env = animation :: Animation animation = env $ - sceneAnimation $ do + scene $ do -- Configure objects txt <- newText "Center" top <- newText "Top" @@ -16,11 +16,11 @@ animation = env $ oRightX .= screenRight botR <- newText "Bottom right" oModifyS botR $ do - oTranslate .= (0, screenBottom+0.5) + oTranslateY .= screenBottom+0.5 oRightX .= screenRight botL <- newText "Bottom left" oModifyS botL $ do - oTranslate .= (0, screenBottom+0.5) + oTranslateY .= screenBottom+0.5 oLeftX .= screenLeft topL <- newText "Top left" oModifyS topL $ do diff --git a/playground/snippets/09_Camera.hs b/playground/snippets/09_Camera.hs index 7c79f23..6bb207f 100644 --- a/playground/snippets/09_Camera.hs +++ b/playground/snippets/09_Camera.hs @@ -1,5 +1,5 @@ animation :: Animation -animation = docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do +animation = docEnv $ mapA (withFillOpacity 1) $ scene $ do cam <- newObject Camera txt <- newObject $ center $ latex "Fixed (non-cam)" @@ -36,4 +36,4 @@ animation = docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do wait 2 cameraZoom cam 3 1 - cameraPan cam 1 (0,0) + cameraPan cam 1 (V2 0 0) diff --git a/src/Reanimate.hs b/src/Reanimate.hs index a9ae427..28de64b 100644 --- a/src/Reanimate.hs +++ b/src/Reanimate.hs @@ -77,7 +77,7 @@ module Reanimate -- ** Scenes Scene , ZIndex - , sceneAnimation -- :: (forall s. Scene s a) -> Animation + , scene -- :: (forall s. Scene s a) -> Animation , play -- :: Animation -> Scene s () , fork -- :: Scene s a -> Scene s a , queryNow -- :: Scene s Time diff --git a/src/Reanimate/Scene.hs b/src/Reanimate/Scene.hs index 3246cfe..84ecf51 100644 --- a/src/Reanimate/Scene.hs +++ b/src/Reanimate/Scene.hs @@ -19,7 +19,6 @@ module Reanimate.Scene Scene, ZIndex, scene, -- :: (forall s. Scene s a) -> Animation - sceneAnimation, -- :: (forall s. Scene s a) -> Animation play, -- :: Animation -> Scene s () fork, -- :: Scene s a -> Scene s a queryNow, -- :: Scene s Time @@ -77,6 +76,8 @@ module Reanimate.Scene -- ** Object Properties oTranslate, + oTranslateX, + oTranslateY, oSVG, oContext, oMargin, @@ -100,6 +101,8 @@ module Reanimate.Scene oLeftX, oRightX, oCenterXY, + oCenterX, + oCenterY, oValue, -- ** Graphics object methods diff --git a/src/Reanimate/Scene/Core.hs b/src/Reanimate/Scene/Core.hs index 509af73..1a69cfa 100644 --- a/src/Reanimate/Scene/Core.hs +++ b/src/Reanimate/Scene/Core.hs @@ -54,11 +54,7 @@ evalScene action = runST $ do -- | Render a 'Scene' to an 'Animation'. scene :: (forall s. Scene s a) -> Animation -scene = sceneAnimation - --- | Render a 'Scene' to an 'Animation'. -sceneAnimation :: (forall s. Scene s a) -> Animation -sceneAnimation action = +scene action = runST ( do (_, s, p, gens) <- unM action 0 diff --git a/src/Reanimate/Scene/Object.hs b/src/Reanimate/Scene/Object.hs index b728f15..e703bac 100644 --- a/src/Reanimate/Scene/Object.hs +++ b/src/Reanimate/Scene/Object.hs @@ -2,6 +2,8 @@ {-# LANGUAGE RecordWildCards #-} module Reanimate.Scene.Object where +import Linear.V2 +import Linear.Vector import Control.Lens import Control.Monad (forM_, void) import Control.Monad.State (State, execState) @@ -46,7 +48,7 @@ data Object s a = Object -- | Container for object properties. data ObjectData a = ObjectData - { _oTranslate :: (Double, Double), + { _oTranslate :: V2 Double, _oValueRef :: a, _oSVG :: SVG, _oContext :: SVG -> SVG, @@ -58,7 +60,7 @@ data ObjectData a = ObjectData _oZIndex :: Int, _oEasing :: Signal, _oScale :: Double, - _oScaleOrigin :: (Double, Double) + _oScaleOrigin :: V2 Double } -- Basic lenses @@ -66,9 +68,17 @@ data ObjectData a = ObjectData -- FIXME: Maybe 'position' is a better name. -- | Object position. Default: \<0,0\> -oTranslate :: Lens' (ObjectData a) (Double, Double) +oTranslate :: Lens' (ObjectData a) (V2 Double) oTranslate = lens _oTranslate $ \obj val -> obj {_oTranslate = val} +-- | Object X position. Default: 0 +oTranslateX :: Lens' (ObjectData a) Double +oTranslateX = oTranslate . _x + +-- | Object Y position. Default: 0 +oTranslateY :: Lens' (ObjectData a) Double +oTranslateY = oTranslate . _y + -- | Rendered SVG node of an object. Does not include context -- or object properties. Read-only. oSVG :: Getter (ObjectData a) SVG @@ -112,7 +122,7 @@ oScale :: Lens' (ObjectData a) Double oScale = lens _oScale $ \obj val -> oComputeBB obj {_oScale = val} -- | Origin point for scaling. Default: \<0,0\> -oScaleOrigin :: Lens' (ObjectData a) (Double, Double) +oScaleOrigin :: Lens' (ObjectData a) (V2 Double) oScaleOrigin = lens _oScaleOrigin $ \obj val -> oComputeBB obj {_oScaleOrigin = val} -- Smart lenses @@ -184,7 +194,7 @@ oRightX = lens getter setter obj & (oTranslate . _1) +~ val - getter obj -- | Derived location of an object's center point. -oCenterXY :: Lens' (ObjectData a) (Double, Double) +oCenterXY :: Lens' (ObjectData a) (V2 Double) oCenterXY = lens getter setter where getter obj = @@ -192,13 +202,21 @@ oCenterXY = lens getter setter miny = obj ^. oBBMinY w = obj ^. oBBWidth h = obj ^. oBBHeight - (dx, dy) = obj ^. oTranslate - in (dx + minx + w / 2, dy + miny + h / 2) - setter obj (dx, dy) = - let (x, y) = getter obj + V2 dx dy = obj ^. oTranslate + in V2 (dx + minx + w / 2) (dy + miny + h / 2) + setter obj (V2 dx dy) = + let V2 x y = getter obj in obj & (oTranslate . _1) +~ dx - x & (oTranslate . _2) +~ dy - y +-- | Derived location of an object's center X value. +oCenterX :: Lens' (ObjectData a) Double +oCenterX = oCenterXY . _x + +-- | Derived location of an object's center Y value. +oCenterY :: Lens' (ObjectData a) Double +oCenterY = oCenterXY . _y + -- | Object's top margin. oMarginTop :: Lens' (ObjectData a) Double oMarginTop = oMargin . _1 @@ -278,7 +296,7 @@ newObject val = do ref <- newVar ObjectData - { _oTranslate = (0, 0), + { _oTranslate = V2 0 0, _oValueRef = val, _oSVG = svg, _oContext = id, @@ -289,14 +307,14 @@ newObject val = do _oZIndex = 1, _oEasing = curveS 2, _oScale = 1, - _oScaleOrigin = (0, 0) + _oScaleOrigin = V2 0 0 } sprite <- newSprite $ do ~obj@ObjectData {..} <- unVar ref pure $ if _oShown then - uncurry translate _oTranslate $ + uncurryV2 translate _oTranslate $ oScaleApply obj $ withGroupOpacity _oOpacity $ mkGroup [_oContext _oSVG] @@ -314,9 +332,12 @@ newObject val = do oScaleApply :: ObjectData a -> (SVG -> SVG) oScaleApply ObjectData {..} = - uncurry translate (_oScaleOrigin & both %~ negate) + uncurryV2 translate (negate _oScaleOrigin) . scale _oScale - . uncurry translate _oScaleOrigin + . uncurryV2 translate _oScaleOrigin + +uncurryV2 :: (a -> a -> b) -> V2 a -> b +uncurryV2 fn (V2 a b) = fn a b ------------------------------------------------------------------------------- -- Graphical transformations @@ -463,13 +484,10 @@ oTransform src dst d = do oShown .= True oEasing .= srcEase oTranslate .= srcLoc - fork $ oTween m d $ \t -> oTranslate %~ moveTo t dstLoc + fork $ oTween m d $ \t -> oTranslate %~ lerp t dstLoc oTweenV m d $ \t -> morphDelta .~ t oModify m $ oShown .~ False oModify dst $ oShown .~ True - where - moveTo t (dstX, dstY) (srcX, srcY) = - (fromToS srcX dstX t, fromToS srcY dstY t) ------------------------------------------------------------------------------- -- Built-in objects @@ -547,12 +565,12 @@ cameraAttach cam obj = spriteModify (objectSprite obj) $ do camData <- unVar (objectData cam) return $ \(svg, zindex) -> - let (x, y) = camData ^. oTranslate + let V2 x y = camData ^. oTranslate ctx = translate (- x) (- y) - . uncurry translate (camData ^. oScaleOrigin) + . uncurryV2 translate (camData ^. oScaleOrigin) . scale (camData ^. oScale) - . uncurry translate (camData ^. oScaleOrigin & both %~ negate) + . uncurryV2 translate (negate $ camData ^. oScaleOrigin) in (ctx svg, zindex) -- | @@ -576,15 +594,15 @@ cameraAttach cam obj = -- @ -- -- <> -cameraFocus :: Object s Camera -> (Double, Double) -> Scene s () -cameraFocus cam (x, y) = do - (ox, oy) <- oRead cam oScaleOrigin - (tx, ty) <- oRead cam oTranslate +cameraFocus :: Object s Camera -> V2 Double -> Scene s () +cameraFocus cam new = do + origin <- oRead cam oScaleOrigin + t <- oRead cam oTranslate s <- oRead cam oScale - let newLocation = (x - ((x - ox) * s + ox - tx), y - ((y - oy) * s + oy - ty)) + let newLocation = new - ((new - origin) ^* s + origin - t) oModifyS cam $ do oTranslate .= newLocation - oScaleOrigin .= (x, y) + oScaleOrigin .= new -- | Instantaneously set camera zoom level. cameraSetZoom :: Object s Camera -> Double -> Scene s () @@ -599,14 +617,13 @@ cameraZoom cam d s = oScale %= \v -> fromToS v s t -- | Instantaneously set camera location. -cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s () +cameraSetPan :: Object s Camera -> V2 Double -> Scene s () cameraSetPan cam location = oModifyS cam $ oTranslate .= location -- | Change camera location over a set duration. -cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s () -cameraPan cam d (x, y) = - oTweenS cam d $ \t -> do - oTranslate . _1 %= \v -> fromToS v x t - oTranslate . _2 %= \v -> fromToS v y t +cameraPan :: Object s Camera -> Duration -> V2 Double -> Scene s () +cameraPan cam d pos = + oTweenS cam d $ \t -> + oTranslate %= lerp t pos diff --git a/src/Reanimate/Scene/Sprite.hs b/src/Reanimate/Scene/Sprite.hs index dfae06d..e69b00e 100644 --- a/src/Reanimate/Scene/Sprite.hs +++ b/src/Reanimate/Scene/Sprite.hs @@ -29,7 +29,7 @@ import Reanimate.Scene.Core fork, liftST, queryNow, - sceneAnimation, + scene, wait, ) import Reanimate.Scene.Var (unpackVar, Var (..), newVar, readVar) @@ -402,7 +402,7 @@ spriteScope (M action) = M $ \t -> do asAnimation :: (forall s'. Scene s' a) -> Scene s Animation asAnimation s = do now <- queryNow - return $ dropA now (sceneAnimation (wait now >> s)) + return $ dropA now (scene (wait now >> s)) -- | Apply a transformation with a given overlap. This makes sure -- to keep timestamps intact such that events can still be timed diff --git a/videos/color-theory/color-theory.hs b/videos/color-theory/color-theory.hs index 2bca281..f6cbaf1 100755 --- a/videos/color-theory/color-theory.hs +++ b/videos/color-theory/color-theory.hs @@ -56,7 +56,7 @@ main = -- $ dropA (wordStart beginWord) -- $ takeA (wordEnd endWord) -- $ takeA 20 - $ sceneAnimation + $ scene $ do newSpriteSVG_ $ mkBackground "black" monalisaScene diff --git a/videos/showcase/showcase.hs b/videos/showcase/showcase.hs index acd88cb..455a88e 100755 --- a/videos/showcase/showcase.hs +++ b/videos/showcase/showcase.hs @@ -73,7 +73,7 @@ playbackTest :: Animation playbackTest = setDuration 10 feat3D sphereIntro :: Animation -sphereIntro = sceneAnimation $ do +sphereIntro = scene $ do -- play $ drawSphere -- # setDuration 15 -- # pauseAtEnd 2 @@ -227,7 +227,7 @@ featWireSphere = rotateWireSphere & repeatA 10 introSVG :: Animation -introSVG = sceneAnimation $ do +introSVG = scene $ do fork $ play $ animate $ const $ mkBackground "black" -- Title @@ -291,7 +291,7 @@ drawAnimation :: SVG -> Animation drawAnimation = drawAnimation' 0.5 0.3 drawAnimation' :: Double -> Double -> SVG -> Animation -drawAnimation' fillDur step svg = sceneAnimation $ do +drawAnimation' fillDur step svg = scene $ do forM_ (zip [0..] $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do let sWidth = case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of