Ch15

Chapter 15: 

Chapter 15 A Module of Reactive Animations

Motivation: 

Motivation The design of animations in Chapter 13 is elegant, and in fact has the feel of a small domain-specific language (DSL), embedded in Haskell. However, the language lacks reactivity: the ability to interact with the user or other external stimuli. In this chapter we add reactivity, and call the resulting DSL functional animation language, or FAL. In addition, an implementation of FAL is described, using streams.

FAL by Example: 

FAL by Example As before, we use the polymorphic data type 'Behavior' to capture time-varying values. For example: color1 :: Behavior Color color1 = red `untilB` (lbp -andgt;andgt; blue) ball1 :: Behavior Picture ball1 = paint color1 circ circ :: Behavior Region circ = translate (cos time, sin time) (ell 0.2 0.2) The function 'untilB' reflects reactive behavior, and 'lbp' corresponds to a left button press.

More Reactivity: 

More Reactivity Recursive reactivity: color1r = red `untilB` lbp -andgt;andgt; blue `untilB` lbp -andgt;andgt; color1r Choice reactivity: color2 = red `untilB` ((lbp -andgt;andgt; blue) .|. (key -andgt;andgt; yellow)) Recursive, choice reactivity: color2r = red `untilB` colorEvent where colorEvent = (lbp -andgt;andgt; blue `untilB` colorEvent) .|. (key -andgt;andgt; yellow `untilB` colorEvent) Pushing recursion into combinator: color2h = red `switch` ((lbp -andgt;andgt; blue) .|. (key -andgt;andgt; yellow))

Events With Data: 

Events With Data Convert button-press events into color events: color1h = red `switch` (lbp `withElem_` cycle [blue, red]) Dispatch on key press: color3 = white `switch` (key =andgt;andgt; \c -andgt; case c of 'R' -andgt; red 'B' -andgt; blue 'Y' -andgt; yellow _ -andgt; white ) Carrying state forward: color4 = white `switch` ((key `snapshot` color4) =andgt;andgt; \(c, old) -andgt; case c of 'R' -andgt; red 'B' -andgt; blue 'Y' -andgt; yellow _ -andgt; lift0 old)

Dynamic Events: 

Dynamic Events Not all events are external. For example: while (time andgt;* 42) generates no events until time exceeds 42, and then generates events 'infinitely often'. when (time andgt;* 42) generates exactly one event when the time exceeds 42. color5 = red `untilB` (when (time andgt;* 5) -andgt;andgt; blue)

Integration: 

Integration The position of a mass under the influence of an accelerating force f: s, v :: Behavior Float s = s0 + integral v v = v0 + integral f Combining with reactivity, a bouncing ball: ball2 = 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 =andgt;andgt; \v'-andgt; lift0 (-v') + integral g) hit = when (y andlt;* -1.5) Note similarity to mathematical equations.

Implementing FAL: 

Implementing FAL Previously a behavior was conceptually a function: Behavior a ≡ Time -andgt; a But somehow we must now introduce events. One obvious approach would be: Behavior a ≡ [(UserAction, Time)] -andgt; Time -andgt; a But this would be very inefficient (why?). Better to do this: Behavior a ≡ [(UserAction, Time)] -andgt; [Time] -andgt; [a] Or, even more efficient, and now as Haskell code: newtype Behavior a = Behavior ( ([Maybe UserAction], [Time]) -andgt; [a] ) (see text for definition of UserAction)

Time and Constants: 

Time and Constants Recall: newtype Behavior a = Behavior ( ([Maybe UserAction], [Time]) -andgt; [a] ) With this representation, let’s define time: time :: Behavior Time time = Behavior (\(_,ts) -andgt; ts) Constant behaviors are achieved via lifting: constB :: a -andgt; Behavior a constB x = Behavior (\_ -andgt; repeat x) For example: red, blue :: Behavior Color red = constB Red blue = constB Blue

Curried Liftings: 

Curried Liftings From this 'lifted' version of application: ($*) :: Beh (a-andgt;b) -andgt; Beh a -andgt; Beh b Beh ff $* Beh fb = Beh (\uts -andgt; zipWith ($) (ff uts) (fb uts)) and the constant lifting operator: lift0 :: a -andgt; Beh a lift0 = constB all other lifting operators can be defined: lift1 :: (a -andgt; b) -andgt; (Beh a -andgt; Beh b) lift1 f b1 = lift0 f $* b1 lift2 :: (a -andgt; b -andgt; c) -andgt; (Beh a -andgt; Beh b -andgt; Beh c) lift2 f b1 b2 = lift1 f b1 $* b2 lift3 :: (a -andgt; b -andgt; c -andgt; d) -andgt; (Beh a -andgt; Beh b -andgt; Beh c -andgt; Beh d) lift3 f b1 b2 b3 = lift2 f b1 b2 $* b3 (For conciseness, 'Beh' is used instead of 'Behavior'.)

Sample Liftings: 

Sample Liftings pairB :: Behavior a -andgt; Behavior b -andgt; Behavior (a,b) pairB = lift2 (,) fstB :: Behavior (a,b) -andgt; Behavior a fstB = lift1 fst paint :: Behavior Color -andgt; Behavior Region -andgt; Behavior Picture paint = lift2 Region red, blue, yellow, green, white, black :: Behavior Color red = lift0 Red blue = lift0 Blue . . . shape :: Behavior Shape -andgt; Behavior Region shape = lift1 Shape ell, rec :: Behavior Float -andgt; Behavior Float -andgt; Behavior Region ell x y = shape (lift2 Ellipse x y) rec x y = shape (lift2 Rectangle x y) See text for more liftings.

