Demos
Home Ordering Info Lecture Slides Demos Bugs/Errata Software Solutions to Exercises

        

Here are several graphics and animation examples taken right from the text, with accompanying video showing the result of running the code.

Demo 1 -  A group of rotating balls that change color.  The Haskell code for this is:

> revolvingBalls :: Behavior Picture
> revolvingBalls = overMany [ timeTrans (lift0 (t*pi/4) + time) flashingBall
>                             | t <- [0..7] ]
> flashingBall = let ball = shape (ell 0.2 0.2) 
>                in reg (timeTrans (8*time) flash) 
>                       (translate (sin time, cos time) ball)
> flash = cond (sin time >* 0) red yellow

Demo 2 - A ball rotating around a stationary object that changes shape; kind of like a moon rotating round a (strange) planet:

> planets :: Animation Picture
> planets t = let p1 = Region Red (Shape (rubberBall t))
>                 p2 = Region Yellow (revolvingBall t)
>             in p1 `Over` p2

> rubberBall t = Ellipse (sin t) (cos t)

> revolvingBall t = let ball = Shape (Ellipse 0.2 0.2) 
>                   in Translate (sin t, cos t) ball
 
Demo 3 - A bouncing ball (which demonstrates "reactivity", in this case the ball hitting the floor):

< bouncingBall = paint red (translate (x,y) (ell 0.2 0.2))
<   where g = -4
<         x = -3 + integral 0.5
<         y = 1.5 + integral v
<         v = integral g `switch` (hit `snapshot_` v =>> \v'->
<             lift0 (-v') + integral g)
<         hit = when (y <* -1.5)

Demo 4 - More sophisticated reactivity: a simple game of "paddle ball" in just 17 lines:

> paddleball vel = walls `over` paddle `over` pball vel

> walls = let upper = paint blue (translate ( 0,1.7) (rec 4.4 0.05))
>             left  = paint blue (translate (-2.2,0) (rec 0.05 3.4))
>             right = paint blue (translate ( 2.2,0) (rec 0.05 3.4))
>         in upper `over` left `over` right

> paddle = paint red (translate (fst mouse, -1.7) (rec 0.5 0.05))

> pball vel =
>   let xvel    = vel `stepAccum` xbounce ->> negate
>       xpos    = integral xvel
>       xbounce = when (xpos >* 2 ||* xpos <* -2)
>       yvel    = vel `stepAccum` ybounce ->> negate
>       ypos    = integral yvel
>       ybounce = when (ypos >* 1.5 
>                   ||* ypos `between` (-2.0,-1.5) &&*
>                       fst mouse `between` (xpos-0.25,xpos+0.25))
>   in paint yellow (translate (xpos, ypos) (ell 0.2 0.2))

> x `between` (a,b) = x >* a &&* x <* b

Demo 5 - Shapes move to the top by clicking on them (showing a lower-level, more imperative style of interaction):

> loop :: Window -> [(Color,Region)] -> IO ()
>
> loop w regs = 
>   do clearWindow w
>      sequence_ [ drawRegionInWindow w c r | (c,r) <- reverse regs ]
>      (x,y) <- getLBP w
>      case (adjust regs (pixelToInch (x - xWin2), 
>                         pixelToInch (yWin2 - y) )) of
>        (Nothing, _ )       -> closeWindow w
>        (Just hit, newRegs) -> loop w (hit : newRegs)

> adjust regs p
>   = case (break (\(_,r) -> r `containsR` p) regs) of
>       (top,hit:rest) -> (Just hit, top++rest)
>       (_,[]) -> (Nothing, regs)

Demo 6 - A kaleidoscope:

> kaleido :: Integer -> (Float -> Behavior Coordinate) 
>            -> Behavior Picture
> kaleido n f = lift2 turn (pi*sin slowTime) $
>               overMany (zipWith reg (map lift0 (cycle spectrum))
>                        (map (flip turn poly) rads) )
>   where rads = map (((2*pi / fromInteger n) *) . fromInteger) [0..n-1]
>         poly = polyShapeAnim (map f rads)

> kaleido1 = kaleido 6 star
>   where star x = syncPair ( 2 * cos (v*c+l), 
>                             2 * abs (sin (slowTime*s - l)) )
>                    where v     = lift0 x
>                          l     = v * (slowTime + 1)
>                          (s,c) = (sin l, cos l)