diff --git a/hpc_index.html b/hpc_index.html index 8e46a62..09dd2d0 100644 --- a/hpc_index.html +++ b/hpc_index.html @@ -101,7 +101,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 5%1/19
0%0/53
4%39/852
  module reanimate-0.4.3.0-inplace/Reanimate.Scene -27%40/144
55%15/27
32%545/1696
+27%40/146
55%15/27
31%545/1707
  module reanimate-0.4.3.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
@@ -125,5 +125,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 100%6/6
50%1/2
95%43/45
  Program Coverage Total -30%248/814
15%131/830
29%4682/15820
+30%248/816
15%131/830
29%4682/15831
diff --git a/hpc_index_alt.html b/hpc_index_alt.html index ba71c3a..d52aa32 100644 --- a/hpc_index_alt.html +++ b/hpc_index_alt.html @@ -23,7 +23,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 90%28/31
57%8/14
87%298/341
  module reanimate-0.4.3.0-inplace/Reanimate.Scene -27%40/144
55%15/27
32%545/1696
+27%40/146
55%15/27
31%545/1707
  module reanimate-0.4.3.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
@@ -125,5 +125,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 15%3/20
- 0/0 14%7/49
  Program Coverage Total -30%248/814
15%131/830
29%4682/15820
+30%248/816
15%131/830
29%4682/15831
diff --git a/hpc_index_exp.html b/hpc_index_exp.html index bd23137..512f447 100644 --- a/hpc_index_exp.html +++ b/hpc_index_exp.html @@ -50,7 +50,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 33%5/15
5%1/20
40%133/325
  module reanimate-0.4.3.0-inplace/Reanimate.Scene -27%40/144
55%15/27
32%545/1696
+27%40/146
55%15/27
31%545/1707
  module reanimate-0.4.3.0-inplace/Geom2D.CubicBezier.Linear 20%20/99
5%2/36
28%102/356
@@ -125,5 +125,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 0%0/1
0%0/4
0%0/61
  Program Coverage Total -30%248/814
15%131/830
29%4682/15820
+30%248/816
15%131/830
29%4682/15831
diff --git a/hpc_index_fun.html b/hpc_index_fun.html index b61bbda..3e0d2b1 100644 --- a/hpc_index_fun.html +++ b/hpc_index_fun.html @@ -65,7 +65,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 33%1/3
0%0/14
21%28/128
  module reanimate-0.4.3.0-inplace/Reanimate.Scene -27%40/144
55%15/27
32%545/1696
+27%40/146
55%15/27
31%545/1707
  module reanimate-0.4.3.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
@@ -125,5 +125,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } 0%0/1
0%0/4
0%0/61
  Program Coverage Total -30%248/814
