Work towards object local sprites.

src/Reanimate/Scene/Object.hs

@@ -18,8 +18,9 @@ import           Reanimate.Morph.Common (morph)
 import           Reanimate.Morph.Linear (linear)
 import           Reanimate.Svg
 
-import           Reanimate.Scene.Core   (Scene, fork, scene, wait)
-import           Reanimate.Scene.Sprite (Sprite, newSprite, newSpriteA', play, spriteModify, unVar)
+import           Reanimate.Scene.Core   (Scene, ZIndex, fork, scene, wait)
+import           Reanimate.Scene.Sprite (Frame, Sprite, destroySprite, newSprite, newSpriteA', play,
+                                         spriteDuration, spriteModify, spriteT, unVar)
 import           Reanimate.Scene.Var    (Var, modifyVar, newVar, readVar, tweenVar)
 
 -------------------------------------------------------
@@ -51,7 +52,7 @@ data ObjectData a = ObjectData
     _oBB          :: (Double, Double, Double, Double),
     _oOpacity     :: Double,
     _oShown       :: Bool,
-    _oZIndex      :: Int,
+    _oZIndex      :: ZIndex,
     _oEasing      :: Signal,
     _oScale       :: Double,
     _oScaleOrigin :: V2 Double
@@ -103,7 +104,7 @@ oShown :: Lens' (ObjectData a) Bool
 oShown = lens _oShown $ \obj val -> obj {_oShown = val}
 
 -- | Object's z-index.
-oZIndex :: Lens' (ObjectData a) Int
+oZIndex :: Lens' (ObjectData a) ZIndex
 oZIndex = lens _oZIndex $ \obj val -> obj {_oZIndex = val}
 
 -- | Easing function used when modifying object properties.
@@ -333,6 +334,39 @@ oScaleApply ObjectData {..} =
 uncurryV2 :: (a -> a -> b) -> V2 a -> b
 uncurryV2 fn (V2 a b) = fn a b
 
+-------------------------------------------------------------------------------
+-- Object-local sprites
+
+oFrame :: Object s a -> Frame s (SVG -> SVG)
+oFrame o = do
+  ~obj@ObjectData {..} <- unVar (objectData o)
+  pure $ \svg -> 
+    if _oShown
+      then uncurryV2 translate _oTranslate $
+        oScaleApply obj $ withGroupOpacity _oOpacity $
+          mkGroup [ _oContext svg ]
+      else None
+
+oNewSprite :: Object s a -> Frame s SVG -> Scene s (Sprite s)
+oNewSprite o gen = do
+  sprite <- newSprite $ oFrame o <*> gen
+  spriteModify sprite $ do
+    ~ObjectData {_oZIndex = z} <- unVar (objectData o)
+    pure $ \(img, _) -> (img, z)
+  return sprite
+
+oNewSpriteA :: Object s a -> Animation -> Scene s (Sprite s)
+oNewSpriteA = oNewSpriteA' SyncStretch
+
+oNewSpriteA' :: Sync -> Object s a -> Animation -> Scene s (Sprite s)
+oNewSpriteA' sync o animation =
+  oNewSprite o (getAnimationFrame sync animation <$> spriteT <*> spriteDuration)
+    <* wait (duration animation)
+
+--
+oPlay :: Object s a -> Animation -> Scene s ()
+oPlay o ani = oNewSpriteA o ani >>= destroySprite
+
 -------------------------------------------------------------------------------
 -- Graphical transformations
 

videos/miles/Objects.hs

@@ -0,0 +1,155 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module Objects where
+
+import           Codec.Picture.Types
+import           Control.Lens
+import           Graphics.SvgTree
+import           Linear.V2
+import           Reanimate
+import           Reanimate.Builtin.CirclePlot
+import           Reanimate.Builtin.Documentation
+import           Reanimate.Scene
+
+
+data RoundFunction = RoundFunction
+  { _roundHeight :: Double
+  , _roundDepth  :: Double
+  }
+
+data SquareFunction = SquareFunction
+  { _squareHeight    :: Double
+  , _squareDepth     :: Double
+  , _squareNubHeight :: Double
+  , _squareNubDepth  :: Double
+  }
+
+data ArcPlot = ArcPlot
+  { _arcPlotPartial :: Double
+  , _arcPlotFn      :: Double -> PixelRGBA8
+  , _arcPlotAngle   :: Double
+  , _arcPlotCenter  :: Double
+  , _arcPlotQuality :: Int
+  }
+
+{-
+operations:
+  Fade in new board
+  Add go pieces
+  Highlight piece
+  Move piece
+-}
+data GoBoard = GoBoard
+  { _goBoardSize :: Int
+  , _goBoardWhite :: [Int]
+  , _goBoardBlack :: [Int]
+  , _goBoardSelected :: [Int]
+  }
+
+data GoPiece = GoPiece
+  { _goPieceBoardSize :: Int
+  , _goPieceLocation :: Int
+  , _goPieceColor :: String
+  }
+
+-- circlePlot :: Int -- ^ Number of diagonal pixels. Only affects quality, not size.
+--            -> (Double -> Double -> PixelRGBA8)
+--               -- ^ Angle and radius in radians and percent respectively.
+--            -> Tree
+
+
+makeLenses ''RoundFunction
+makeLenses ''SquareFunction
+makeLenses ''ArcPlot
+
+makeLenses ''GoBoard
+makeLenses ''GoPiece
+
+instance Renderable GoBoard where
+  toSVG (GoBoard size white black selected) = withFillOpacity 0 $ mkGroup
+    [ mkRect 1 1 ]
+
+instance Renderable RoundFunction where
+  toSVG (RoundFunction mouthHeight mouthDepth) =
+    mkGroup
+    [ withFillOpacity 0 $ mkPath
+      [ MoveTo OriginAbsolute [V2 (mouthDepth-1) 0]
+      , VerticalTo OriginRelative [-mouthHeight/2]
+      , HorizontalTo OriginAbsolute [-mouthX]
+      , EllipticalArc OriginRelative
+          [(1,1,0,True,True,V2 0 mouthHeight)]
+      , HorizontalTo OriginAbsolute [mouthDepth-1]
+      , VerticalTo OriginRelative [-mouthHeight/2]
+      , EndPath
+      ]
+    ]
+    where
+      mouthX = cos (asin (mouthHeight/2))
+
+instance Renderable SquareFunction where
+  toSVG (SquareFunction mouthHeight mouthDepth nubHeight nubDepth) =
+    mkGroup
+    [ withFillOpacity 0 $ mkPath
+      [ MoveTo OriginAbsolute [V2 (mouthDepth-1) 0]
+      , VerticalTo OriginRelative [-mouthHeight/2]
+      , HorizontalTo OriginAbsolute [-1]
+      , VerticalTo OriginAbsolute [-1]
+      , HorizontalTo OriginAbsolute [1]
+
+      , VerticalTo OriginAbsolute [-nubHeight/2]
+      , HorizontalTo OriginAbsolute [1-nubDepth]
+      , VerticalTo OriginAbsolute [nubHeight/2]
+      , HorizontalTo OriginAbsolute [1]
+
+      , VerticalTo OriginAbsolute [1]
+      , HorizontalTo OriginAbsolute [-1]
+      , VerticalTo OriginAbsolute [mouthHeight/2]
+      , HorizontalTo OriginAbsolute [mouthDepth-1]
+      , VerticalTo OriginRelative [-mouthHeight/2]
+      , EndPath
+      ]
+    ]
+
+instance Renderable ArcPlot where
+  toSVG plot | plot^.arcPlotPartial == 0 = None
+  toSVG plot = mkGroup
+      [ withId "arcPlotMask" $
+        MaskTree $ defaultSvg
+        & maskWidth .~ Num screenWidth
+        & maskHeight .~ Num screenHeight
+        & maskContent .~
+          [ withFillOpacity 1 $
+            withStrokeWidth 0 $
+            mkGroup
+            [ -- Show everything by default
+              withFillColor "white" $
+              mkCircle 1
+              -- Hide center
+            , withFillColor "black" $
+              mkCircle (plot^.arcPlotCenter)
+              -- Hide everything outside of arcPlotAngle
+            , withFillColor "black" $ scale 2 $ mkPath
+              [ MoveTo OriginAbsolute [V2 0 0]
+              , LineTo OriginAbsolute [V2 (cos pAng) (sin pAng)]
+              , EllipticalArc OriginAbsolute
+                [(1,1,0,True,True,V2 (cos pAng) (-sin pAng))]
+              , EndPath ]
+              -- Partially hide arc plot
+            , withFillColor "black" $ mkPath
+              [ MoveTo OriginAbsolute [V2 0 0]
+              , LineTo OriginAbsolute [V2 (-1) (0)]
+              , EllipticalArc OriginAbsolute
+                [(1,1,0,lAng>0,True,V2 (cos lAng) (sin lAng))]
+              , EndPath ]
+            ]
+          ]
+          
+      , (lowerTransformations $
+        circlePlot (plot^.arcPlotQuality) gen)
+        & maskRef .~ pure (Ref "arcPlotMask")
+      ]
+    where
+      pAng = (plot^.arcPlotAngle)/2
+      lAng = fromToS pAng (-pAng) (plot^.arcPlotPartial)
+      gen ang _r =
+        (plot^.arcPlotFn) ((ang/pAng+1)/2)

videos/miles/emoji.svg

@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512.001 512.001"><circle cx="256.001" cy="256" r="256" fill="#ffe17d"/><g fill="#ffd164"><path d="M293.162 474.839c-141.385 0-256-114.615-256-256 0-61.227 21.521-117.411 57.376-161.463C36.864 104.316.001 175.842.001 256c0 141.385 114.615 256 256 256 80.159 0 151.685-36.864 198.626-94.538-44.053 35.855-100.237 57.377-161.465 57.377z"/><path d="M181.678 512c9.084 0 16.516-7.432 16.516-16.516 0-9.084-7.432-16.516-16.516-16.516h8.258c9.084 0 16.516-7.432 16.516-16.516 0-9.084-7.432-16.516-16.516-16.516h8.258c9.084 0 16.516-7.432 16.516-16.516 0-9.084-7.432-16.516-16.516-16.516h90.839c9.122 0 16.516-7.395 16.516-16.516 0-9.122-7.395-16.516-16.516-16.516H140.388c-13.682 0-24.774-11.092-24.774-24.774V305.55c0-9.122-7.395-16.516-16.516-16.516-9.122 0-16.516 7.395-16.516 16.516v40.426a49.548 49.548 0 01-10.858 30.953l-7.698 9.622a66.066 66.066 0 00-14.477 41.27v34.632c0 27.365 22.184 49.548 49.548 49.548h82.581V512z"/></g><g fill="#ffc350"><path d="M198.195 495.484H99.098c-18.214 0-33.032-14.818-33.032-33.032v-34.633a49.727 49.727 0 0110.857-30.952l7.699-9.622c9.335-11.669 14.476-26.326 14.476-41.27v-56.942c-9.121 0-16.516 7.395-16.516 16.516v40.426a49.552 49.552 0 01-10.857 30.953l-7.698 9.622a66.066 66.066 0 00-14.477 41.27v34.633c0 27.365 22.183 49.548 49.548 49.548h82.581c9.083-.001 16.516-7.433 16.516-16.517zm107.354-99.097H189.936a8.258 8.258 0 000 16.516h99.097c9.122 0 16.516-7.394 16.516-16.516zm-132.129 41.29a8.258 8.258 0 008.258 8.258h16.516c9.084 0 16.516-7.432 16.516-16.516h-33.032a8.258 8.258 0 00-8.258 8.258z"/><path d="M165.162 470.71a8.258 8.258 0 008.258 8.258h16.516c9.084 0 16.516-7.432 16.516-16.516H173.42a8.258 8.258 0 00-8.258 8.258z"/></g><path d="M297.275 340.645c-1.556 0-3.137-.355-4.629-1.105-.565-.282-57.186-28.427-119.774-29.863-5.702-.129-10.218-4.855-10.089-10.556.129-5.698 4.863-10.419 10.556-10.081 67.387 1.544 126.137 30.823 128.605 32.069 5.089 2.565 7.129 8.77 4.565 13.859-1.814 3.601-5.452 5.677-9.234 5.677zM189.928 134.194c-2.25 0-4.516-.734-6.411-2.242-1.556-1.222-37.065-28.472-79.806-7.105-5.081 2.552-11.306.476-13.847-4.617a10.323 10.323 0 014.621-13.851c54.823-27.435 100.008 7.911 101.903 9.431 4.452 3.56 5.169 10.056 1.613 14.508a10.31 10.31 0 01-8.073 3.876zm115.613 16.52a10.33 10.33 0 01-10.113-8.302c-1.121-5.589 2.508-11.028 8.097-12.145l82.581-16.516a10.305 10.305 0 0112.145 8.097c1.121 5.589-2.508 11.028-8.097 12.145l-82.581 16.516c-.685.136-1.362.205-2.032.205z" fill="#aa7346"/><path d="M152.007 208.018c-11.316-1.395-19.359-11.7-17.964-23.016l2.021-16.392c1.395-11.316 11.7-19.359 23.016-17.964 11.316 1.395 19.359 11.7 17.964 23.016l-2.021 16.392c-1.395 11.316-11.7 19.359-23.016 17.964z" fill="#7d5046"/><path d="M159.08 150.646a20.708 20.708 0 00-4.149-.092l-3.486 28.273c-.837 6.79 3.988 12.973 10.778 13.81s12.973-3.988 13.81-10.778l1.011-8.196c1.395-11.317-6.647-21.622-17.964-23.017z" fill="#9c6846"/><path d="M324.91 226.082c-11.316-1.395-19.359-11.7-17.964-23.016l2.021-16.392c1.395-11.316 11.7-19.359 23.016-17.964 11.316 1.395 19.359 11.7 17.964 23.016l-2.021 16.392c-1.395 11.317-11.7 19.36-23.016 17.964z" fill="#7d5046"/><path d="M331.983 168.71a20.708 20.708 0 00-4.149-.092l-3.486 28.273c-.837 6.79 3.988 12.973 10.778 13.81 6.79.837 12.973-3.988 13.81-10.778l1.011-8.196c1.395-11.317-6.647-21.621-17.964-23.017z" fill="#9c6846"/></svg>

videos/miles/miles.hs

@@ -0,0 +1,70 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module Main where
+
+import           Codec.Picture.Types
+import           Control.Lens
+import           Graphics.SvgTree                (Origin (..), PathCommand (..))
+import           Linear.V2
+import           Reanimate
+import           Reanimate.Animation
+import           Reanimate.Builtin.Documentation
+import           Reanimate.Scene
+
+import           Objects
+
+env :: Animation -> Animation
+env = mapA (withStrokeColor "black")
+
+main :: IO ()
+main = reanimate $ env $ scene $ do
+  newSpriteSVG_ $ mkBackground "grey"
+  aPlot <- newObject $ ArcPlot
+    { _arcPlotPartial = 1
+    , _arcPlotFn      = promotePixel . viridis
+    , _arcPlotAngle   = 120/180*pi
+    , _arcPlotCenter  = 0.5
+    , _arcPlotQuality = 100
+    }
+  rFn <- newObject $ RoundFunction 1 0.5
+  sFn <- newObject $ SquareFunction 1 0.5 0.1 0.5
+  oModify aPlot $
+    oContext %~ \o -> scale 3 . o
+  oModify rFn $
+    oContext %~ \o -> lowerTransformations . scale 3 . o
+  oModify sFn $
+    oContext %~ \o -> lowerTransformations . scale 3 . o
+
+  -- oShowWith rFn oDrawLine
+  -- oShowWith aPlot oFadeIn
+  -- oShowWith sFn $ adjustDuration (*2) . oDrawLine
+
+  oShow rFn
+  b1 <- newObject $ GoBoard 5 [] [] []
+  oModify b1 $
+    oContext %~ \o -> lowerTransformations . scale 2.5 . o
+  oShow b1
+
+  -- oTweenV aPlot 1 $ \t ->
+  --   arcPlotAngle %~ \v -> fromToS v (60/180*pi) t
+  -- oTweenV aPlot 1 $ \t ->
+  --   arcPlotAngle %~ \v -> fromToS v (300/180*pi) t
+  -- oTweenV aPlot 1 $ \t ->
+  --   arcPlotCenter %~ \v -> fromToS v 0.1 t
+  -- oTweenV aPlot 1 $ \t ->
+  --   arcPlotCenter %~ \v -> fromToS v 0.9 t
+
+  -- oTweenV aPlot 3 $ \t ->
+  --   arcPlotPartial %~ \v -> fromToS v 1 t
+  -- oTweenV aPlot 1 $ \t ->
+  --   arcPlotAngle %~ \v -> fromToS v (60/180*pi) t
+  -- oTweenV aPlot 1 $ \t ->
+  --   arcPlotPartial %~ \v -> fromToS v 0 t
+
+  wait 1
+
+oDrawLine :: SVG -> Animation
+oDrawLine = oStagger $ \svg -> animate $ \t -> partialSvg t svg
+