| Copyright | Written by David Himmelstrup |
|---|---|
| License | Unlicense |
| Maintainer | lemmih@gmail.com |
| Stability | experimental |
| Portability | POSIX |
| Safe Haskell | None |
| Language | Haskell2010 |
Reanimate.Scene
Contents
Description
Scenes are an imperative way of defining animations.
Synopsis
- data Scene s a
- type ZIndex = Int
- 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
- wait :: Duration -> Scene s ()
- waitUntil :: Time -> Scene s ()
- waitOn :: Scene s a -> Scene s a
- adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
- withSceneDuration :: Scene s () -> Scene s Duration
- data Var s a
- newVar :: a -> Scene s (Var s a)
- readVar :: Var s a -> Scene s a
- writeVar :: Var s a -> a -> Scene s ()
- modifyVar :: Var s a -> (a -> a) -> Scene s ()
- tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
- tweenVarUnclamped :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
- simpleVar :: (a -> SVG) -> a -> Scene s (Var s a)
- findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a)
- data Sprite s
- data Frame s a
- unVar :: Var s a -> Frame s a
- spriteT :: Frame s Time
- spriteDuration :: Frame s Duration
- newSprite :: Frame s SVG -> Scene s (Sprite s)
- newSprite_ :: Frame s SVG -> Scene s ()
- newSpriteA :: Animation -> Scene s (Sprite s)
- newSpriteA' :: Sync -> Animation -> Scene s (Sprite s)
- newSpriteSVG :: SVG -> Scene s (Sprite s)
- newSpriteSVG_ :: SVG -> Scene s ()
- destroySprite :: Sprite s -> Scene s ()
- applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
- spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
- spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
- spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
- spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a)
- spriteE :: Sprite s -> Effect -> Scene s ()
- spriteZ :: Sprite s -> ZIndex -> Scene s ()
- spriteScope :: Scene s a -> Scene s a
- data Object s a
- data ObjectData a
- oNew :: Renderable a => a -> Scene s (Object s a)
- newObject :: Renderable a => a -> Scene s (Object s a)
- oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s ()
- oModifyS :: Object s a -> State (ObjectData a) b -> Scene s ()
- oRead :: Object s a -> Getting b (ObjectData a) b -> Scene s b
- oTween :: Object s a -> Duration -> (Double -> ObjectData a -> ObjectData a) -> Scene s ()
- oTweenS :: Object s a -> Duration -> (Double -> State (ObjectData a) b) -> Scene s ()
- oTweenV :: Renderable a => Object s a -> Duration -> (Double -> a -> a) -> Scene s ()
- oTweenVS :: Renderable a => Object s a -> Duration -> (Double -> State a b) -> Scene s ()
- class Renderable a where
- oTranslate :: Lens' (ObjectData a) (Double, Double)
- oSVG :: Getter (ObjectData a) SVG
- oContext :: Lens' (ObjectData a) (SVG -> SVG)
- oMargin :: Lens' (ObjectData a) (Double, Double, Double, Double)
- oMarginTop :: Lens' (ObjectData a) Double
- oMarginRight :: Lens' (ObjectData a) Double
- oMarginBottom :: Lens' (ObjectData a) Double
- oMarginLeft :: Lens' (ObjectData a) Double
- oBB :: Getter (ObjectData a) (Double, Double, Double, Double)
- oBBMinX :: Getter (ObjectData a) Double
- oBBMinY :: Getter (ObjectData a) Double
- oBBWidth :: Getter (ObjectData a) Double
- oBBHeight :: Getter (ObjectData a) Double
- oOpacity :: Lens' (ObjectData a) Double
- oShown :: Lens' (ObjectData a) Bool
- oZIndex :: Lens' (ObjectData a) Int
- oEasing :: Lens' (ObjectData a) Signal
- oScale :: Lens' (ObjectData a) Double
- oScaleOrigin :: Lens' (ObjectData a) (Double, Double)
- oTopY :: Lens' (ObjectData a) Double
- oBottomY :: Lens' (ObjectData a) Double
- oLeftX :: Lens' (ObjectData a) Double
- oRightX :: Lens' (ObjectData a) Double
- oCenterXY :: Lens' (ObjectData a) (Double, Double)
- oValue :: Renderable a => Lens' (ObjectData a) a
- oShow :: Object s a -> Scene s ()
- oHide :: Object s a -> Scene s ()
- oFadeIn :: Object s a -> Duration -> Scene s ()
- oFadeOut :: Object s a -> Duration -> Scene s ()
- oGrow :: Object s a -> Duration -> Scene s ()
- oShrink :: Object s a -> Duration -> Scene s ()
- oTransform :: Object s a -> Object s b -> Duration -> Scene s ()
- newtype Circle = Circle {}
- circleRadius :: Lens' Circle Double
- data Rectangle = Rectangle {}
- rectWidth :: Lens' Rectangle Double
- rectHeight :: Lens' Rectangle Double
- data Morph = Morph {}
- morphDelta :: Lens' Morph Double
- morphSrc :: Lens' Morph SVG
- morphDst :: Lens' Morph SVG
- data Camera = Camera
- cameraAttach :: Object s Camera -> Object s a -> Scene s ()
- cameraFocus :: Object s Camera -> (Double, Double) -> Scene s ()
- cameraSetZoom :: Object s Camera -> Double -> Scene s ()
- cameraZoom :: Object s Camera -> Duration -> Double -> Scene s ()
- cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s ()
- cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s ()
- liftST :: ST s a -> Scene s a
- transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s ()
- evalScene :: (forall s. Scene s a) -> a
Scenes
A Scene represents a sequence of animations and variables
that change over time.
The ZIndex property specifies the stack order of sprites and animations. Elements with a higher ZIndex will be drawn on top of elements with a lower index.
play :: Animation -> Scene s () Source #
Play an animation once and then remove it. This advances the clock by the duration of the animation.
Example:
do play drawBox play drawCircle