15%131/830
29%4682/15820
+30%248/816
15%131/830
29%4682/15831
diff --git a/playground/snippets.js b/playground/snippets.js index 1c4e75e..fa2b259 100644 --- a/playground/snippets.js +++ b/playground/snippets.js @@ -1,4 +1,4 @@ -const snippets = [{"title": "Hello World","url": "https://reanimate.clozecards.com/LMvAjyzwwRi/30.svg","code": "-- This is the interactive Reanimate Playground\n\n-- Here you can write Haskell code and have it\n-- render directly to your browser.\n\n-- There are more examples available if you click\n-- on the 'collections' icon to the far right\n\nanimation :: Animation\nanimation = docEnv drawBox\n"} +const snippets = [{"title": "Hello World","url": "https://reanimate.clozecards.com/NIHR92zCsdg/298.svg","code": "-- This is the interactive Reanimate Playground\n\n-- Here you can write Haskell code and have it\n-- render directly to your browser.\n\n-- There are more examples available if you click\n-- on the 'collections' icon to the far right\n\nanimation :: Animation\nanimation = scene $ do\n newSpriteSVG_ $ mkBackground \"white\"\n logo <- oNew $ center $ latex \"Reanimate\"\n oModify logo $ oScale .~ 3\n\n oShowWith logo oFadeIn\n oTweenS logo 1 $ \\t -> do\n oScale %= \\prev -> fromToS prev 2 t\n oTopY %= \\prev -> fromToS prev screenTop t\n\n haskell <- oNew $ center $ withStrokeColor \"black\" $ latex \"Haskell\"\n oModify haskell $ oScale .~ 3\n oShowWith haskell oDraw\n oTweenS haskell 1 $ \\t -> do\n oScale %= \\prev -> fromToS prev 2 t\n oBottomY %= \\prev -> fromToS prev screenBottom t\n\n features <- mapM (oNew . scale 3 . center . latex)\n [\"SVG\", \"\\\\LaTeX\", \"Animation\", \"Windows\", \"Linux\", \"MacOS\", \"Browsers\"]\n oShowWith (head features) $ adjustDuration (*3) . oScaleIn\n featureChain features\n\n wait (-1)\n fork $ oHideWith logo oFadeOut\n fork $ oHideWith haskell oFadeOut\n\nreplace :: Object s a -> Object s b -> Scene s ()\nreplace a b = do\n fork $ oHideWith a $ adjustDuration (*3) . oScaleOut\n wait 0.2\n oShowWith b $ adjustDuration (*3) . oScaleIn\n\nfeatureChain :: [Object s a] -> Scene s ()\nfeatureChain (x:y:xs) = do\n replace x y\n featureChain (y:xs)\nfeatureChain [x] = do\n oHideWith x $ adjustDuration (*3) . oScaleOut\nfeatureChain [] = return ()\n"} ,{"title": "Composition","url": "https://reanimate.clozecards.com/ECv3cbsbuMV/150.svg","code": "animation :: Animation\nanimation = docEnv $ sceneAnimation $ do\n play $ drawBox `parA` drawCircle\n & label \"parA\"\n play $ drawBox `seqA` drawCircle\n & label \"seqA\"\n play $ drawBox `andThen` drawCircle\n & label \"andThen\"\n\nlabel txt = addStatic $\n withFillOpacity 1 $ withStrokeWidth 0 $\n withFillColor \"black\" $\n translate screenLeft (screenBottom+0.2) $\n latex txt\n"} ,{"title": "Color Maps","url": "https://reanimate.clozecards.com/Ezuf27J2YrF/60.svg","code": "animation :: Animation\nanimation = docEnv $ sceneAnimation $ do\n play $ staticFrame 1 (showColorMap parula)\n & label \"Parula\"\n play $ staticFrame 1 (showColorMap viridis)\n & label \"Viridis\"\n play $ staticFrame 1 (showColorMap turbo)\n & label \"Turbo\"\n play $ staticFrame 1 (showColorMap greyscale)\n & label \"Greyscale\"\n\nlabel txt = overlay $\n withFillOpacity 1 $ withStrokeWidth 0 $\n withFillColor \"white\" $\n translate screenLeft (screenBottom+0.2) $\n latex txt\n\noverlay svg ani = ani `parA` staticFrame (duration ani) svg\n"} ,{"title": "Try it live","url": "https://reanimate.clozecards.com/OwjMi4FCJ4Z/90.svg","code": "background = \"lightblue\"\n\nshape :: SVG\nshape = mkCircle 4\n--shape = mkRect 6 6\n--shape = mkLine (screenLeft, screenBottom) (screenRight, screenTop)\n\nanimation :: Animation\nanimation = docEnv $\n addStatic (mkBackground background) $\n playThenReverseA $\n signalA (curveS 2) $\n setDuration 3 $ animate $ \\t ->\n partialSvg t $ pathify shape\n"} @@ -9,4 +9,4 @@ const snippets = [{"title": "Hello World","url": "https://reanimate.clozecards.c ,{"title": "Object Positions","url": "https://reanimate.clozecards.com/Mf4zcImo+I7/195.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n sceneAnimation $ do\n -- Configure objects\n txt <- newText \"Center\"\n top <- newText \"Top\"\n oModifyS top $ \n oTopY .= screenTop\n topR <- newText \"Top right\"\n oModifyS topR $ do\n oTopY .= screenTop\n oRightX .= screenRight\n botR <- newText \"Bottom right\"\n oModifyS botR $ do\n oTranslate .= (0, screenBottom+0.5)\n oRightX .= screenRight\n botL <- newText \"Bottom left\"\n oModifyS botL $ do\n oTranslate .= (0, screenBottom+0.5)\n oLeftX .= screenLeft\n topL <- newText \"Top left\"\n oModifyS topL $ do\n oTopY .= screenTop\n oLeftX .= screenLeft\n -- Show objects\n oShow txt\n wait 1\n switchTo txt top\n switchTo top topR\n switchTo topR botR\n switchTo botR botL\n switchTo botL topL\n switchTo topL txt\n\nswitchTo src dst = do\n fork $ oHideWith src oFadeOut\n oShowWith dst oFadeIn\n wait 1\n\nnewText txt =\n newObject $ scale 1.5 $ centerX $ latex txt\n"} ,{"title": "Camera","url": "https://reanimate.clozecards.com/Hcx00P+aeph/150.svg","code": "animation :: Animation\nanimation = docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do\n cam <- newObject Camera\n\n txt <- newObject $ center $ latex \"Fixed (non-cam)\"\n oModifyS txt $ do\n oTopY .= screenTop \n oZIndex .= 2\n\n circle <- newObject $ withFillColor \"blue\" $ mkCircle 1\n cameraAttach cam circle\n circleRight <- oRead circle oRightX\n\n box <- newObject $ withFillColor \"green\" $ mkRect 2 2\n cameraAttach cam box\n oModify box $ oLeftX .~ circleRight\n boxCenter <- oRead box oCenterXY\n\n small <- newObject $ center $ latex \"This text is very small\"\n cameraAttach cam small\n oModifyS small $ do\n oCenterXY .= boxCenter\n oScale .= 0.1\n \n oShow txt\n oShow small\n oShow circle\n oShow box\n\n wait 1\n\n cameraFocus cam boxCenter\n waitOn $ do\n fork $ cameraPan cam 3 boxCenter\n fork $ cameraZoom cam 3 15\n \n wait 2\n cameraZoom cam 3 1\n cameraPan cam 1 (0,0)\n"} ]; -const playgroundVersion = "2020-09-02 (3a678)"; +const playgroundVersion = "2020-09-02 (eff3b)"; diff --git a/reanimate-0.4.3.0-inplace/Reanimate.Scene.hs.html b/reanimate-0.4.3.0-inplace/Reanimate.Scene.hs.html index 5a35d91..d955906 100644 --- a/reanimate-0.4.3.0-inplace/Reanimate.Scene.hs.html +++ b/reanimate-0.4.3.0-inplace/Reanimate.Scene.hs.html @@ -858,11 +858,11 @@ span.spaces { background: white } 839 840 -- | Object's scale. Default: 1 841 oScale :: Lens' (ObjectData a) Double - 842 oScale = lens _oScale $ \obj val -> obj { _oScale = val } + 842 oScale = lens _oScale $ \obj val -> oComputeBB obj { _oScale = val } 843 844 -- | Origin point for scaling. Default: \<0,0\> 845 oScaleOrigin :: Lens' (ObjectData a) (Double, Double) - 846 oScaleOrigin = lens _oScaleOrigin $ \obj val -> obj { _oScaleOrigin = val } + 846 oScaleOrigin = lens _oScaleOrigin $ \obj val -> oComputeBB obj { _oScaleOrigin = val } 847 848 -- Smart lenses 849 @@ -870,473 +870,480 @@ span.spaces { background: white } 851 oValue :: Renderable a => Lens' (ObjectData a) a 852 oValue = lens _oValueRef $ \obj newVal -> 853 let svg = toSVG newVal - 854 in obj + 854 in oComputeBB obj 855 { _oValueRef = newVal - 856 , _oSVG = svg - 857 , _oBB = boundingBox svg } - 858 - 859 -- | Derived location of the top-most point of an object + margin. - 860 oTopY :: Lens' (ObjectData a) Double - 861 oTopY = lens getter setter - 862 where - 863 getter obj = - 864 let top = obj ^. oMarginTop - 865 miny = obj ^. oBBMinY - 866 h = obj ^. oBBHeight - 867 dy = obj ^. oTranslate . _2 - 868 in dy+miny+h+top - 869 setter obj val = - 870 obj & (oTranslate . _2) +~ val-getter obj - 871 - 872 -- | Derived location of the bottom-most point of an object + margin. - 873 oBottomY :: Lens' (ObjectData a) Double - 874 oBottomY = lens getter setter - 875 where - 876 getter obj = - 877 let bot = obj ^. oMarginBottom - 878 miny = obj ^. oBBMinY - 879 dy = obj ^. oTranslate . _2 - 880 in dy+miny-bot - 881 setter obj val = - 882 obj & (oTranslate . _2) +~ val-getter obj - 883 - 884 -- | Derived location of the left-most point of an object + margin. - 885 oLeftX :: Lens' (ObjectData a) Double - 886 oLeftX = lens getter setter - 887 where - 888 getter obj = - 889 let left = obj ^. oMarginLeft - 890 minx = obj ^. oBBMinX - 891 dx = obj ^. oTranslate . _1 - 892 in dx+minx-left - 893 setter obj val = - 894 obj & (oTranslate . _1) +~ val-getter obj - 895 - 896 -- | Derived location of the right-most point of an object + margin. - 897 oRightX :: Lens' (ObjectData a) Double - 898 oRightX = lens getter setter - 899 where - 900 getter obj = - 901 let right = obj ^. oMarginRight - 902 minx = obj ^. oBBMinX - 903 w = obj ^. oBBWidth - 904 dx = obj ^. oTranslate . _1 - 905 in dx+minx+w+right - 906 setter obj val = - 907 obj & (oTranslate . _1) +~ val-getter obj - 908 - 909 -- | Derived location of an object's center point. - 910 oCenterXY :: Lens' (ObjectData a) (Double, Double) - 911 oCenterXY = lens getter setter - 912 where - 913 getter obj = - 914 let minx = obj ^. oBBMinX - 915 miny = obj ^. oBBMinY - 916 w = obj ^. oBBWidth - 917 h = obj ^. oBBHeight - 918 (dx,dy) = obj ^. oTranslate - 919 in (dx+minx+w/2, dy+miny+h/2) - 920 setter obj (dx, dy) = - 921 let (x,y) = getter obj in - 922 obj & (oTranslate . _1) +~ dx-x - 923 & (oTranslate . _2) +~ dy-y - 924 - 925 -- | Object's top margin. - 926 oMarginTop :: Lens' (ObjectData a) Double - 927 oMarginTop = oMargin . _1 - 928 - 929 -- | Object's right margin. - 930 oMarginRight :: Lens' (ObjectData a) Double - 931 oMarginRight = oMargin . _2 - 932 - 933 -- | Object's bottom margin. - 934 oMarginBottom :: Lens' (ObjectData a) Double - 935 oMarginBottom = oMargin . _3 - 936 - 937 -- | Object's left margin. - 938 oMarginLeft :: Lens' (ObjectData a) Double - 939 oMarginLeft = oMargin . _4 - 940 - 941 -- | Object's minimal X-coordinate.. - 942 oBBMinX :: Getter (ObjectData a) Double - 943 oBBMinX = oBB . _1 - 944 - 945 -- | Object's minimal Y-coordinate.. - 946 oBBMinY :: Getter (ObjectData a) Double - 947 oBBMinY = oBB . _2 - 948 - 949 -- | Object's width without margin. - 950 oBBWidth :: Getter (ObjectData a) Double - 951 oBBWidth = oBB . _3 - 952 - 953 -- | Object's height without margin. - 954 oBBHeight :: Getter (ObjectData a) Double - 955 oBBHeight = oBB . _4 - 956 - 957 ------------------------------------------------------------------------------- - 958 -- Object modifiers + 856 , _oSVG = svg } + 857 + 858 oComputeBB :: ObjectData a -> ObjectData a + 859 oComputeBB obj = obj + 860 { _oBB = boundingBox $ oScaleApply obj (_oSVG obj) } + 861 + 862 -- | Derived location of the top-most point of an object + margin. + 863 oTopY :: Lens' (ObjectData a) Double + 864 oTopY = lens getter setter + 865 where + 866 getter obj = + 867 let top = obj ^. oMarginTop + 868 miny = obj ^. oBBMinY + 869 h = obj ^. oBBHeight + 870 dy = obj ^. oTranslate . _2 + 871 in dy+miny+h+top + 872 setter obj val = + 873 obj & (oTranslate . _2) +~ val-getter obj + 874 + 875 -- | Derived location of the bottom-most point of an object + margin. + 876 oBottomY :: Lens' (ObjectData a) Double + 877 oBottomY = lens getter setter + 878 where + 879 getter obj = + 880 let bot = obj ^. oMarginBottom + 881 miny = obj ^. oBBMinY + 882 dy = obj ^. oTranslate . _2 + 883 in dy+miny-bot + 884 setter obj val = + 885 obj & (oTranslate . _2) +~ val-getter obj + 886 + 887 -- | Derived location of the left-most point of an object + margin. + 888 oLeftX :: Lens' (ObjectData a) Double + 889 oLeftX = lens getter setter + 890 where + 891 getter obj = + 892 let left = obj ^. oMarginLeft + 893 minx = obj ^. oBBMinX + 894 dx = obj ^. oTranslate . _1 + 895 in dx+minx-left + 896 setter obj val = + 897 obj & (oTranslate . _1) +~ val-getter obj + 898 + 899 -- | Derived location of the right-most point of an object + margin. + 900 oRightX :: Lens' (ObjectData a) Double + 901 oRightX = lens getter setter + 902 where + 903 getter obj = + 904 let right = obj ^. oMarginRight + 905 minx = obj ^. oBBMinX + 906 w = obj ^. oBBWidth + 907 dx = obj ^. oTranslate . _1 + 908 in dx+minx+w+right + 909 setter obj val = + 910 obj & (oTranslate . _1) +~ val-getter obj + 911 + 912 -- | Derived location of an object's center point. + 913 oCenterXY :: Lens' (ObjectData a) (Double, Double) + 914 oCenterXY = lens getter setter + 915 where + 916 getter obj = + 917 let minx = obj ^. oBBMinX + 918 miny = obj ^. oBBMinY + 919 w = obj ^. oBBWidth + 920 h = obj ^. oBBHeight + 921 (dx,dy) = obj ^. oTranslate + 922 in (dx+minx+w/2, dy+miny+h/2) + 923 setter obj (dx, dy) = + 924 let (x,y) = getter obj in + 925 obj & (oTranslate . _1) +~ dx-x + 926 & (oTranslate . _2) +~ dy-y + 927 + 928 -- | Object's top margin. + 929 oMarginTop :: Lens' (ObjectData a) Double + 930 oMarginTop = oMargin . _1 + 931 + 932 -- | Object's right margin. + 933 oMarginRight :: Lens' (ObjectData a) Double + 934 oMarginRight = oMargin . _2 + 935 + 936 -- | Object's bottom margin. + 937 oMarginBottom :: Lens' (ObjectData a) Double + 938 oMarginBottom = oMargin . _3 + 939 + 940 -- | Object's left margin. + 941 oMarginLeft :: Lens' (ObjectData a) Double + 942 oMarginLeft = oMargin . _4 + 943 + 944 -- | Object's minimal X-coordinate.. + 945 oBBMinX :: Getter (ObjectData a) Double + 946 oBBMinX = oBB . _1 + 947 + 948 -- | Object's minimal Y-coordinate.. + 949 oBBMinY :: Getter (ObjectData a) Double + 950 oBBMinY = oBB . _2 + 951 + 952 -- | Object's width without margin. + 953 oBBWidth :: Getter (ObjectData a) Double + 954 oBBWidth = oBB . _3 + 955 + 956 -- | Object's height without margin. + 957 oBBHeight :: Getter (ObjectData a) Double + 958 oBBHeight = oBB . _4 959 - 960 -- | Modify object properties. - 961 oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s () - 962 oModify o fn = modifyVar (objectData o) fn - 963 - 964 -- | Modify object properties using a stateful API. - 965 oModifyS :: Object s a -> (State (ObjectData a) b) -> Scene s () - 966 oModifyS o fn = oModify o (execState fn) - 967 - 968 -- | Query object property. - 969 oRead :: Object s a -> Getting b (ObjectData a) b -> Scene s b - 970 oRead o l = view l <$> readVar (objectData o) - 971 - 972 -- | Modify object properties over a set duration. - 973 oTween :: Object s a -> Duration -> (Double -> ObjectData a -> ObjectData a) -> Scene s () - 974 oTween o d fn = do - 975 -- Read 'easing' var here instead of taking it from 'v'. - 976 -- This allows different easing functions even at the same timestamp. - 977 ease <- oRead o oEasing - 978 tweenVar (objectData o) d (\v t -> fn (ease t) v) - 979 - 980 -- | Modify object properties over a set duration using a stateful API. - 981 oTweenS :: Object s a -> Duration -> (Double -> State (ObjectData a) b) -> Scene s () - 982 oTweenS o d fn = oTween o d (\t -> execState (fn t)) - 983 - 984 -- | Modify object value over a set duration. This is a convenience function - 985 -- for modifying `oValue`. - 986 oTweenV :: Renderable a => Object s a -> Duration -> (Double -> a -> a) -> Scene s () - 987 oTweenV o d fn = oTween o d (\t -> oValue %~ fn t) - 988 - 989 -- | Modify object value over a set duration using a stateful API. This is a - 990 -- convenience function for modifying `oValue`. - 991 oTweenVS :: Renderable a => Object s a -> Duration -> (Double -> State a b) -> Scene s () - 992 oTweenVS o d fn = oTween o d (\t -> oValue %~ execState (fn t)) - 993 - 994 -- | Create new object. - 995 oNew :: Renderable a => a -> Scene s (Object s a) - 996 oNew = newObject - 997 - 998 -- | Create new object. - 999 newObject :: Renderable a => a -> Scene s (Object s a) - 1000 newObject val = do - 1001 ref <- newVar ObjectData - 1002 { _oTranslate = (0,0) - 1003 , _oValueRef = val - 1004 , _oSVG = svg - 1005 , _oContext = id - 1006 , _oMargin = (0.5,0.5,0.5,0.5) - 1007 , _oBB = boundingBox svg - 1008 , _oOpacity = 1 - 1009 , _oShown = False - 1010 , _oZIndex = 1 - 1011 , _oEasing = curveS 2 - 1012 , _oScale = 1 - 1013 , _oScaleOrigin = (0,0) - 1014 } - 1015 sprite <- newSprite $ do - 1016 ~ObjectData{..} <- unVar ref - 1017 pure $ - 1018 if _oShown - 1019 then - 1020 uncurry translate _oTranslate $ - 1021 uncurry translate (_oScaleOrigin & both %~ negate) $ - 1022 scale _oScale $ - 1023 uncurry translate _oScaleOrigin $ - 1024 withGroupOpacity _oOpacity $ - 1025 mkGroup [_oContext _oSVG] - 1026 else None - 1027 spriteModify sprite $ do - 1028 ~ObjectData{_oZIndex=z} <- unVar ref - 1029 pure $ \(img,_) -> (img,z) - 1030 return Object - 1031 { objectSprite = sprite - 1032 , objectData = ref } - 1033 where - 1034 svg = toSVG val - 1035 - 1036 ------------------------------------------------------------------------------- - 1037 -- Graphical transformations - 1038 - 1039 -- | Instantly show object. - 1040 oShow :: Object s a -> Scene s () - 1041 oShow o = oModify o $ oShown .~ True + 960 ------------------------------------------------------------------------------- + 961 -- Object modifiers + 962 + 963 -- | Modify object properties. + 964 oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s () + 965 oModify o fn = modifyVar (objectData o) fn + 966 + 967 -- | Modify object properties using a stateful API. + 968 oModifyS :: Object s a -> (State (ObjectData a) b) -> Scene s () + 969 oModifyS o fn = oModify o (execState fn) + 970 + 971 -- | Query object property. + 972 oRead :: Object s a -> Getting b (ObjectData a) b -> Scene s b + 973 oRead o l = view l <$> readVar (objectData o) + 974 + 975 -- | Modify object properties over a set duration. + 976 oTween :: Object s a -> Duration -> (Double -> ObjectData a -> ObjectData a) -> Scene s () + 977 oTween o d fn = do + 978 -- Read 'easing' var here instead of taking it from 'v'. + 979 -- This allows different easing functions even at the same timestamp. + 980 ease <- oRead o oEasing + 981 tweenVar (objectData o) d (\v t -> fn (ease t) v) + 982 + 983 -- | Modify object properties over a set duration using a stateful API. + 984 oTweenS :: Object s a -> Duration -> (Double -> State (ObjectData a) b) -> Scene s () + 985 oTweenS o d fn = oTween o d (\t -> execState (fn t)) + 986 + 987 -- | Modify object value over a set duration. This is a convenience function + 988 -- for modifying `oValue`. + 989 oTweenV :: Renderable a => Object s a -> Duration -> (Double -> a -> a) -> Scene s () + 990 oTweenV o d fn = oTween o d (\t -> oValue %~ fn t) + 991 + 992 -- | Modify object value over a set duration using a stateful API. This is a + 993 -- convenience function for modifying `oValue`. + 994 oTweenVS :: Renderable a => Object s a -> Duration -> (Double -> State a b) -> Scene s () + 995 oTweenVS o d fn = oTween o d (\t -> oValue %~ execState (fn t)) + 996 + 997 -- | Create new object. + 998 oNew :: Renderable a => a -> Scene s (Object s a) + 999 oNew = newObject + 1000 + 1001 -- | Create new object. + 1002 newObject :: Renderable a => a -> Scene s (Object s a) + 1003 newObject val = do + 1004 ref <- newVar ObjectData + 1005 { _oTranslate = (0,0) + 1006 , _oValueRef = val + 1007 , _oSVG = svg + 1008 , _oContext = id + 1009 , _oMargin = (0.5,0.5,0.5,0.5) + 1010 , _oBB = boundingBox svg + 1011 , _oOpacity = 1 + 1012 , _oShown = False + 1013 , _oZIndex = 1 + 1014 , _oEasing = curveS 2 + 1015 , _oScale = 1 + 1016 , _oScaleOrigin = (0,0) + 1017 } + 1018 sprite <- newSprite $ do + 1019 ~obj@ObjectData{..} <- unVar ref + 1020 pure $ + 1021 if _oShown + 1022 then + 1023 uncurry translate _oTranslate $ + 1024 oScaleApply obj $ + 1025 withGroupOpacity _oOpacity $ + 1026 mkGroup [_oContext _oSVG] + 1027 else None + 1028 spriteModify sprite $ do + 1029 ~ObjectData{_oZIndex=z} <- unVar ref + 1030 pure $ \(img,_) -> (img,z) + 1031 return Object + 1032 { objectSprite = sprite + 1033 , objectData = ref } + 1034 where + 1035 svg = toSVG val + 1036 + 1037 oScaleApply :: ObjectData a -> (SVG -> SVG) + 1038 oScaleApply ObjectData{..} = + 1039 uncurry translate (_oScaleOrigin & both %~ negate) . + 1040 scale _oScale . + 1041 uncurry translate _oScaleOrigin 1042 - 1043 -- | Instantly hide object. - 1044 oHide :: Object s a -> Scene s () - 1045 oHide o = oModify o $ oShown .~ False - 1046 - 1047 oShowWith :: Object s a -> (SVG -> Animation) -> Scene s () - 1048 oShowWith o fn = do - 1049 oModify o $ oShown .~ True - 1050 initSVG <- oRead o oSVG - 1051 let ani = fn initSVG - 1052 oTween o (duration ani) $ \t obj -> - 1053 obj{ _oSVG = getAnimationFrame SyncStretch ani t 1 } - 1054 oModify o $ \obj -> obj { _oSVG = initSVG } - 1055 - 1056 oHideWith :: Object s a -> (SVG -> Animation) -> Scene s () - 1057 oHideWith o fn = do - 1058 initSVG <- oRead o oSVG - 1059 let ani = fn initSVG - 1060 oTween o (duration ani) $ \t obj -> - 1061 obj{ _oSVG = getAnimationFrame SyncStretch ani t 1 } - 1062 oModify o $ \obj -> obj { _oSVG = initSVG } - 1063 oModify o $ oShown .~ False - 1064 - 1065 -- | Fade in object over a set duration. - 1066 oFadeIn :: SVG -> Animation - 1067 oFadeIn svg = animate $ \t -> withGroupOpacity t svg - 1068 - 1069 -- | Fade out object over a set duration. - 1070 oFadeOut :: SVG -> Animation - 1071 oFadeOut = reverseA . oFadeIn - 1072 - 1073 -- | Scale in object over a set duration. - 1074 oGrow :: SVG -> Animation - 1075 oGrow svg = animate $ \t -> scale t svg - 1076 - 1077 -- | Scale out object over a set duration. - 1078 oShrink :: SVG -> Animation - 1079 oShrink = reverseA . oGrow - 1080 - 1081 type Origin = (Double, Double) - 1082 - 1083 svgOrigin :: SVG -> Origin -> (Double, Double) - 1084 svgOrigin svg (originX, originY) = - 1085 case boundingBox svg of - 1086 (polyX, polyY, polyWidth, polyHeight) -> - 1087 ( polyX + polyWidth * originX - 1088 , polyY + polyHeight * originY) + 1043 ------------------------------------------------------------------------------- + 1044 -- Graphical transformations + 1045 + 1046 -- | Instantly show object. + 1047 oShow :: Object s a -> Scene s () + 1048 oShow o = oModify o $ oShown .~ True + 1049 + 1050 -- | Instantly hide object. + 1051 oHide :: Object s a -> Scene s () + 1052 oHide o = oModify o $ oShown .~ False + 1053 + 1054 oShowWith :: Object s a -> (SVG -> Animation) -> Scene s () + 1055 oShowWith o fn = do + 1056 oModify o $ oShown .~ True + 1057 initSVG <- oRead o oSVG + 1058 let ani = fn initSVG + 1059 oTween o (duration ani) $ \t obj -> + 1060 obj{ _oSVG = getAnimationFrame SyncStretch ani t 1 } + 1061 oModify o $ \obj -> obj { _oSVG = initSVG } + 1062 + 1063 oHideWith :: Object s a -> (SVG -> Animation) -> Scene s () + 1064 oHideWith o fn = do + 1065 initSVG <- oRead o oSVG + 1066 let ani = fn initSVG + 1067 oTween o (duration ani) $ \t obj -> + 1068 obj{ _oSVG = getAnimationFrame SyncStretch ani t 1 } + 1069 oModify o $ \obj -> obj { _oSVG = initSVG } + 1070 oModify o $ oShown .~ False + 1071 + 1072 -- | Fade in object over a set duration. + 1073 oFadeIn :: SVG -> Animation + 1074 oFadeIn svg = animate $ \t -> withGroupOpacity t svg + 1075 + 1076 -- | Fade out object over a set duration. + 1077 oFadeOut :: SVG -> Animation + 1078 oFadeOut = reverseA . oFadeIn + 1079 + 1080 -- | Scale in object over a set duration. + 1081 oGrow :: SVG -> Animation + 1082 oGrow svg = animate $ \t -> scale t svg + 1083 + 1084 -- | Scale out object over a set duration. + 1085 oShrink :: SVG -> Animation + 1086 oShrink = reverseA . oGrow + 1087 + 1088 type Origin = (Double, Double) 1089 - 1090 oScaleIn :: SVG -> Animation - 1091 oScaleIn = oScaleIn' (curveS 2) (0.5,1) - 1092 - 1093 oScaleIn' :: Signal -> Origin -> SVG -> Animation - 1094 oScaleIn' easing origin = oStagger' 0.05 $ \svg -> - 1095 let (cx, cy) = svgOrigin svg origin - 1096 in signalA easing $ mkAnimation 0.3 $ \t -> - 1097 translate cx cy $ - 1098 scale t $ - 1099 translate (-cx) (-cy) $ - 1100 svg - 1101 - 1102 oScaleOut :: SVG -> Animation - 1103 oScaleOut = reverseA . oStaggerRev' 0.05 (oScaleIn' (curveS 2) (0.5,0)) - 1104 - 1105 oScaleOut' :: Signal -> Origin -> SVG -> Animation - 1106 oScaleOut' easing origin = reverseA . oStaggerRev' 0.05 (oScaleIn' easing origin) - 1107 - 1108 oSim :: (SVG -> Animation) -> SVG -> Animation - 1109 oSim = oStagger' 0 - 1110 - 1111 -- oSim (oStagger fn) = oSim fn - 1112 -- oStagger (oStagger fn) = oStagger fn - 1113 oStagger :: (SVG -> Animation) -> SVG -> Animation - 1114 oStagger = oStagger' 0.2 - 1115 - 1116 oStaggerRev :: (SVG -> Animation) -> SVG -> Animation - 1117 oStaggerRev = oStaggerRev' 0.2 - 1118 - 1119 oStagger' :: Duration -> (SVG -> Animation) -> SVG -> Animation - 1120 oStagger' staggerDelay fn svg = scene $ - 1121 forM_ (svgGlyphs svg) $ \(ctx, _attr, node) -> do - 1122 void $ fork $ newSpriteA' SyncFreeze (fn $ ctx node) - 1123 wait staggerDelay - 1124 - 1125 oStaggerRev' :: Duration -> (SVG -> Animation) -> SVG -> Animation - 1126 oStaggerRev' staggerDelay fn svg = scene $ - 1127 forM_ (reverse $ svgGlyphs svg) $ \(ctx, _attr, node) -> do - 1128 void $ fork $ newSpriteA' SyncFreeze (fn $ ctx node) - 1129 wait staggerDelay - 1130 - 1131 oDraw :: SVG -> Animation - 1132 oDraw = oStagger $ \svg -> scene $ do - 1133 forM_ (svgGlyphs $ pathify svg) $ \(ctx, attr, node) -> do - 1134 let sWidth = - 1135 case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of - 1136 Just (Num d) -> max defaultStrokeWidth d - 1137 _ -> defaultStrokeWidth - 1138 -- wait 1 - 1139 play $ - 1140 mapA ctx $ - 1141 applyE (overEnding fillDur $ fadeLineOutE sWidth) $ - 1142 animate $ \t -> withStrokeWidth sWidth $ - 1143 mkGroup - 1144 [withFillOpacity 0 $ partialSvg t node] - 1145 wait (-fillDur) - 1146 newSpriteA' SyncFreeze $ mkAnimation fillDur $ \t -> - 1147 withGroupOpacity t $ - 1148 mkGroup [ ctx node ] - 1149 where - 1150 fillDur = 0.3 - 1151 - 1152 _oBalloon :: SVG -> Animation - 1153 _oBalloon = animate . balloon - 1154 - 1155 -- FIXME: Also transform attributes: 'opacity', 'scale', 'scaleOrigin'. - 1156 -- | Morph source object into target object over a set duration. - 1157 oTransform :: Object s a -> Object s b -> Duration -> Scene s () - 1158 oTransform src dst d = do - 1159 srcSvg <- oRead src oSVG - 1160 srcCtx <- oRead src oContext - 1161 srcEase <- oRead src oEasing - 1162 srcLoc <- oRead src oTranslate - 1163 oModify src $ oShown .~ False - 1164 - 1165 dstSvg <- oRead dst oSVG - 1166 dstCtx <- oRead dst oContext - 1167 dstLoc <- oRead dst oTranslate - 1168 - 1169 m <- newObject $ Morph 0 (srcCtx srcSvg) (dstCtx dstSvg) - 1170 oModifyS m $ do - 1171 oShown .= True - 1172 oEasing .= srcEase - 1173 oTranslate .= srcLoc - 1174 fork $ oTween m d $ \t -> oTranslate %~ moveTo t dstLoc - 1175 oTweenV m d $ \t -> morphDelta .~ t - 1176 oModify m $ oShown .~ False - 1177 oModify dst $ oShown .~ True - 1178 where - 1179 moveTo t (dstX, dstY) (srcX, srcY) = - 1180 (fromToS srcX dstX t, fromToS srcY dstY t) - 1181 - 1182 - 1183 ------------------------------------------------------------------------------- - 1184 -- Built-in objects - 1185 - 1186 -- | Basic object mapping to \<circle\/\> in SVG. - 1187 newtype Circle = Circle {_circleRadius :: Double} + 1090 svgOrigin :: SVG -> Origin -> (Double, Double) + 1091 svgOrigin svg (originX, originY) = + 1092 case boundingBox svg of + 1093 (polyX, polyY, polyWidth, polyHeight) -> + 1094 ( polyX + polyWidth * originX + 1095 , polyY + polyHeight * originY) + 1096 + 1097 oScaleIn :: SVG -> Animation + 1098 oScaleIn = oScaleIn' (curveS 2) (0.5,1) + 1099 + 1100 oScaleIn' :: Signal -> Origin -> SVG -> Animation + 1101 oScaleIn' easing origin = oStagger' 0.05 $ \svg -> + 1102 let (cx, cy) = svgOrigin svg origin + 1103 in signalA easing $ mkAnimation 0.3 $ \t -> + 1104 translate cx cy $ + 1105 scale t $ + 1106 translate (-cx) (-cy) $ + 1107 svg + 1108 + 1109 oScaleOut :: SVG -> Animation + 1110 oScaleOut = reverseA . oStaggerRev' 0.05 (oScaleIn' (curveS 2) (0.5,0)) + 1111 + 1112 oScaleOut' :: Signal -> Origin -> SVG -> Animation + 1113 oScaleOut' easing origin = reverseA . oStaggerRev' 0.05 (oScaleIn' easing origin) + 1114 + 1115 oSim :: (SVG -> Animation) -> SVG -> Animation + 1116 oSim = oStagger' 0 + 1117 + 1118 -- oSim (oStagger fn) = oSim fn + 1119 -- oStagger (oStagger fn) = oStagger fn + 1120 oStagger :: (SVG -> Animation) -> SVG -> Animation + 1121 oStagger = oStagger' 0.2 + 1122 + 1123 oStaggerRev :: (SVG -> Animation) -> SVG -> Animation + 1124 oStaggerRev = oStaggerRev' 0.2 + 1125 + 1126 oStagger' :: Duration -> (SVG -> Animation) -> SVG -> Animation + 1127 oStagger' staggerDelay fn svg = scene $ + 1128 forM_ (svgGlyphs svg) $ \(ctx, _attr, node) -> do + 1129 void $ fork $ newSpriteA' SyncFreeze (fn $ ctx node) + 1130 wait staggerDelay + 1131 + 1132 oStaggerRev' :: Duration -> (SVG -> Animation) -> SVG -> Animation + 1133 oStaggerRev' staggerDelay fn svg = scene $ + 1134 forM_ (reverse $ svgGlyphs svg) $ \(ctx, _attr, node) -> do + 1135 void $ fork $ newSpriteA' SyncFreeze (fn $ ctx node) + 1136 wait staggerDelay + 1137 + 1138 oDraw :: SVG -> Animation + 1139 oDraw = oStagger $ \svg -> scene $ do + 1140 forM_ (svgGlyphs $ pathify svg) $ \(ctx, attr, node) -> do + 1141 let sWidth = + 1142 case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of + 1143 Just (Num d) -> max defaultStrokeWidth d + 1144 _ -> defaultStrokeWidth + 1145 -- wait 1 + 1146 play $ + 1147 mapA ctx $ + 1148 applyE (overEnding fillDur $ fadeLineOutE sWidth) $ + 1149 animate $ \t -> withStrokeWidth sWidth $ + 1150 mkGroup + 1151 [withFillOpacity 0 $ partialSvg t node] + 1152 wait (-fillDur) + 1153 newSpriteA' SyncFreeze $ mkAnimation fillDur $ \t -> + 1154 withGroupOpacity t $ + 1155 mkGroup [ ctx node ] + 1156 where + 1157 fillDur = 0.3 + 1158 + 1159 _oBalloon :: SVG -> Animation + 1160 _oBalloon = animate . balloon + 1161 + 1162 -- FIXME: Also transform attributes: 'opacity', 'scale', 'scaleOrigin'. + 1163 -- | Morph source object into target object over a set duration. + 1164 oTransform :: Object s a -> Object s b -> Duration -> Scene s () + 1165 oTransform src dst d = do + 1166 srcSvg <- oRead src oSVG + 1167 srcCtx <- oRead src oContext + 1168 srcEase <- oRead src oEasing + 1169 srcLoc <- oRead src oTranslate + 1170 oModify src $ oShown .~ False + 1171 + 1172 dstSvg <- oRead dst oSVG + 1173 dstCtx <- oRead dst oContext + 1174 dstLoc <- oRead dst oTranslate + 1175 + 1176 m <- newObject $ Morph 0 (srcCtx srcSvg) (dstCtx dstSvg) + 1177 oModifyS m $ do + 1178 oShown .= True + 1179 oEasing .= srcEase + 1180 oTranslate .= srcLoc + 1181 fork $ oTween m d $ \t -> oTranslate %~ moveTo t dstLoc + 1182 oTweenV m d $ \t -> morphDelta .~ t + 1183 oModify m $ oShown .~ False + 1184 oModify dst $ oShown .~ True + 1185 where + 1186 moveTo t (dstX, dstY) (srcX, srcY) = + 1187 (fromToS srcX dstX t, fromToS srcY dstY t) 1188 - 1189 -- | Circle radius in local units. - 1190 circleRadius :: Lens' Circle Double - 1191 circleRadius = iso _circleRadius Circle + 1189 + 1190 ------------------------------------------------------------------------------- + 1191 -- Built-in objects 1192 - 1193 instance Renderable Circle where - 1194 toSVG (Circle r) = mkCircle r + 1193 -- | Basic object mapping to \<circle\/\> in SVG. + 1194 newtype Circle = Circle {_circleRadius :: Double} 1195 - 1196 -- | Basic object mapping to \<rect\/\> in SVG. - 1197 data Rectangle = Rectangle { _rectWidth :: Double, _rectHeight :: Double } - 1198 - 1199 -- | Rectangle width in local units. - 1200 rectWidth :: Lens' Rectangle Double - 1201 rectWidth = lens _rectWidth $ \obj val -> obj{_rectWidth=val} + 1196 -- | Circle radius in local units. + 1197 circleRadius :: Lens' Circle Double + 1198 circleRadius = iso _circleRadius Circle + 1199 + 1200 instance Renderable Circle where + 1201 toSVG (Circle r) = mkCircle r 1202 - 1203 -- | Rectangle height in local units. - 1204 rectHeight :: Lens' Rectangle Double - 1205 rectHeight = lens _rectHeight $ \obj val -> obj{_rectHeight=val} - 1206 - 1207 instance Renderable Rectangle where - 1208 toSVG (Rectangle w h) = mkRect w h + 1203 -- | Basic object mapping to \<rect\/\> in SVG. + 1204 data Rectangle = Rectangle { _rectWidth :: Double, _rectHeight :: Double } + 1205 + 1206 -- | Rectangle width in local units. + 1207 rectWidth :: Lens' Rectangle Double + 1208 rectWidth = lens _rectWidth $ \obj val -> obj{_rectWidth=val} 1209 - 1210 -- | Object representing an interpolation between SVG nodes. - 1211 data Morph = Morph { _morphDelta :: Double, _morphSrc :: SVG, _morphDst :: SVG } - 1212 - 1213 -- | Control variable for the interpolation. A value of 0 gives the - 1214 -- source SVG and 1 gives the target svg. - 1215 morphDelta :: Lens' Morph Double - 1216 morphDelta = lens _morphDelta $ \obj val -> obj{_morphDelta = val} - 1217 - 1218 -- | Source shape. - 1219 morphSrc :: Lens' Morph SVG - 1220 morphSrc = lens _morphSrc $ \obj val -> obj{_morphSrc = val} - 1221 - 1222 -- | Target shape. - 1223 morphDst :: Lens' Morph SVG - 1224 morphDst = lens _morphDst $ \obj val -> obj{_morphDst = val} - 1225 - 1226 instance Renderable Morph where - 1227 toSVG (Morph t src dst) = morph linear src dst t + 1210 -- | Rectangle height in local units. + 1211 rectHeight :: Lens' Rectangle Double + 1212 rectHeight = lens _rectHeight $ \obj val -> obj{_rectHeight=val} + 1213 + 1214 instance Renderable Rectangle where + 1215 toSVG (Rectangle w h) = mkRect w h + 1216 + 1217 -- | Object representing an interpolation between SVG nodes. + 1218 data Morph = Morph { _morphDelta :: Double, _morphSrc :: SVG, _morphDst :: SVG } + 1219 + 1220 -- | Control variable for the interpolation. A value of 0 gives the + 1221 -- source SVG and 1 gives the target svg. + 1222 morphDelta :: Lens' Morph Double + 1223 morphDelta = lens _morphDelta $ \obj val -> obj{_morphDelta = val} + 1224 + 1225 -- | Source shape. + 1226 morphSrc :: Lens' Morph SVG + 1227 morphSrc = lens _morphSrc $ \obj val -> obj{_morphSrc = val} 1228 - 1229 -- | Cameras can take control of objects and manipulate them - 1230 -- with convenient pan and zoom operations. - 1231 data Camera = Camera - 1232 instance Renderable Camera where - 1233 toSVG Camera = None - 1234 - 1235 -- | Connect an object to a camera such that - 1236 -- camera settings (position, zoom, and rotation) is - 1237 -- applied to the object. - 1238 -- - 1239 -- Example - 1240 -- - 1241 -- @ - 1242 -- do cam \<- 'newObject' 'Camera' - 1243 -- circ \<- 'newObject' $ 'Circle' 2 - 1244 -- 'oModifyS' circ $ - 1245 -- 'oContext' .= 'withFillOpacity' 1 . 'withFillColor' "blue" - 1246 -- 'oShow' circ - 1247 -- 'cameraAttach' cam circ - 1248 -- 'cameraZoom' cam 1 2 - 1249 -- 'cameraZoom' cam 1 1 - 1250 -- @ - 1251 -- - 1252 -- <<docs/gifs/doc_cameraAttach.gif>> - 1253 cameraAttach :: Object s Camera -> Object s a -> Scene s () - 1254 cameraAttach cam obj = - 1255 spriteModify (objectSprite obj) $ do - 1256 camData <- unVar (objectData cam) - 1257 return $ \(svg,zindex) -> - 1258 let (x,y) = camData^.oTranslate - 1259 ctx = - 1260 translate (-x) (-y) . - 1261 uncurry translate (camData^.oScaleOrigin) . - 1262 scale (camData^.oScale) . - 1263 uncurry translate (camData^.oScaleOrigin & both %~ negate) - 1264 in (ctx svg, zindex) - 1265 - 1266 -- | - 1267 -- - 1268 -- Example - 1269 -- - 1270 -- @ - 1271 -- do cam \<- 'newObject' 'Camera' - 1272 -- circ \<- 'newObject' $ 'Circle' 2; 'oShow' circ - 1273 -- 'oModify' circ $ 'oTranslate' .~ (-3,0) - 1274 -- box \<- 'newObject' $ 'Rectangle' 4 4; 'oShow' box - 1275 -- 'oModify' box $ 'oTranslate' .~ (3,0) - 1276 -- 'cameraAttach' cam circ - 1277 -- 'cameraAttach' cam box - 1278 -- 'cameraFocus' cam (-3,0) - 1279 -- 'cameraZoom' cam 2 2 -- Zoom in - 1280 -- 'cameraZoom' cam 2 1 -- Zoom out - 1281 -- 'cameraFocus' cam (3,0) - 1282 -- 'cameraZoom' cam 2 2 -- Zoom in - 1283 -- 'cameraZoom' cam 2 1 -- Zoom out - 1284 -- @ - 1285 -- - 1286 -- <<docs/gifs/doc_cameraFocus.gif>> - 1287 cameraFocus :: Object s Camera -> (Double, Double) -> Scene s () - 1288 cameraFocus cam (x,y) = do - 1289 (ox, oy) <- oRead cam oScaleOrigin - 1290 (tx, ty) <- oRead cam oTranslate - 1291 s <- oRead cam oScale - 1292 let newLocation = (x-((x-ox)*s+ox-tx), y-((y-oy)*s+oy-ty)) - 1293 oModifyS cam $ do - 1294 oTranslate .= newLocation - 1295 oScaleOrigin .= (x,y) - 1296 - 1297 -- | Instantaneously set camera zoom level. - 1298 cameraSetZoom :: Object s Camera -> Double -> Scene s () - 1299 cameraSetZoom cam s = - 1300 oModifyS cam $ - 1301 oScale .= s - 1302 - 1303 -- | Change camera zoom level over a set duration. - 1304 cameraZoom :: Object s Camera -> Duration -> Double -> Scene s () - 1305 cameraZoom cam d s = - 1306 oTweenS cam d $ \t -> - 1307 oScale %= \v -> fromToS v s t - 1308 - 1309 -- | Instantaneously set camera location. - 1310 cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s () - 1311 cameraSetPan cam location = - 1312 oModifyS cam $ do - 1313 oTranslate .= location - 1314 - 1315 -- | Change camera location over a set duration. - 1316 cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s () - 1317 cameraPan cam d (x,y) = - 1318 oTweenS cam d $ \t -> do - 1319 oTranslate._1 %= \v -> fromToS v x t - 1320 oTranslate._2 %= \v -> fromToS v y t + 1229 -- | Target shape. + 1230 morphDst :: Lens' Morph SVG + 1231 morphDst = lens _morphDst $ \obj val -> obj{_morphDst = val} + 1232 + 1233 instance Renderable Morph where + 1234 toSVG (Morph t src dst) = morph linear src dst t + 1235 + 1236 -- | Cameras can take control of objects and manipulate them + 1237 -- with convenient pan and zoom operations. + 1238 data Camera = Camera + 1239 instance Renderable Camera where + 1240 toSVG Camera = None + 1241 + 1242 -- | Connect an object to a camera such that + 1243 -- camera settings (position, zoom, and rotation) is + 1244 -- applied to the object. + 1245 -- + 1246 -- Example + 1247 -- + 1248 -- @ + 1249 -- do cam \<- 'newObject' 'Camera' + 1250 -- circ \<- 'newObject' $ 'Circle' 2 + 1251 -- 'oModifyS' circ $ + 1252 -- 'oContext' .= 'withFillOpacity' 1 . 'withFillColor' "blue" + 1253 -- 'oShow' circ + 1254 -- 'cameraAttach' cam circ + 1255 -- 'cameraZoom' cam 1 2 + 1256 -- 'cameraZoom' cam 1 1 + 1257 -- @ + 1258 -- + 1259 -- <<docs/gifs/doc_cameraAttach.gif>> + 1260 cameraAttach :: Object s Camera -> Object s a -> Scene s () + 1261 cameraAttach cam obj = + 1262 spriteModify (objectSprite obj) $ do + 1263 camData <- unVar (objectData cam) + 1264 return $ \(svg,zindex) -> + 1265 let (x,y) = camData^.oTranslate + 1266 ctx = + 1267 translate (-x) (-y) . + 1268 uncurry translate (camData^.oScaleOrigin) . + 1269 scale (camData^.oScale) . + 1270 uncurry translate (camData^.oScaleOrigin & both %~ negate) + 1271 in (ctx svg, zindex) + 1272 + 1273 -- | + 1274 -- + 1275 -- Example + 1276 -- + 1277 -- @ + 1278 -- do cam \<- 'newObject' 'Camera' + 1279 -- circ \<- 'newObject' $ 'Circle' 2; 'oShow' circ + 1280 -- 'oModify' circ $ 'oTranslate' .~ (-3,0) + 1281 -- box \<- 'newObject' $ 'Rectangle' 4 4; 'oShow' box + 1282 -- 'oModify' box $ 'oTranslate' .~ (3,0) + 1283 -- 'cameraAttach' cam circ + 1284 -- 'cameraAttach' cam box + 1285 -- 'cameraFocus' cam (-3,0) + 1286 -- 'cameraZoom' cam 2 2 -- Zoom in + 1287 -- 'cameraZoom' cam 2 1 -- Zoom out + 1288 -- 'cameraFocus' cam (3,0) + 1289 -- 'cameraZoom' cam 2 2 -- Zoom in + 1290 -- 'cameraZoom' cam 2 1 -- Zoom out + 1291 -- @ + 1292 -- + 1293 -- <<docs/gifs/doc_cameraFocus.gif>> + 1294 cameraFocus :: Object s Camera -> (Double, Double) -> Scene s () + 1295 cameraFocus cam (x,y) = do + 1296 (ox, oy) <- oRead cam oScaleOrigin + 1297 (tx, ty) <- oRead cam oTranslate + 1298 s <- oRead cam oScale + 1299 let newLocation = (x-((x-ox)*s+ox-tx), y-((y-oy)*s+oy-ty)) + 1300 oModifyS cam $ do + 1301 oTranslate .= newLocation + 1302 oScaleOrigin .= (x,y) + 1303 + 1304 -- | Instantaneously set camera zoom level. + 1305 cameraSetZoom :: Object s Camera -> Double -> Scene s () + 1306 cameraSetZoom cam s = + 1307 oModifyS cam $ + 1308 oScale .= s + 1309 + 1310 -- | Change camera zoom level over a set duration. + 1311 cameraZoom :: Object s Camera -> Duration -> Double -> Scene s () + 1312 cameraZoom cam d s = + 1313 oTweenS cam d $ \t -> + 1314 oScale %= \v -> fromToS v s t + 1315 + 1316 -- | Instantaneously set camera location. + 1317 cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s () + 1318 cameraSetPan cam location = + 1319 oModifyS cam $ do + 1320 oTranslate .= location + 1321 + 1322 -- | Change camera location over a set duration. + 1323 cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s () + 1324 cameraPan cam d (x,y) = + 1325 oTweenS cam d $ \t -> do + 1326 oTranslate._1 %= \v -> fromToS v x t + 1327 oTranslate._2 %= \v -> fromToS v y t