﻿ CSE 230, Winter 2011 - Functional Animations

# Functional Animations

Credits: Lecture and literate Haskell file borrowed from Ranjit Jhala, UCSD CSE 230

``> {-# LANGUAGE NoMonomorphismRestriction #-}``
``> import Shape> import Draw> import Picture> import SOE hiding (Region)> import qualified SOE as G (Region)``

# Graphics Recap

## Representing Regions

Recall the `Shape` type from a few lectures back (here we’ll just use the definitions in the SOE library.)

``data Shape = Rectangle Side Side           | Ellipse Radius Radius           | RtTriangle Side Side           | Polygon [Vertex]     deriving Showtype Radius = Floattype Side   = Floattype Vertex  = (Float,Float)``

We can create specific shape values like

``> s1 = Rectangle 3 2> s2 = Ellipse 1 1.5> s3 = RtTriangle 3 2> s4 = Polygon [(-2.5, 2.5)>              ,(-3, 0)>              ,(-1.7,-1.0)>              ,(-1.1,0.2)>              ,(-1.5,2.0)]``

We can convert a `Shape` into a more general `Region` that contains atomic shapes, which can be operated on in various ways.

``data Region = Shape Shape		-- primitive shape            | Translate Vector Region -- translated region            | Scale      Vector Region -- scaled region            | Complement Region	-- inverse of region            | Region `Union` Region   -- union of regions            | Region `Intersect` Region -- intersection of regions            | Region `Xor` Region -- XOR of regions            | Empty                   -- empty region     deriving Show``

We can convert our basic shapes to atomic regions

``> r1 = Shape s1> r2 = Shape s2> r3 = Shape s3> r4 = Shape s4``

and combine the atomic regions

``> reg1  = r3 `Union` (r1 `Intersect` (Complement r2 `Union` r4)) ``

## Representing Pictures

Finally, we have a `Picture` type which comprises colored regions, which can be layered over each other

``data Picture = Region Color Region             | Picture `Over` Picture             | EmptyPic     deriving Show``

Here is an atomic picture

``> pic1  = Region Red reg1``

Here’s another region

``> r5   = Shape \$ Rectangle 1 1> r6   = Shape \$ Ellipse 0.5 0.5> reg2 = (Scale (2,2) r6) `Union` >        (Translate (2,1) r6) `Union` >        (Translate (-2,0) r5)``

which we color yellow

``> pic2 = Region Yellow reg2``

and we can layer the two pictures over each other

``> pic3 =pic2 `Over` pic1``

## Drawing Pictures

We can render a picture in a window via the function `draw`

``> main1 = draw "Picture 1" pic1``

Lets render the other pictures

``> main2 = draw "Picture 2" pic2``

and

``> main3 = draw "Picture 3" \$ pic3 ``

# From Pictures To Animations

So far, our pictures have been static, nothing moves.

Suppose we wanted to create animations. The standard trick for how moving images work is by exploiting persistence of vision wherein an illusion of motion is created by rapidly rendering a series of images. This seems like an inherently imperative activity

1. initialize image
2. render image
3. pause
4. change image
5. go to step 1.

However, this is hideously low-level: it is hard to compose animations from simpler ones, hard to reuse animations, and generally rather brittle. Instead, we will take a radically different view, where we will represent an animation as a purely functional value. How? A type is worth a thousand pictures…

``> type Animation a = Time -> a> type Time        = Float``

That is, an animation is a function that tells us, at each time instant, what the image to be rendered at that instant is!

``> rubberBall :: Animation Shape> rubberBall = \t -> Ellipse (sin t) (cos t)``

or `Region` animations

``> revolvingBall :: Animation Region> revolvingBall = \t -> Translate (sin t, cos t) ball >   where ball  = Shape (Ellipse 0.2 0.2)``

or `Picture` animations

``> planets ::  Animation Picture> planets t = p1 `Over` p2>   where p1 = Region Red    \$ Shape (rubberBall t) >         p2 = Region Yellow \$ revolvingBall t``

or just plain old `String` animations

``> ticker :: Animation String> ticker t = "The time is :" ++ show t``

How do we render all these animations? Well, all we need is a function that renders graphics, that is, takes a window name, an `Animation Graphic` and returns an action (the rendering.)

``> animate :: String -> Animation Graphic -> IO ()``

with this, rendering is trivial. First, lets create an appropriate animation

``> blueBall ::  Animation Graphic> blueBall = withColor Blue . shapeToGraphic . rubberBall ``

The above type looks a bit surprising, but lets slowly step through the expression.

``withColor Blue :: Graphic -> GraphicshapeToGraphic :: Shape -> Graphic``

and so

``withColor Blue . shapeToGraphic :: Shape -> Graphic``

Finally,

``rubberBall :: Time -> Shape ``

and so

``withColor Blue . shapeToGraphic . rubberBall :: Time -> Graphic``

Now, lets run some animations!

``> main4 = animate "Shape"   \$ withColor Blue . shapeToGraphic . rubberBall ``
``> main5 = animate "Text"    \$ text (100,200) . ticker ``
``> main6 = animate "Region"  \$ withColor Yellow . regionToGraphic . revolvingBall``
``> main7 = animate "Picture" \$ picToGraphic . planets``

# A DSL for Animations

We can build animations up at a low-level, by constructing functions from `Time` to `Graphic` but this is a bit ugly. Next, we will use type classes to design some generic operators for animations, which will allow us to write animations much more easily and smoothly.

When we are done, we will be able to create very rich animations, from very simple ones, by elegantly composing the animations, thereby allowing us reuse sub-animations and animation combinators in a safe and flexible way.

1. We start with a trivial behavior which is a stationary object.
``> demo1 = animateB "1" \$ reg yellow \$ ballB``
1. Next, we can simply translate a picture behavior with an xy-coordinate behavior thereby giving us a shifted animation.
``> demo2 = animateB "2" \$ reg yellow \$ tx (0, sin time) ballB``
1. We can trivially reuse the bouncing mechanism, by translating a different object with the same rotation behavior.
``> demo3 = animateB "3" \$ reg red \$ tx (0, sin time) pentaB``
1. We can think of the color itself as a behavior and if we replace `red` with `flash` then the rendered image’s color now changes dynamically!
``> demo4 = animateB "4" \$ reg flash \$ tx (0, sin time) ballB ``
1. Next, we can layer multiple animations by simply putting them over each other.
``> demo5 = animateB "5" \$ a1 `over` a2 >   where a1 = reg red    \$ tx (0, sin time) ballB>         a2 = reg yellow \$ tx (sin time, 0) pentaB``
1. We can design a rotation combinator to rotate each individual element
``> demo6 = animateB "6" \$ a1 `over` a2 >   where a1 = reg red    \$ tx (0, sin time) ballB>         a2 = reg yellow \$ lift2 turn (pi * sin time) pentaB``
1. We can even think of time as a behavior and can manipulate it. For example, here is an animation layered with itself `2` seconds in the future,
``> demo7 = animateB "7" \$ a1 `over` a2 >   where a1 = reg red \$ tx (sin time, cos time) ballB>         a2 = timeTx (2 + time) a1 ``
1. Or we can speed up time (fast-forward)
``> demo8 = animateB "8" \$ a1 `over` a2 >   where a1 = reg red \$ tx (sin time, cos time) ballB>         a2 = timeTx (2 * time) a1 ``
1. or slow it down (slow-motion)
``> demo9 = animateB "9" \$ a1 `over` a2 >   where a1 = reg red \$ tx (sin time, cos time) ballB>         a2 = timeTx (0.5 * time) a1 ``
1. or go backwards in time (rewind)
``> demo0 = animateB "0" \$ a1 `over` a2 >   where a1 = reg red \$ tx (sin time, cos time) ballB>         a2 = timeTx (-1 * time) a1 ``

Pretty sweet! You can imagine a variety of other combinators for manipulating animations. Seems pretty magical doesn’t it? It turns out, its not hard, once you put on the Haskell goggles.

Our strategy for creating the DSL for animations, will be to

• make behaviors a first-class value, by defining a special type for behaviors, and

• defining a variety of numeric and graphical operations over behaviors by making the above type an instance of various classes which define the numerical and graphical operations.

## A Type For Behaviors

First, lets define a newtype which is basically a wrapper around the old animation type.

``> newtype Behavior a = Beh (Time -> a)``

There are several reasons for doing this.

1. The typeclass instantiation is not very happy with type synonyms (we just saw an example, but that was after pleading with haskell via some command line options.) There are rather technical reasons for this, which we will avoid going into right now.

2. More importantly, we will want to hide the actual implementation of behaviors from clients (ie make the definition private), so that they can only be constructed using the high-level operations that we provide. To use the `BST` example, we would want to hide the implementation of the `BST` to prevent a client from creating a raw `BST` that does not satisfy the binary-search-ordered invariant.

Now, we can easily define an animation function for this new behavior type.

``> animateB ::  String -> Behavior Picture -> IO ()> animateB s (Beh f) = animate s (picToGraphic. f)``

Next, lets look at how to build our DSL for writing `Behavior Picture` values.

## Lifting Operations To Behaviors

Remember the good old `map` function? It showed how to convert a function from `a` to `b` into one from `[a]` to `[b]`. We say that `map` lifts a function from `a` to `b` into one from lists of `a` to lists of `b`.

The notion of “lifting” is quite general (and has been studied formally.) Rather than getting too abstract, lets just replace “[]” above with `Behavior` and `map` with `lift1` and we can imagine functions like

``> lift1 :: (a -> b) -> Behavior a -> Behavior b> lift1 f (Beh a) = Beh \$ \t -> f (a t)``

thus, `lift1` lifts 1-ary functions similarly, we can lift 2-ary functions and 3-ary functions

``> lift2 :: (a -> b -> c) -> Behavior a -> Behavior b -> Behavior c> lift2 f (Beh a) (Beh b) = Beh \$ \t -> f (a t) (b t)> > lift3 :: (a -> b -> c -> d) -> Behavior a -> Behavior b -> Behavior c -> Behavior d> lift3 f (Beh a) (Beh b) (Beh c) = Beh \$ \t -> f (a t) (b t) (c t)``

What do you think `lift0` might do? Yes, it just “lifts” a constant value into a behaviour that returns that value at each instant in time.

``> lift0 :: a -> Behavior a> lift0 x = Beh \$ \t -> x``

and a function that lifts a function over a list.

``> liftXs ::  ([t] -> a) -> [Behavior t] -> Behavior a> liftXs f bs = Beh (\t -> f (map (\(Beh b) -> b t) bs))``

Now, we will make `Behavior` an instance of `Num` by simply lifting the various operations over `a` to `Behavior a` (whenever `Num a` holds.)

``> instance Num a => Num (Behavior a) where>   (+)         = lift2 (+)>   (*)         = lift2 (*)>   negate      = lift1 negate>   abs         = lift1 abs>   signum      = lift1 signum>   fromInteger = lift0 . fromInteger``

We can do the same for operations defined over `Fractional` and `Floating` values.

``> instance Fractional a => Fractional (Behavior a) where>   (/) = lift2 (/)>   fromRational = lift0 . fromRational``
``> instance Floating a => Floating (Behavior a) where>   pi    = lift0 pi>   sqrt  = lift1 sqrt>   exp   = lift1 exp>   log   = lift1 log>   sin   = lift1 sin>   cos   = lift1 cos>   tan   = lift1 tan>   asin  = lift1 asin>   acos  = lift1 acos>   atan  = lift1 atan>   sinh  = lift1 sinh>   cosh  = lift1 cosh>   tanh  = lift1 tanh>   asinh = lift1 asinh>   acosh = lift1 acosh>   atanh = lift1 atanh``

As a result of the above, the operations that we perform on floating point numbers (eg adding them, multiplying them, taking their `sin`) can be lifted to behaviors on floating point numbers. For example, if we define the behavior

``> time :: Behavior Time> time = Beh \$ \t -> t``

then `sin time` is the behavior

``sin time == {- unfold overloading for time, sin -}             lift1 sin (\t -> t)          == {- unfold definition of lift1 -}            \t -> sin ((\t -> t) t)          == {- unfold the anonymous functions -}            \t -> sin t ``

Similarly, we can lift the basic shape and color constructors to `Behavior`

``> reg    = lift2 Region> shape  = lift1 Shape> poly   = liftXs Polygon> ell    = lift2 Ellipse> red    = lift0 Red> yellow = lift0 Yellow> green  = lift0 Green > blue   = lift0 Blue> tx (Beh a1, Beh a2) (Beh r)>        = Beh (\t -> Translate (a1 t, a2 t) (r t))``

Now, we can define a simple ball and pentagon behavior

``> ballB    = shape \$ ell 0.2 0.2``
``> pentaB   = shape \$ poly (map lift0 vs) >   where vs = [ ( 0.0, 0.8)>              , ( 0.3,-0.5)>              , (-0.3,-0.5)]``

we can define a function that takes any `Behavior Region` and makes it go around in a circle

``> revolveRegion = tx (sin time, cos time) ``

after which we get the spinning behaviors

``> revBallB  = revolveRegion ballB> revPentaB = revolveRegion pentaB``
``reg :: Behavior Color -> Behavior Region -> Behavior Picture``

defined above, takes a `Behavior Color` and a `Behavior Region` and returns a `Behavior Picture` which is the colored version of the region, thereby allowing us build a simple atomic animation

``> anim1 = animateB "Yellow Revolving Sphere" \$ reg yellow revBallB``

Next, we can define a multiplexer or conditional combinator for behaviors like so

``> cond :: Behavior Bool -> Behavior a -> Behavior a -> Behavior a> cond = lift3 \$ \b x y -> if b then x else y ``

Huh? Simple. We made a function of three arguments that uses the first argument to choose between the second or third, and simply hoist it up to work over behaviors!

We can similarly lift primitive comparison operators up into `Behavior` land

``> (>*) = lift2 (>)> (<*) = lift2 (<)``

Now, we can use these combinators to define different `Behavior Bool` values, and hence, get different `Behavior Color` values

``> flash   = cond (cos time >* 0) red yellow> flash'  = cond (cos time >* 0) green blue``

which we can drop into our old animation to get different color schemes!

``> anim2 = animateB "Revolving Sphere" \$ reg flash   revBallB> anim3 = animateB "Revolving Sphere" \$ reg flash'  revBallB``

Indeed, we can conditionally compose the two flashing colors, to get a four-way flash

``> flash'' = cond (sin time >* 0) flash flash' > anim4 = animateB "Revolving Sphere" \$ reg flash'' revBallB``

## New Typeclasses For Graphical Operations

Next, lets see how we can layer behaviors. To do so, lets define a typeclass that supports layering

``> class Combine a where>   empty :: a>   over  :: a -> a -> a``

We can layer multiple values using the combinator

``> overMany = foldr over empty``

NOTE: the type for `overMany`, behold automatic propagation at work! We can make `Picture` and `Behavior` instances of `Combine`

``> instance Combine Picture where>   empty = EmptyPic>   over  = Over``
``> instance Combine a => Combine (Behavior a) where>   empty = lift0 empty>   over  = lift2 over``

The names are quite self-explanatory. By virtue of the above, we can use `overMany` to layer multiple `Picture` and `Behavior` values

``> anim5 = animateB "Many Spheres" \$ overMany [b1,b2,b3]>   where b1 = reg flash   \$ tx ((sin time)-1, cos time) ballB>         b2 = reg flash'  \$ tx ((sin time)+1, cos time) ballB>         b3 = reg flash'' \$ tx (2 * sin time, cos time) pentaB``

Similarly, we can define a richer class of operations on Shapes and lift them to behaviors

``> class Deformable a where>   turn    :: Float -> a -> a>   stretch :: Float -> a -> a ``

that is, we can turn (rotate) and stretch (resize) by some amount. For now, lets just define these for `Polygon`s

``> instance Deformable Shape where>   turn theta (Polygon ps) = Polygon (map (rotate theta) ps)>   stretch x  (Polygon ps) = Polygon (map (\(a,b) -> (a*x, b*x)) ps)> > instance Deformable Region where>   turn theta (Shape sh) = Shape (turn theta sh)>   stretch x  (Shape sh) = Shape (stretch x  sh)``

where the helper function `rotate` is defined as

``> rotate :: Float -> Coordinate -> Coordinate> rotate theta (x,y) >   = (x*c+y*s, y*c-x*s) >     where (s,c) = (sin theta, cos theta)``

and lift to `Picture`s

``> instance Deformable Picture where>   turn theta (Region c r)   = Region c (turn theta r)>   turn theta (p1 `Over` p2) = turn theta p1 `Over` turn theta p2>   turn theta EmptyPic       = EmptyPic>   stretch x (Region c r)    = Region c (stretch x r)>   stretch x (p1 `Over` p2)  = stretch x p1 `Over` stretch x p2>   stretch x EmptyPic        = EmptyPic``

and `Behavior`s

``> instance Deformable a => Deformable (Behavior a) where>   turn theta (Beh b) = Beh (turn theta . b)>   stretch x  (Beh b) = Beh (stretch x  . b)``

Now, we can pull even neater effects from our DSL

``> anim6 = animateB "Pendulum" \$ f pentaB>   where f = reg flash'' >           . lift2 stretch (1.2 + sin time) >           . lift2 turn (pi * sin time) ``

## Time Travel Via Time Transformation

As one last trick, let us see how we do time travel as it were, by using the following function, that translates a behavior in time.

``> timeTx (Beh tb) (Beh b) = Beh (b. tb)``

Lets look at the type of this function, it takes a `Behavior Time` and any other `Behavior a`, and returns a new `Behavior a` which is the old one translated according to the first signal! That is, at any given instant `t` the time behavior is used to look up a `t'` from which the new behavior draws its value. This can really provide for some interesting effects.

For example, to fast-forward an animation, we write a combinator

``> fastForward = timeTx (2   * time)``

to watch it in slow-motion

``> slowMotion  = timeTx (0.5 * time)``

and to rewind an animation, we might do

``> rewind      = timeTx (-1  * time)``

Check it out!

``> anim7 = animateB "Many Spheres" \$ overMany [b1,b2,b3,b4]>   where b1  = reg flash revBallB >         b2  = rewind b1 >         b3  = fastForward b1 >         b4  = slowMotion b1 ``

Of course, we can apply the time transformation to the individual behaviors, for example

``> anim8 = animateB "Fast Flash" \$ overMany [b1,b2]>   where b1 = reg (fflash 4) \$ tx ((sin time)-1, cos time) ballB>         b2 = reg (fflash 8) \$ tx ((sin time)+1, cos time) ballB``

where `fflash` is `flash` sped up by some factor

``> fflash n = timeTx (n*time) flash''``

And one last example

``> anim9 = animateB "Last!" \$ overMany (map stagger [0..7])>   where stagger = \t -> timeTx (lift0 (t * pi/4) + time) bB>         bB      = reg (fflash 8) revBallB``

Thats all for lecture, see the detailed implementation of a Kaleidoscope animation given in SOE.

# Details

## Dummy Instances for `Eq` and `Show`

We need to make `Behavior a` an instance of `Eq` and `Show` in order that it to satisfy the requirements of `Num`. Of course these operations don’t really make sense so we’ll just make a dummy instantiation.

``> instance Eq (Behavior a) where>   a1 == a2 = error "Can't compare behaviors."> > instance Show (Behavior a)  where>   showsPrec n a1 = error "<< Behavior >>"``

## Conversion Between Graphic Values

``> regionToGraphic :: Region -> Graphic> regionToGraphic = drawRegion . regionToGRegion``
``> picToGraphic :: Picture -> Graphic> picToGraphic (Region c r)>   = withColor c (regionToGraphic r)> picToGraphic (p1 `Over` p2)>   = picToGraphic p1 `overGraphic` picToGraphic p2> picToGraphic EmptyPic >   = emptyGraphic``

## Rendering

``> animate title anim = runGraphics \$ do>   w  <- openWindowEx title (Just (0,0)) (Just (xWin, yWin)) drawBufferedGraphic >   t0 <- timeGetTime>   animateLoop w t0 anim``
``> animateLoop w t0 anim = do >   t <- timeGetTime>   let ft = intToFloat (fromInteger (toInteger (t - t0))) / 1000>   setGraphic w (anim ft)>   spaceCloseEx w \$ animateLoop w t0 anim``
``> spaceCloseEx w loop = do >   k <- maybeGetWindowEvent w>   case k of>     Just (Key c d) | c == ' ' && d -> closeWindow w>     Just Closed                    -> closeWindow w>     Nothing                        -> loop>     _                              -> spaceCloseEx w loop``