fork :: Scene s a -> Scene s a Source #
Execute actions in a scene without advancing the clock. Note that scenes do not end before all forked actions have completed.
Example:
do fork $ play drawBox play drawCircle

queryNow :: Scene s Time Source #
Query the current clock timestamp.
Example:
do now <- play drawCircle *> queryNow
play $ staticFrame 1 $ scale 2 $ withStrokeWidth 0.05 $
mkText $ "Now=" <> T.pack (show now)
wait :: Duration -> Scene s () Source #
Advance the clock by a given number of seconds.
Example:
do fork $ play drawBox wait 1 play drawCircle

waitOn :: Scene s a -> Scene s a Source #
Wait until all forked and sequential animations have finished.
Example:
do waitOn $ fork $ play drawBox play drawCircle

Variables
newVar :: a -> Scene s (Var s a) Source #
Create a new variable with a default value. Variables always have a defined value even if they are read at a timestamp that is earlier than when the variable was created. For example:
do v <- fork (wait 10 >> newVar 0) -- Create a variable at timestamp '10'.
readVar v -- Read the variable at timestamp '0'.
-- The value of the variable will be '0'.writeVar :: Var s a -> a -> Scene s () Source #
Write the value of a variable at the current timestamp.
Example:
do v <- newVar 0 newSprite $ mkCircle <$> unVar v writeVar v 1; wait 1 writeVar v 2; wait 1 writeVar v 3; wait 1

modifyVar :: Var s a -> (a -> a) -> Scene s () Source #
Modify the value of a variable at the current timestamp and all future timestamps.
tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s () Source #
Modify a variable between now and now+duration.
Note: The modification function is invoked for past timestamps (with a time value of 0) and
for timestamps after now+duration (with a time value of 1). See tweenVarUnclamped.
tweenVarUnclamped :: Var s a -> Duration -> (a -> Time -> a) -> Scene s () Source #
Modify a variable between now and now+duration.
Note: The modification function is invoked for past timestamps (with a negative time value) and
for timestamps after now+duration (with a time value greater than 1).
simpleVar :: (a -> SVG) -> a -> Scene s (Var s a) Source #
Create and render a variable. The rendering will be born at the current timestamp and will persist until the end of the scene.
Example:
do var <- simpleVar mkCircle 0 tweenVar var 2 $ \val -> fromToS val (screenHeight/2)

findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a) Source #
Helper function for filtering variables.
Sprites
Sprites are animations with a given time of birth as well as a time of death. They can be controlled using variables, tweening, and effects.
Sprite frame generator. Generates frames over time in a stateful environment.
unVar :: Var s a -> Frame s a Source #
Dereference a variable as a Sprite frame.
Example:
do v <- newVar 0 newSprite $ mkCircle <$> unVar v tweenVar v 1 $ \val -> fromToS val 3 tweenVar v 1 $ \val -> fromToS val 0

