Composing Reactive Animations 
by Conal Elliott

Listing One
leftRightCharlotte = moveXY wiggle 0 charlotte
charlotte = importBitmap "../Media/charlotte.bmp"  

Listing Two
upDownPat = moveXY 0 waggle pat
pat = importBitmap "../Media/pat.bmp"  

Listing Three
charlottePatDance = 
  leftRightCharlotte `over` upDownPat  

Listing Four
hvDance im1 im2 =
    moveXY wiggle 0 im1  `over` 
    moveXY 0 waggle im2

Listing Five
charlottePatDoubleDance = hvDance aSmall aSmall 
  where
    aSmall = stretch 0.5 charlottePatDance  

Listing Six
(a)
dance1 = stretch (abs wiggle) charlottePatDance 

(b)
dance2 = hvDance (stretch wiggle charlotte) 
                  (stretch waggle pat)

(c)
patOrbitsCharlotte =
   stretch wiggle charlotte  `over` 
   moveXY wiggle waggle pat

Listing Seven
velBecky u = moveXY x 0 becky 
  where
    x = -1 + atRate 1 u

Listing Eight
accelBecky u = moveXY x 0 becky 
   where
     x = -1 + atRate v u
     v =  0 + atRate 1 u

Listing Nine
mouseVelBecky u = move offset becky
   where
    offset = atRate vel u
    vel    = mouseMotion u

Listing Ten
beckyChaseMouse u = move offset becky 
   where
    offset = atRate vel u
    vel    = mouseMotion u - offset

Listing Eleven
chaseMouse im u = move offset im
   where
    offset = atRate vel u
    vel    = mouseMotion u - offset 

Listing Twelve
danceChase u =
   chaseMouse (stretch 0.5 charlottePatDance) u 

Listing Thirteen
springDragBecky u = move offset becky
   where
    offset = atRate vel u
    vel    = atRate accel u
    accel  = (mouseMotion u - offset) - 0.5 *^ vel 

Listing Fourteen
orbitAndLater = orbit `over` later 1 orbit  
  where
    orbit = moveXY wiggle waggle jake

Listing Fifteen
orbitAndFaster = orbit `over` faster 2 orbit  
   where
    orbit = move wiggle waggle jake

Listing Sixteen
followMouseAndDelay u =
  follow `over` later 1 follow
   where
    follow = move (mouseMotion u) jake 

Listing Seventeen
kids u =
   delayAnims 0.5
     (map (move (mouseMotion u))
          [jake, becky, charlotte, pat]) 

Listing Eighteen
trailWords motion str =
  delayAnims 1 (map moveWord (words str))
  where
     moveWord word = move motion (
                      stretch 2 (
                        withColor blue (stringIm word) )) 

Listing Nineteen
flows u = trailWords motion 
             "Time flows like a river"
   where
     motion = 0.7 *^ vector2XY (cos time)
                               (sin (2 * time)) 

Listing Twenty
flows2 u = trailWords (mouseMotion u)
              "Time flows like a river" 

Listing Twenty-One
redBlue u = buttonMonitor u `over`
             withColor c circle
   where
    c = red `untilB` lbp u -=> blue 

Listing Twenty-Two
redBlueCycle u = buttonMonitor u `over`
                  withColor (cycle red blue u)
                            circle
   where
    cycle c1 c2 u =
     c1 `untilB` nextUser_ lbp u ==> cycle c2 c1 

Listing Twenty-Three
tricycle u =
    buttonMonitor u `over`
    withColor (cycle3 green yellow red u) ( 
      stretch (wiggleRange 0.5 1)
        circle )
   where
    cycle3 c1 c2 c3 u =
     c1 `untilB` nextUser_ lbp u ==> 
     cycle3 c2 c3 c1

Listing Twenty-Four
jumpFlower u = buttonMonitor u `over`
                moveXY (bSign u) 0 flower
flower = stretch 0.4
            (importBitmap "../Media/rose medium.bmp") 
bSign u = selectLeftRight 0 (-1) 1 u

Listing Twenty-Five
growFlower u = buttonMonitor u `over`
                stretch (grow u) flower  
grow u = size
  where 
   size = 1 + atRate rate u 
   rate = bSign u

Listing Twenty-Six
growFlowerExp u = buttonMonitor u `over`
                   stretch (grow' u) flower 
grow' u = size
  where 
   size = 1 + atRate rate u 
   rate = bSign u * size 

Listing Twenty-Seven
buttonMonitor u =
   moveXY 0 (- height / 2 + 0.25) (
    withColor textColor (
     stretch 2 (
     stringBIm (selectLeftRight "(press a button)" "left" "right" u)))) 
  where
    (width,height) = vector2XYCoords (viewSize u)
 
Listing Twenty-Eight
selectLeftRight none left right u = 
   condB (leftButton u) (constantB left) ( 
     condB (rightButton u) (constantB right) ( 
       constantB none ))

Listing Twenty-Nine
teapot =
   stretch3 2 (importX "../Media/tpot2.x") 

Listing Thirty
redSpinningPot =
  turn3 zVector3 time (
    withColorG red teapot) 

Listing Thirty-One
mouseTurn g u =
   turn3 xVector3 y (
    turn3 zVector3 (-x) g)
  where
    (x,y) = vector2XYCoords (pi *^ mouseMotion u)
 mouseSpinningPot u =
   mouseTurn (withColorG green teapot) u 

Listing Thirty-Two
spinPot potColor potAngle =
  turn3 zVector3 potAngle (
    withColorG potColor teapot) 

Listing Thirty-Three
spin1 u = buttonMonitor u `over`
           renderGeometry (spinPot red (grow u)) 
                          defaultCamera 

Listing Thirty-Four
withSpinner f u =
   buttonMonitor u `over`
   renderGeometry (f (grow u) u)
                  defaultCamera 
 
Listing Thirty-Five
spin1 = withSpinner spinner1
  where
    spinner1 angle u = spinPot red angle 

Listing Thirty-Six
spin2 = withSpinner spinner2
  where
    spinner2 potAngleSpeed u =
      spinPot (colorHSL time 0.5 0.5)
              (atRate potAngleSpeed u)

Listing Thirty-Seven
 sphereLowRes = importX "../Media/sphere0.x"
 movingLight =
    move3 motion (
     stretch3 0.1 (
      withColorG white (
       sphereLowRes `unionG` pointLightG)))
  where
   motion = vector3Spherical 1.5
              (pi*time) (2*pi*time)
 potAndLight =
   withColorG green teapot `unionG` movingLight 

Listing Thirty-Eight
delayAnims3 dt anims =
   unionGs (zipWith later [0, dt ..] anims) 

Listing Thirty-Nine
potAndLights =
   slower 5 (
    withColorG green teapot `unionG`
    delayAnims3 (2/5) (replicate 5 movingLight) )

Listing Forty
spiral3D = delayAnims3 0.075 balls
  where
    ball   = move3 motion (stretch3 0.1 sphereLowRes)
    balls  = [ withColorG (bColor i) ball
             | i <- [1 .. n] ]
    motion = vector3Spherical 1.5 (10*time) time
    n      = 20
    bColor i =
      colorHSL (2*pi * fromInt i / fromInt n) 0.5 0.5 

Listing Forty-One
spiralTurn = turn3 zVector3 (pi*time) (unionGs (map ball [1 .. n]))
  where
    n = 40
    ball i  = withColorG color (
               move3 motion (
                stretch3 0.1 sphereLowRes ))
     where
       motion = vector3Spherical 1.5 (10*phi) phi
       phi    = pi * fromInt i / fromInt n
       color  = colorHSL (2*phi) 0.5 0.5

6


