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)