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)