spriteDuration :: Frame s Duration Source #
Dereference duration of the current sprite.
newSprite :: Frame s SVG -> Scene s (Sprite s) Source #
Create new sprite defined by a frame generator. Unless otherwise specified using
destroySprite, the sprite will die at the end of the scene.
Example:
do newSprite $ mkCircle <$> spriteT -- Circle sprite where radius=time. wait 2
![]()
newSprite_ :: Frame s SVG -> Scene s () Source #
Create new sprite defined by a frame generator. The sprite will die at the end of the scene.
newSpriteA :: Animation -> Scene s (Sprite s) Source #
Create a new sprite from an animation. This advances the clock by the
duration of the animation. Unless otherwise specified using
destroySprite, the sprite will die at the end of the scene.
Note: If the scene doesn't end immediately after the duration of the
animation, the animation will be stretched to match the lifetime of the
sprite. See newSpriteA' and play.
Example:
do fork $ newSpriteA drawCircle play drawBox play $ reverseA drawBox
![]()
newSpriteA' :: Sync -> Animation -> Scene s (Sprite s) Source #
Create a new sprite from an animation and specify the synchronization policy. This advances the clock by the duration of the animation.
Example:
do fork $ newSpriteA' SyncFreeze drawCircle play drawBox play $ reverseA drawBox
![]()
newSpriteSVG :: SVG -> Scene s (Sprite s) Source #
Create a sprite from a static SVG image.
Example:
do newSpriteSVG $ mkBackground "lightblue" play drawCircle
![]()
newSpriteSVG_ :: SVG -> Scene s () Source #
Create a permanent sprite from a static SVG image. Same as newSpriteSVG
but the sprite isn't returned and thus cannot be destroyed.
destroySprite :: Sprite s -> Scene s () Source #
Destroy a sprite, preventing it from being rendered in the future of the scene.
If destroySprite is invoked multiple times, the earliest time-of-death is used.
Example:
do s <- newSpriteSVG $ withFillOpacity 1 $ mkCircle 1 fork $ wait 1 >> destroySprite s play drawBox
![]()
applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s () Source #
Change the rendering of a sprite using data from a variable. If data from several variables is needed, use a frame generator instead.
Example:
do s <- fork $ newSpriteA drawBox v <- newVar 0 applyVar v s rotate tweenVar v 2 $ \val -> fromToS val 90

spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s () Source #
Low-level frame modifier.
spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s () Source #
Map the SVG output of a sprite.
Example:
do s <- fork $ newSpriteA drawCircle wait 1 spriteMap s flipYAxis
![]()
spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s () Source #
Modify the output of a sprite between now and now+duration.
Example:
do s <- fork $ newSpriteA drawCircle spriteTween s 1 $ \val -> translate (screenWidth*0.3*val) 0
![]()
spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a) Source #
Create a new variable and apply it to a sprite.
Example:
do s <- fork $ newSpriteA drawBox v <- spriteVar s 0 rotate tweenVar v 2 $ \val -> fromToS val 90
![]()
spriteE :: Sprite s -> Effect -> Scene s () Source #
Apply an effect to a sprite.
Example:
do s <- fork $ newSpriteA drawCircle spriteE s $ overBeginning 1 fadeInE spriteE s $ overEnding 0.5 fadeOutE
![]()
spriteZ :: Sprite s -> ZIndex -> Scene s () Source #
Set new ZIndex of a sprite.
Example:
do s1 <- newSpriteSVG $ withFillOpacity 1 $ withFillColor "blue" $ mkCircle 3 newSpriteSVG $ withFillOpacity 1 $ withFillColor "red" $ mkRect 8 3 wait 1 spriteZ s1 1 wait 1
![]()
spriteScope :: Scene s a -> Scene s a Source #
Destroy all local sprites at the end of a scene.
Example:
do -- the rect lives through the entire 3s animation
newSpriteSVG_ $ translate (-3) 0 $ mkRect 4 4
wait 1
spriteScope $ do
-- the circle only lives for 1 second.
local <- newSpriteSVG $ translate 3 0 $ mkCircle 2
spriteE local $ overBeginning 0.3 fadeInE
spriteE local $ overEnding 0.3 fadeOutE
wait 1
wait 1![]()
Object API
Objects are SVG nodes (represented as Haskell values) with identity, location, and several other properties that can change over time.
data ObjectData a Source #
Container for object properties.
oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s () Source #
Modify object properties.
oModifyS :: Object s a -> State (ObjectData a) b -> Scene s () Source #
Modify object properties using a stateful API.
oTween :: Object s a -> Duration -> (Double -> ObjectData a -> ObjectData a) -> Scene s () Source #
Modify object properties over a set duration.
oTweenS :: Object s a -> Duration -> (Double -> State (ObjectData a) b) -> Scene s () Source #
Modify object properties over a set duration using a stateful API.
oTweenV :: Renderable a => Object s a -> Duration -> (Double -> a -> a) -> Scene s () Source #
Modify object value over a set duration. This is a convenience function
for modifying oValue.
oTweenVS :: Renderable a => Object s a -> Duration -> (Double -> State a b) -> Scene s () Source #
Modify object value over a set duration using a stateful API. This is a
convenience function for modifying oValue.
class Renderable a where Source #
Objects can be any Haskell structure as long as it can be rendered to SVG.
Instances
| Renderable Tree Source # | |
| Renderable Camera Source # | |
| Renderable Morph Source # | |
| Renderable Rectangle Source # | |
| Renderable Circle Source # | |
Object Properties
oTranslate :: Lens' (ObjectData a) (Double, Double) Source #
Object position. Default: <0,0>
oSVG :: Getter (ObjectData a) SVG Source #
Rendered SVG node of an object. Does not include context or object properties. Read-only.
oContext :: Lens' (ObjectData a) (SVG -> SVG) Source #
Custom render context. Is applied to the object for every frame that it is shown.
oMargin :: Lens' (ObjectData a) (Double, Double, Double, Double) Source #
Object margins (top, right, bottom, left) in local units.
oMarginTop :: Lens' (ObjectData a) Double Source #
Object's top margin.
oMarginRight :: Lens' (ObjectData a) Double Source #
Object's right margin.
oMarginBottom :: Lens' (ObjectData a) Double Source #
Object's bottom margin.
oMarginLeft :: Lens' (ObjectData a) Double Source #
Object's left margin.
oBB :: Getter (ObjectData a) (Double, Double, Double, Double) Source #
Object bounding-box (minimal X-coordinate, minimal Y-coordinate,
width, height). Uses boundingBox
and has the same limitations.
oShown :: Lens' (ObjectData a) Bool Source #
Toggle for whether or not the object should be rendered. Default: False
oEasing :: Lens' (ObjectData a) Signal Source #
Easing function used when modifying object properties.
Default: curveS 2
oScaleOrigin :: Lens' (ObjectData a) (Double, Double) Source #
Origin point for scaling. Default: <0,0>
oTopY :: Lens' (ObjectData a) Double Source #
Derived location of the top-most point of an object + margin.
oBottomY :: Lens' (ObjectData a) Double Source #
Derived location of the bottom-most point of an object + margin.
oLeftX :: Lens' (ObjectData a) Double Source #
Derived location of the left-most point of an object + margin.
oRightX :: Lens' (ObjectData a) Double Source #
Derived location of the right-most point of an object + margin.
oCenterXY :: Lens' (ObjectData a) (Double, Double) Source #
Derived location of an object's center point.
oValue :: Renderable a => Lens' (ObjectData a) a Source #
Lens for the source value contained in an object.
Graphics object methods
oTransform :: Object s a -> Object s b -> Duration -> Scene s () Source #
Morph source object into target object over a set duration.
Pre-defined objects
Basic object mapping to <circle/> in SVG.
Constructors
| Circle | |
Fields | |
Instances
| Renderable Circle Source # | |
Basic object mapping to <rect/> in SVG.
Constructors
| Rectangle | |
Fields
| |
Instances
| Renderable Rectangle Source # | |
Object representing an interpolation between SVG nodes.
Instances
| Renderable Morph Source # | |
morphDelta :: Lens' Morph Double Source #
Control variable for the interpolation. A value of 0 gives the source SVG and 1 gives the target svg.
Cameras can take control of objects and manipulate them with convenient pan and zoom operations.
Constructors
| Camera |
Instances
| Renderable Camera Source # | |
cameraAttach :: Object s Camera -> Object s a -> Scene s () Source #
Connect an object to a camera such that camera settings (position, zoom, and rotation) is applied to the object.
Example
do cam <- newObject Camera
circ <- newObject $ Circle 2
oModifyS circ $
oContext .= withFillOpacity 1 . withFillColor "blue"
oShow circ
cameraAttach cam circ
cameraZoom cam 1 2
cameraZoom cam 1 1
cameraFocus :: Object s Camera -> (Double, Double) -> Scene s () Source #
Example
do cam <- newObject Camera circ <- newObject $ Circle 2; oShow circ oModify circ $ oTranslate .~ (-3,0) box <- newObject $ Rectangle 4 4; oShow box oModify box $ oTranslate .~ (3,0) cameraAttach cam circ cameraAttach cam box cameraFocus cam (-3,0) cameraZoom cam 2 2 -- Zoom in cameraZoom cam 2 1 -- Zoom out cameraFocus cam (3,0) cameraZoom cam 2 2 -- Zoom in cameraZoom cam 2 1 -- Zoom out

cameraSetZoom :: Object s Camera -> Double -> Scene s () Source #
Instantaneously set camera zoom level.
cameraZoom :: Object s Camera -> Duration -> Double -> Scene s () Source #
Change camera zoom level over a set duration.
cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s () Source #
Instantaneously set camera location.
cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s () Source #
Change camera location over a set duration.
ST internals
transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s () Source #
Apply a transformation with a given overlap. This makes sure to keep timestamps intact such that events can still be timed by transcripts.