Events and Reactivity: 

Events and Reactivity Abstractly, we can think of events as: type Event a = Behavior (Maybe a) But for type safety, this is better: newtype Event a = Event ( ([Maybe UserAction], [Time]) -andgt; [Maybe a] ) Core of FAL’s reactivity: untilB :: Behavior a -andgt; Event (Behavior a) -andgt; Behavior a switch :: Behavior a -andgt; Event (Behavior a) -andgt; Behavior a (-andgt;andgt;) :: Event a -andgt; b -andgt; Event b (=andgt;andgt;) :: Event a -andgt; (a-andgt;b) -andgt; Event b plus primitive events such as: lbp :: Event ( )

Primitive Events: 

Primitive Events 'lbp' must look for a 'left button press' in the stream of UserActions: lbp :: Event ( ) lbp = Event (\(uas,_) -andgt; map getlbp uas) where getlbp (Just (Button _ True True)) = Just ( ) getlbp _ = Nothing Similarly for 'key': key :: Event Char key = Event (\(uas,_) -andgt; map getkey uas) where getkey (Just (Key ch True)) = Just ch getkey _ = Nothing

Implementing UntilB: 

Implementing UntilB untilB switches into a new behavior carried by the event. untilB :: Behavior a -andgt; Event (Behavior a) -andgt; Behavior a Behavior fb `untilB` Event fe = memoB $ Behavior (\uts@(us,ts) -andgt; loop us ts (fe uts) (fb uts)) where loop (_:us) (_:ts) ~(e:es) (b:bs) = b : case e of Nothing -andgt; loop us ts es bs Just (Behavior fb') -andgt; fb' (us,ts) memoB :: Behavior a -andgt; Behavior a memoB (Behavior fb) = Behavior (memo1 fb) Stare at this code until you understand it completely! The definition of 'switch' is very similar (see text).

Event Map: 

Event Map Recall: color1 :: Behavior Color color1 = red `untilB` (lbp -andgt;andgt; blue) What does '-andgt;andgt;' do? Consider types: red, blue :: Behavior Color untilB :: Behavior Color -andgt; Event (Behavior Color) -andgt; Behavior Color lbp :: Event ( ) (-andgt;andgt;) :: Event ( ) -andgt; Behavior Color -andgt; Event (Behavior Color) So (-andgt;andgt;) somehow 'tags' an event with a Behavior. Polymorphically speaking: (-andgt;andgt;) :: Event a -andgt; b -andgt; Event b It is actually a special case of the more general: (=andgt;andgt;) :: Event a -andgt; (a-andgt;b) -andgt; Event b

Implementing Event Map: 

Implementing Event Map (=andgt;andgt;) is defined as: Event fe =andgt;andgt; f = Event (\uts -andgt; map aux (fe uts)) where aux (Just a) = Just (f a) aux Nothing = Nothing Which can be defined more succinctly using fmap from the Functor class (discussed in Chapter 18!): Event fe =andgt;andgt; f = Event (map (fmap f) . fe) (-andgt;andgt;) is then defined in terms of (=andgt;andgt;): e -andgt;andgt; v = e =andgt;andgt; \_ -andgt; v

ImplementingPredicate Events: 

Implementing Predicate Events 'while' is defined as: while :: Behavior Bool -andgt; Event () while (Behavior fb) = Event (\uts -andgt; map aux (fb uts)) where aux True = Just () aux False = Nothing 'when' is defined similarly (see text).

Implementing Integration: 

Implementing Integration 'integral' is defined by: integral :: Behavior Float -andgt; Behavior Float integral (Behavior fb) = Behavior (\uts@(us,t:ts) -andgt; 0 : loop t 0 ts (fb uts)) where loop t0 acc (t1:ts) (a:as) = let acc' = acc + (t1-t0)*a in acc' : loop t1 acc' ts as This corresponds to the standard definition of integration as a limit in calculus (see text).

“Steppers”: 

'Steppers' 'Steppers' are convenient variations of switch: step :: a -andgt; Event a -andgt; Behavior a a `step` e = constB a `switch` e =andgt;andgt; constB stepAccum :: a -andgt; Event (a-andgt;a) -andgt; Behavior a a `stepAccum` e = b where b = a `step` (e `snapshot` b =andgt;andgt; uncurry ($)) For example, a counter: counter = 0 `stepAccum` lbp -andgt;andgt; (+1) an example involving `step` is on the next slide.

Mouse Movement: 

Mouse Movement It’s convenient to treat mouse position as a pair of Behaviors: mouse :: (Behavior Float, Behavior Float) mouse = (fstB m, sndB m) where m = (0,0) `step` mm where 'mm' is defined as: mm :: Event Coordinate mm = Event (\(uas,_) -andgt; map getmm uas) where getmm (Just (MouseMove pt)) = Just (gPtToPt pt) getmm _ = Nothing

Final Example: Paddleball!: 

Final Example: Paddleball! A paddleball game consists of three parts: paddleball vel = walls `over` paddle `over` pball vel Where 'walls' and 'paddle' are defined by: 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)) The core of the game is in 'pball'.

Putting it All Together: 

Putting it All Together pball vel = let xvel = vel `stepAccum` xbounce -andgt;andgt; negate xpos = integral xvel xbounce = when (xpos andgt;* 2 ||* xpos andlt;* -2) yvel = vel `stepAccum` ybounce -andgt;andgt; negate ypos = integral yvel ybounce = when (ypos andgt;* 1.5 ||* ypos `between` (-2.0,-1.5) andamp;andamp;* 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 andgt;* a andamp;andamp;* x andlt;* b