> $zL(@
0ReactAnim\Reactimate.lhs\..\..\..\AFunProgYale\ReactAnim\Reactimate.lhs/0( 0;[0
0000$([\{b00000000000 0=] 00
0000 2 3 !A0C0E0G0I0c00000000000000000!%),.:;?]}acdeghijklmnop0DTimes New Roman<$0<:A 04DArialNew Roman<$0<:A 04" DGenevaew Roman<$0<:A 040DCourier Newman<$0<:A 041C.@ @@``
@n?" dd@ @@``p$443
78
(
.(
2346#lAA1?f@fg4KdKdT:A 0:ppp@<4BdBd$ 0|Cʚ;ʚ;<4!d!dT# 0l<4ddddT# 0lr0___PPT10
2___PPT9/0?%Lecture #15, Nov. 15, 2004Todays Topics
Simple Animations - Review
Reactive animations
Vocabulary
Examples
Implementation
behaviors
events
Reading
Read Chapter 15 - A Module of Reactive Animations
Read Chapter 17 Rendering Reactive Animations
Homework
Assignment #7 on back of this handout
Due Monday Nov 29, 2004 After Thanksgiving BreakUd YUd Y<fReview: BehaviorhA Behavior a can be thought of abstractly as a function from Time to a.
In the chapter on functional animation, we animated Shape s, Region s, and Picture s.
For example:
dot = (ell 0.2 0.2)
ex1 = paint red (translate (0, time / 2) dot)
Try It
ex2 = paint blue (translate (sin time,cos time) dot)
35C7*$
B
0gAbstraction
The power of animations is the ease with which they can be abstracted over, to flexibly create new animations from old.
wander x y color = paint color (translate (x,y) dot)
ex3 = wander (time /2) (sin time) red
*y^y^oExample: The bouncing ballSuppose we wanted to animate a ball bouncing horizontally from wall to wall
The Y position is constant, but the x position varies like:epq
Implementation
bounce t = f fraction
where (period,fraction) = modula t 2
f = funs !! (period `mod` 4)
funs = [id,(2.0 -),negate,(\x -> x - 2.0)]
ex4 = wander (lift1 bounce time) 0 yellow
Remember this example. Reactive animations will make this much easier to do.,MM5hReactive AnimationsWith a reactive animation, things do more than just change and move with time according to some algorithm.
Reactive programs react to user stimuli, and real-time events, even virtual events, such as:
key press
button press
hardware interrupts
virtual event - program variable takes on some particular value
We will try and illustrate this first by example, and then only later explain how it is implemented
Example:
color0 = red `switch` (lbp ->> blue)
moon = (translate (sin time,cos time) dot)
ex5 = paint color0 moonzPkPmPPhPkmg,"$iA Reactive VocabularyColors
Red,Blue,Yellow,Green,White :: Color
red, blue, yellow, green, white :: Behavior Color
Shapes and Regions
Shape :: Shape -> Region
shape :: Behavior Shape -> Behavior Region
Ellipse,Rectangle :: Float -> Float -> Region
ell, rec :: Behavior Float -> Behavior Float -> Behavior Region
Translate :: (Float,Float) -> Region -> Region
translate :: (Behavior Float, Behavior Float) -> Behavior Region -> Behavior RegionZWBWAjOperator and Event VocabularyNumeric and Boolean Operators
(+), (*) :: Num a => Behavior a -> Behavior a -> Behavior a
negate :: Num a => Behavior a -> Behavior a
(>*),(<*),(>=*),(<=*) :: Ord a => Behavior a -> Behavior a -> Behavior Bool
(&&*),(||*) :: Behavior Bool -> Behavior Bool -> Behavior Bool
Events
lbp :: Event () -- left button press
rbp :: Event () -- right button press
key :: Event Char -- key press
mm :: Event Vertex -- mouse motion`+
*xkCombinator Vocabulary
Event Combinators
(->>) :: Event a -> b -> Event b
(=>>) :: Event a -> (a->b) -> Event b
(.|.) :: Event a -> Event a -> Event a
withElem :: Event a -> [b] -> Event (a,b)
withElem_ :: Event a -> [b] -> Event b
Behavior and Event Combinators
switch :: Behavior a -> Event(Behavior a) -> Behavior a
snapshot_ :: Event a -> Behavior b -> Event b
step :: a -> Event a -> Behavior a
stepAccum :: a -> Event(a -> a) -> Behavior a~Gy Gy bp#3 %lAnalyse Ex3.red,blue :: Behavior Color
lbp :: Event ()
(->>) :: Event a -> b -> Event b
switch :: Behavior a -> Event(Behavior a) -> Behavior a
Bnm Either (.|.) and withElem
color1 = red `switch`
(lbp `withElem_` cycle [blue,red])
ex6 = paint color1 moon
color2 = red `switch`
((lbp ->> blue) .|. (key ->> yellow))
ex7 = paint color2 moon
>'X<n
Key and Snapshot`color3 = white `switch` (key =>> \c ->
case c of r' -> red
b' -> blue
y' -> yellow
_ -> white )
ex8 = paint color3 moon
color4 = white `switch` ((key `snapshot` color4) =>> \(c,old) ->
case c of r' -> red
b' -> blue
y' -> yellow
_ -> constB old)
ex9 = paint color4 moon"u"Step :: a -> Event a -> Behavior a#"Fsize '2' = 0.2 -- size :: Char -> Float
size '3' = 0.4
size '4' = 0.6
size '5' = 0.8
size '6' = 1.0
size '7' = 1.2
size '8' = 1.4
size '9' = 1.6
size _ = 0.1
growCircle :: Char -> Region
growCircle x = Shape(Ellipse (size x) (size x))
ex10 = paint red (Shape(Ellipse 1 1)
`step` (key =>> growCircle))GG>
s
v-stepAccum :: a -> Event(a -> a) -> Behavior a^. %@
stepAccum takes a value and an event of a function. Everytime the event occurs, the function is applied to the old value to get a new value.
power2 :: Event(Float -> Float)
power2 = (lbp ->> \ x -> x*2) .|.
(rbp ->> \ x -> x * 0.5)
dynSize = 1.0 `stepAccum` power2
ex11 = paint red (ell dynSize dynSize)( + {$ rIntegralThe combinator:
integral :: Behavior Float -> Behavior Float
has a lot of interesting uses.
If F :: Behavior Float (think function from time to Float) then integral F z is the area under the curve gotten by plotting F from 0 to z1-*,<
sBouncing Ball revisited1The bouncing ball has a constant velocity (either to the right, or to the left).
Its position can be thought of as the integral of its velocity.
At time t, the area under the curve is t, so the x position is t as well. If the ball had constant velocity 2, then the area under the curve is 2 * t, etc.tBouncing Ball again
ex12 = wander x 0 yellow
where xvel = 1 `stepAccum` (hit ->> negate)
x = integral xvel
left = x <=* -2.0 &&* xvel <*0
right = x >=* 2.0 &&* xvel >*0
hit = predicate (left ||* right)
0b( -$)6wMouse MotionThe variable mm :: Event Vertex
At every point in time it is an event that returns the mouse position.
mouseDot =
mm =>> \ (x,y) ->
translate (constB x,constB y)
dot
ex13 = paint red (dot `switch` mouseDot)(iiPi1JxHow does this work?@Events are real-time actions that happen in the world. How do we mix Events and behaviors in some rational way.
The Graphics Library supports a basic type that models these actions.
type Time = Float
data G.Event
= Key { char :: Char, isDown :: Bool }
| Button { pt :: Vertex, isLeft, isDown :: Bool }
| MouseMove { pt :: Vertex }
| Resize
| Closed
deriving Show
type UserAction = G.Event! =
yType of BehaviorIn simple animations, a Behavior was a function from time. But if we mix in events, then it must be a function from time and a list of events.
First try:
newtype Behavior1 a =
Behavior1 ([(UserAction,Time)] -> Time -> a)
User Actions are time stamped. Thus the value of a behavior (Behavior1 f) at time t is, f uas t, where uas is the list of user actions.
Expensive because f has to whittle down uas at every sampling point (time t), to find the events it is interested in.HF=
.*bm
HKzSolutionRSample at monotonically increasing times, and keep the events in time order.
Analogy: suppose we have two lists xs and ys and we want to test for each element in ys whether it is a member of xs
inList :: [Int] -> Int -> Bool
result :: [Bool] -- Same length as ys
result1 :: map (inList xs) ys
What s the cost of this operation?
This is analagous to sampling a behavior at many times.6]]q)9/ '{If xs and ys are ordered ...,
result2 :: [Bool]
result2 = manyInList xs ys
manyInList :: [Int] -> [Int] -> [Bool]
manyInList [] _ = []
manyInList _ [] = []
manyInList (x:xs) (y:ys) =
if y
[Time] ->
[a])
See how this has structure similar to the manyInList problem?
manyInList :: [Int] -> [Int] -> [Bool]Jp?'o?'e
}Refinements/newtype Behavior2 a =
Behavior2 ([(UserAction,Time)] -> [Time] -> [a])
newtype Behavior3 a =
Behavior3 ([UserAction] -> [Time] -> [a])
newtype Behavior4 a =
Behavior4 ([Maybe UserAction] -> [Time] -> [a])
Final Solution
newtype Behavior a
= Behavior (([Maybe UserAction],[Time]) -> [a])
DH H
$
%#~Events"
newtype Event a =
Event (([Maybe UserAction],[Time]) -> [Maybe a])
Note there is an isomorphism between the two types
Event a and Behavior (Maybe a)
We can think of an event, that at any particular time t, either occurs, or it doesn t.
Exercise: Write the two functions that make up the isomorphism:
toEvent :: Event a -> Behavior (Maybe a)
toBeh :: Behavior(Maybe a) -> Event azG5/OG5OP
"! IntuitionIntuitively it s useful to think of a Behavior m as transforming two streams, one of user actions, the other of the corresponding time (the two streams always proceed in lock-step) , into a stream of m things.
User actions include things like
left and right button presses
key presses
mouse movement
User Actions also include the clock tick that is used to time the animation.
p9O(
+9OThe Implementationxtime :: Behavior Time
time = Behavior (\(_,ts) -> ts)
constB :: a -> Behavior a
constB x = Behavior (\_ -> repeat x)yyP+-Simple Behaviorso
red, blue :: Behavior Color
red = constB Red
blue = constB Blue
lift0 :: a -> Behavior a
lift0 = constB
(oo>&(,NotationWe often have two versions of a function:
xxx :: Behavior a -> (a -> b) -> T b
xxx_ :: Behavior a -> b -> T b
And two versions of some operators:
(=>>) :: Event a -> (a->b) -> Event b
(->>) :: Event a -> b -> Event b`+F&H+F&GLifting ordinary functions_($*) :: Behavior (a->b) -> Behavior a -> Behavior b
Behavior ff $* Behavior fb
= Behavior (\uts -> zipWith ($) (ff uts) (fb uts)
where f $ x = f x
lift1 :: (a -> b) -> (Behavior a -> Behavior b)
lift1 f b1 = lift0 f $* b1
lift2 :: (a -> b -> c) ->
(Behavior a -> Behavior b -> Behavior c)
lift2 f b1 b2 = lift1 f b1 $* b2``tL Button Presses8data G.Event
= Key { char :: Char, isDown :: Bool }
| Button { pt :: Vertex, isLeft, isDown :: Bool }
| MouseMove { pt :: Vertex }
lbp :: Event ()
lbp = Event (\(uas,_) -> map getlbp uas)
where getlbp (Just (Button _ True True)) = Just ()
getlbp _ = NothingF,!
0' Key Strokeskey :: Event Char
key = Event (\(uas,_) -> map getkey uas)
where getkey (Just (Key ch True)) = Just ch
getkey _ = Nothing !
#!Mouse Movementmm :: Event Vertex
mm = Event (\(uas,_) -> map getmm uas)
where getmm (Just (MouseMove pt))
= Just (gPtToPt pt)
getmm _ = Nothing
mouse :: (Behavior Float, Behavior Float)
mouse = (fstB m, sndB m)
where m = (0,0) `step` mm
!
#F,"Behavior and Event Combinators]switch :: Behavior a -> Event (Behavior a) -> Behavior a
Behavior fb `switch` Event fe =
memoB
(Behavior
(\uts@(us,ts) -> loop us ts (fe uts) (fb uts)))
where loop (_:us) (_:ts) ~(e:es) (b:bs) =
b : case e of
Nothing -> loop us ts es bs
Just (Behavior fb')
-> loop us ts es (fb' (us,ts))
L^9 pB
8#Event Transformer (map?)
(=>>) :: Event a -> (a->b) -> Event b
Event fe =>> f = Event (\uts -> map aux (fe uts))
where aux (Just a) = Just (f a)
aux Nothing = Nothing
(->>) :: Event a -> b -> Event b
e ->> v = e =>> \_ -> v
P.
$withElem`withElem :: Event a -> [b] -> Event (a,b)
withElem (Event fe) bs
= Event (\uts -> loop (fe uts) bs)
where loop (Just a : evs) (b:bs)
= Just (a,b) : loop evs bs
loop (Nothing : evs) bs
= Nothing : loop evs bs
withElem_ :: Event a -> [b] -> Event b
withElem_ e bs = e `withElem` bs =>> snd
aa%
&&%Either one event or another
(.|.) :: Event a -> Event a -> Event a
Event fe1 .|. Event fe2
= Event (\uts -> zipWith aux (fe1 uts) (fe2 uts))
where aux Nothing Nothing = Nothing
aux (Just x) _ = Just x
aux _ (Just x) = Just xPN
&Snapshot'snapshot :: Event a -> Behavior b -> Event (a,b)
Event fe `snapshot` Behavior fb
= Event (\uts -> zipWith aux (fe uts) (fb uts))
where aux (Just x) y = Just (x,y)
aux Nothing _ = Nothing
snapshot_ :: Event a -> Behavior b -> Event b
snapshot_ e b = e `snapshot` b =>> snd
((8
'step and stepAccum step :: a -> Event a -> Behavior a
a `step` e = constB a `switch` e =>> constB
stepAccum :: a -> Event (a->a) -> Behavior a
a `stepAccum` e = b
where b = a `step`
(e `snapshot` b =>> uncurry ($))
b0 ' D( predicatepredicate :: Behavior Bool -> Event ()
predicate (Behavior fb)
= Event (\uts -> map aux (fb uts))
where aux True = Just ()
aux False = Nothingb"
?)integralintegral :: Behavior Float -> Behavior Float
integral (Behavior fb)
= Behavior (\uts@(us,t:ts) ->
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 ast@"*Putting it all together@reactimate :: String -> Behavior a -> (a -> IO Graphic) -> IO ()
reactimate title franProg toGraphic
= runGraphics $
do w <- openWindowEx title (Just (0,0))
(Just (xWin,yWin))
drawBufferedGraphic (Just 30)
(us,ts,addEvents) <- windowUser w
addEvents
let drawPic (Just p) =
do g <- toGraphic p
setGraphic w g
addEvents
getWindowTick w
drawPic Nothing = return ()
let Event fe = sample `snapshot_` franProg
mapM_ drawPic (fe (us,ts))$AA
7
*
"
'+The Channel Abstraction
(us,ts,addEvents) <- windowUser w
us, and ts are infinite streams made with channels.
A Channel is a special kind of abstraction, in the multiprocessing paradigm.
If you pull on the tail of a channel, and it is null, then you wait until something becomes available.
addEvents :: IO () is a action which adds the latest user actions, thus extending the streams us and ts"T" L b
\.Making a Stream from a Channel
makeStream :: IO ([a], a -> IO ())
makeStream = do
ch <- newChan
contents <- getChanContents ch
return (contents, writeChan ch)
/A Reactive window8windowUser :: Window -> IO ([Maybe UserAction], [Time], IO ())
windowUser w
= do (evs, addEv) <- makeStream
t0 <- timeGetTime
let addEvents =
let loop rt = do
mev <- maybeGetWindowEvent w
case mev of
Nothing -> return ()
Just e -> addEv(rt, Just e) >> loop rt
in do t <- timeGetTime
let rt = w32ToTime (t-t0)
loop rt
addEv (rt, Nothing)
return (map snd evs, map fst evs, addEvents)$9?
N, 0,The Paddle Ball Gamepaddleball vel = walls `over` paddle `over` ball 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))
x `between` (a,b) = x >* a &&* x <* b#GQQ_31&The reactive ball-ball vel =
let xvel = vel `stepAccum` xbounce ->> negate
xpos = integral xvel
xbounce = predicate (xpos >* 2 &&* xvel >* 0
||* xpos <* -2 &&* xvel <* 0)
yvel = vel `stepAccum` ybounce ->> negate
ypos = integral yvel
ybounce = predicate (ypos >* 1.5 &&* yvel >* 0
||* ypos `between` (-2.0,-1.5) &&*
fst mouse `between` (xpos-0.25,xpos+0.25) &&*
yvel <* 0)
in paint yellow (translate (xpos, ypos) (ell 0.2 0.2))
main = test (paddleball 1).. 3>$-P] ` ̙33` ` ff3333f` 333MMM` f` f` 3>?" dZ@$|? " dZ@ @" ` n?" dZ(
PR @ ` `p>>
-( I
`H;xaxa1 ?;
?Slide Title
)
Z:xaxa1 ?X;
;Body Text
Second Level
Third Level
Fourth Level
Fifth Level
<
Z;xaxa1?G
kCse536 Functional Programming
Z;xaxa1?
\*
Z\;xaxa1?G
`*;B
s*h ? a( Default Design
0SK( J
Zjv$zv$z1?
oL
~Page *Z
p
01 ?T=j)
Zj771 ?\FLj
;Body Text
Second Level
Third Level
Fourth Level
Fifth Level
<B
s*.F2m ? a(80___PPT10.SE*pP(
ZHjv$zv$z1?
oL
Page *Z
B
s*.F2m ? a(80___PPT10.SpE
-K0TL0(
#ll>xaxa1 ?
>
#l>xaxa1 ?X0@>
0$\|H
0h ? a(y___PPT10Y+D=' =
@B +`
(
l
C>
>
l
C>X>
T0>GH_1? @
`X
coord
T>GHv1?p@
_Y
coordH
0h ?/ a(y___PPT10Y+D=' =
@B +
( AD+
=
l
C<C
C
l
CCXC
H
0h ? a(
IA( `
l
CC
C
l
C0>X>
d
<1? d
<1?pd2
<1?p0 `jB
BD1?` jB
@
BD1?PdB
<D1?p@pdB
<D1?0 0 ` dB
<D1?` dB
<D1?`
<C1?
70 2
HC1? f
6+N
H\C1? &!
6-NdB
<D1?@@dB
<D1?@@@dB
<D1?@PPdB
<D1?@dB
<D1?@dB
<D1?@dB
<D1?@P
P
dB
<D1?@dB
<D1?@
BCDEF$o?P0`@P
@PH
0h ? a(T
@
( -
dB
<D1?dB
<D1?dB
<D1?
H<&C1?
:Y axis
H)C1?V<
:X axis
H,C1?`F
:X axisjB
BDo?
H1C1? R Z
8timedB
<Do?pdB
<Do?pdB
<Do?pdB
<Do?pdB
<Do?p
H5C1? ]
@Time `mod` N
<:C1?pD
bPeriod 0 1 2 3 4cc
<=C1?
U
nmodula x y = (period,w)
where (whole,fract) = properFraction x
n = whole `mod` y
period = (whole `div` y)
w = (fromInt (toInt n)) + fract
2 2lQH
0h ? a(PQ(
dB
<D1?`0`
HxIC1?j
:X axisdB
<Do?```dB
<Do?`` `dB
<Do?` ``dB
<Do?```
HNC1?6F
@Time `mod` N
dB
<D1?:
HRC1?&
:X axisdB
<Do?
jjdB
<Do?
`` dB
<Do?j :`dB
<Do?:``
HWC1?@e
91 id
HZC1?6
<2 (N-)
HT_C1?@ `
<3 negate
HtcC1?@
<4 (-N) jB
BD1?jB
BD1?PPjB
BD1?
jB
BD1?
P
H
0h ? a(
(
l
CiC
C
l
CjCXC
H
0h ? a(
( 5,
l
CC
C
l
CEvent ()
TCGHM|1?` @`
DBehavior Colorjr
B1?
<,C1?pPpw
%color0 = red `switch` (lbp ->> blue)
0% 2%
HLC1?fE
JEvent (Behavior Color)jr
BZ1?
H|C1?
Z
BBehavior ColorH
0h ?/ a(y___PPT10Y+D=' =
@B +a
(
l
C>
>
l
C>X>
H
0h ? a(y___PPT10Y+D=' =
@B +a
p(
l
CC
C
l
CCXC
H
0h ? a(y___PPT10Y+D=' =
@B +a
@( 0
l
CV
V
l
CVXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
P( 0
l
CPV
V
l
C$VXV
H
0h ? a(y___PPT10Y+D=' =
@B +D
kc`(
l
C&V
V
l
C'VXV
dB
<D1?@`@dB
<D1?
BCDEFD1?++tHHP(p((8(h8P`` H 0
0X(
@
H
h
@x @ X@
HC1?
7F x
H.V1?z
= time axis
dB
<D1?@
Hl2V1?
j
5z
H6V1?P@Y$
@Integral F z
H
0h ? a(y___PPT10Y+D=' =
@B +
p(
l
C=V
V
l
Cp>VXV
dB
<D1?p0dB
<D1?0pp jB
BD1?p`dB
<D1?dB
<D1?dB
<D1?ppdB
<D1?``
HDEV1?&
OIf velocity is a constant 1dB
<D1?PPdB
<D1?@@dB
<D1?0 0 dB
<D1?
HJV1?j
` 1 2 3 4 5 6 7 8 & .11H
0h ? a(y___PPT10Y+D=' =
@B +a
(
l
CRV
V
l
CVVXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
( 0
l
CbV
V
l
CbVXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
(
l
CgV
V
l
ChVXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
(
l
CPpV
V
l
C$qVXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
( AF
l
CDV
V
l
CVXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
(
l
C̅V
V
l
CVXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
(
l
CV
V
l
CVXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
( KK
l
CTV
V
l
C(VXV
H
0h ? a(y___PPT10Y+D=' =
@B +a
(
l
CLV
V
l
C VXV
H
0h ? a(y___PPT10Y+D=' =
@B +
(
l
CV
V
l
CVX@V
Z
HV1?
h[ leftbutton, key x , clocktick, mousemove(x,y), & ]55>
<V1?P
,
o9[ 0.034, 0.65, 0.98, 1.29, . . . ] : 2:
BCDEF1?0 @``dB
<D1?
<V1?
P
X"[ M1, m2, m3, & ] 2H
0h ? a(y___PPT10Y+D=' =
@B +
n(
l
C V
V
l
CVXV
&
<\V1?@` b
([ua1,ua2,ua3, & ],[t1,t2,t3, & ]) --->
[t1, t2, t3, & ]C 2C
<X V1?"
~([ua1,ua2,ua3, & ],[t1,t2,t3, & ]) --->
[x, x, x, & ]@ 2@H
0h ? a(y___PPT10Y+D=' =
@B +a
0T( 1
Tl
T CV
V
l
T CVXV
H
T0h ? a(y___PPT10Y+D=' =
@B +a
@P(
Pl
P C4V
V
l
P CVXV
H
P0h ? a(y___PPT10Y+D=' =
@B +
PR( L
l
CV
V
l
ChVXV
2
<V1?0
([f1,f2,f3, & ],[t1,t2,t3, & ]) --->
[f1 t1, f2 t2, f3 t3, & ]I 2IH
0h ? a(y___PPT10Y+D=' =
@B +
`(
l
CV
V
l
CVX
V
<i1?
4([Noting, Just (Button & ), Nothing, Just(Button & ), & ],
[t1,t2,t3, & ]) --->
[Nothing, Just(), Nothing, Just(), & ] 2
<8i1?@
z$Color0 = red `switch` (lbp --> blue)% 2%H
0h ? a(y___PPT10Y+D=' =
@B +
p V(
l
Ci
i
l
CiXi
6
<,i1?P
r([leftbut, key z True, clock-tick, key a True & ],
[t1, t2, t3, t4, & ])
--->
[Nothing, Just z , Nothing, Just a , & ] 2H
0h ? a(y___PPT10Y+D=' =
@B +
$`(
$l
$ C('i
i
l
$ C'iXi
$
<0)i1?w
([Noting, Just (MouseMove & ), Nothing, Just(MouseMove & ), & ],
[t1,t2,t3, & ]) --->
[Nothing, Just(x1,y1), Nothing, Just(x2,y2), & ] 2, [D
$
<p/i1?pc
n( (uas,ts) --> [x1,x2, & ],
(uas,ts) --> [y1, y2, & ] )8 28,H
$0h ? a(y___PPT10Y+D=' =
@B +m
($( (U
(l
( CAi
i
l
( CTBi@i
(
<PHi1?
([Noting,Just (Beh [x,y,...] & ),Nothing,Just(Beh [m,n,& ])& ],
[t1,t2,t3, & ]) --->
[fb1, fb2, x, y, m, n & ]Zx 2+,HH
(0h ? a(y___PPT10Y+D=' =
@B +
F>,( =66
,l
, Cfi
i
l
, Cfipi
,
<,hi1?
J([Noting, Just (Ev x), Nothing, Just(Ev y), & ] --> f -->
[Nothing, Just(f x), Nothing, Just(f y), & ]q 2q,JH
,0h ? a(y___PPT10Y+D=' =
@B +
0( }
0l
0 C8zi
i
l
0 C{iX
i
0
TT|iGH3e1?`
C
Infinite list
0
<i1?
0
(([Noting, Just x, Nothing, Just y, & ]) ---> [b0,b1,b2,b3, & ] ->
[Nothing, Just(x,b0), Nothing, Just(y,b1), & ]z 2zH
00h ?0 a(y___PPT10Y+D=' =
@B +
D<4( @.\.
4l
4 Ci
i
l
4 CĒiXP
i
4
<i1?@@7
H([Noting, Just x, Nothing, Just y, & ]) --->
[Nothing, Just a, Just b, Nothing, & ] --->
[Nothing, Just x, Just b, Just y, & ] 2H
40h ? a(y___PPT10Y+D=' =
@B +!
H@8( (:
8l
8 Ci
i
l
8 CiX
i
8
<̥i1?@@7
L[Nothing, Just x, Nothing, Just y, & ] --->
[b1, b2, b3, b4, & ] --->
[Nothing, Just(x,b2), Nothing, Just(y,b4), & ] 2H
80h ? a(y___PPT10Y+D=' =
@B +K
rj <( n5
<l
< Chi
i
l
< C* [Nothing, Just x2, Nothing, Just x3, & ] --->
[x1, x1, x2, x2, x3, ...]f 2fn
<
<i1?
X1 -> [Noting, Just f, Nothing, Just g, & ] --->
[x1, x1, f x1, (f x1), g(f x1), ...]g 2gH
<0h ? a(y___PPT10Y+D=' =
@B +
@(
@l
@ Ci
i
l
@ C`iX` i
d
@
<i1?0 P#
[True, True, False, True, False, & ] --->
[Just(), Just(), Nothing, Just(), Nothing, ...]b 2bH
@0h ? a(y___PPT10Y+D=' =
@B +
5-'D
( (KF
Dl
D Ci
i
l
D CXiXi
F PX
D
lB
D
<D1?@`@lB
D
<D1?
D
BCDEFD1?++tHHP(p((8(h8P`` H 0
0X(
@
H
h
@x @ X@
D
H4i1?
7F x
D
Hi1?z
= time axis
lB
D
<D1?@
D
Hi1?
j
5z
D
Hi1?@PY$
@Integral F z
lB
D
<D)?p`plB
D
<D)?`pplB
D
<D)?p`plB
!D
<Df)?`pplB
"D
<D1?``plB
#D
<D1?plB
$D
<D1?``plB
%D
<D1?p
&D
<i1?P t
Lt0 t1 t2 t3 t4 2
'D
<i1?
p
L([ua0,ua1,ua2,ua3, & ],[t0,t1,t2,t3, & ]) --->
[0, Area t0-t1, Area t0-t2, Area t0-t3, & ]z\ 25
H
D0h ? a(y___PPT10Y+D=' =
@B +a
H(
Hl
H C| j
j
l
H CP
jXj
H
H0h ? a(y___PPT10Y+D=' =
@B +
L( 8
Ll
L Cj
j
l
L C|jXj
H
L0h ? a(
\(
\l
\ Cj
j
l
\ C#jXj
H
\0h ? a(
0`(
`l
` C x - 2.0)]
ex4 = wander (lift1 bounce time) 0 yellow
Remember this example. Reactive animations will make this much easier to do.,MM5hReactive AnimationsWith a reactive animation, things do more than just change and move with time according to some algorithm.
Reactive programs react to user stimuli, and real-time events, even virtual events, such as:
key press
button press
hardware interrupts
virtual event - program variable takes on some particular value
We will try and illustrate this first by example, and then only later explain how it is implemented
Example:
color0 = red `switch` (lbp ->> blue)
moon = (translate (sin time,cos time) dot)
ex5 = paint color0 moonzPkPmPPhPkmg,"$iA Reactive VocabularyColors
Red,Blue,Yellow,Green,White :: Color
red, blue, yellow, green, white :: Behavior Color
Shapes and Regions
Shape :: Shape -> Region
shape :: Behavior Shape -> Behavior Region
Ellipse,Rectangle :: Float -> Float -> Region
ell, rec :: Behavior Float -> Behavior Float -> Behavior Region
Translate :: (Float,Float) -> Region -> Region
translate :: (Behavior Float, Behavior Float) -> Behavior Region -> Behavior RegionZWBWAjOperator and Event VocabularyNumeric and Boolean Operators
(+), (*) :: Num a => Behavior a -> Behavior a -> Behavior a
negate :: Num a => Behavior a -> Behavior a
(>*),(<*),(>=*),(<=*) :: Ord a => Behavior a -> Behavior a -> Behavior Bool
(&&*),(||*) :: Behavior Bool -> Behavior Bool -> Behavior Bool
Events
lbp :: Event () -- left button press
rbp :: Event () -- right button press
key :: Event Char -- key press
mm :: Event Vertex -- mouse motion`
!"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~)Root EntrydO)zZ%Current User2SummaryInformation(4PowerPoint Document("DocumentSummaryInformation8T3 !A0C0E0G0I0c00000000000000000!%),.:;?]}acdeghijklmnop0DTimes New Roman<$0<:A 04DArialNew Roman<$0<:A 04" DGenevaew Roman<$0<:A 040DCourier Newman<$0<:A 041C.@ @@``
@n?" dd@ @@``p'543
78
(-
.(
23469#lAA1?f@fg4IdIdT:A 0pppp@<4BdBd$ 0xʚ;ʚ;<4!d!dT# 0l<4ddddT# 0lr0___PPT10
2___PPT9/0?%Lecture #15, Nov. 15, 2004Todays Topics
Simple Animations - Review
Reactive animations
Vocabulary
Examples
Implementation
behaviors
events
Reading
Read Chapter 15 - A Module of Reactive Animations
Read Chapter 17 Rendering Reactive Animations
Homework
Assignment #7 on back of this handout
Due Monday Nov 29, 2004 After Thanksgiving BreakUd YUd Y<fReview: BehaviorhA Behavior a can be thought of abstractly as a function from Time to a.
In the chapter on functional animation, we animated Shape s, Region s, and Picture s.
For example:
dot = (ell 0.2 0.2)
ex1 = paint red (translate (0, time / 2) dot)
Try It
ex2 = paint blue (translate (sin time,cos time) dot)
35C7*$
B
0gAbstraction
The power of animations is the ease with which they can be abstracted over, to flexibly create new animations from old.
wander x y color = paint color (translate (x,y) dot)
ex3 = wander (time /2) (sin time) red
*y^y^oExample: The bouncing ballSuppose we wanted to animate a ball bouncing horizontally from wall to wall
The Y position is constant, but the x position varies like:epq
Implementation
bounce t = f fraction
where (period,fraction) = modula t 2
f = funs !! (period `mod` 4)
funs = [id,(2.0 -),negate,(\x -> x - 2.0)]
ex4 = wander (lift1 bounce time) 0 yellow
Remember this example. Reactive animations will make this much easier to do.,MM5hReactive AnimationsWith a reactive animation, things do more than just change and move with time according to some algorithm.
Reactive programs react to user stimuli, and real-time events, even virtual events, such as:
key press
button press
hardware interrupts
virtual event - program variable takes on some particular value
We will try and illustrate this first by example, and then only later explain how it is implemented
Example:
color0 = red `switch` (lbp ->> blue)
moon = (translate (sin time,cos time) dot)
ex5 = paint color0 moonzPkPmPPhPkmg,"$iA Reactive VocabularyColors
Red,Blue,Yellow,Green,White :: Color
red, blue, yellow, green, white :: Behavior Color
Shapes and Regions
Shape :: Shape -> Region
shape :: Behavior Shape -> Behavior Region
Ellipse,Rectangle :: Float -> Float -> Region
ell, rec :: Behavior Float -> Behavior Float -> Behavior Region
Translate :: (Float,Float) -> Region -> Region
translate :: (Behavior Float, Behavior Float) -> Behavior Region -> Behavior RegionZWBWAjOperator and Event VocabularyNumeric and Boolean Operators
(+), (*) :: Num a => Behavior a -> Behavior a -> Behavior a
negate :: Num a => Behavior a -> Behavior a
(>*),(<*),(>=*),(<=*) :: Ord a => Behavior a -> Behavior a -> Behavior Bool
(&&*),(||*) :: Behavior Bool -> Behavior Bool -> Behavior Bool
Events
lbp :: Event () -- left button press
rbp :: Event () -- right button press
key :: Event Char -- key press
mm :: Event Vertex -- mouse motion`+
*xkCombinator Vocabulary
Event Combinators
(->>) :: Event a -> b -> Event b
(=>>) :: Event a -> (a->b) -> Event b
(.|.) :: Event a -> Event a -> Event a
withElem :: Event a -> [b] -> Event (a,b)
withElem_ :: Event a -> [b] -> Event b
Behavior and Event Combinators
switch :: Behavior a -> Event(Behavior a) -> Behavior a
snapshot_ :: Event a -> Behavior b -> Event b
step :: a -> Event a -> Behavior a
stepAccum :: a -> Event(a -> a) -> Behavior a~Gy Gy bp#3 %lAnalyse Ex3.red,blue :: Behavior Color
lbp :: Event ()
(->>) :: Event a -> b -> Event b
switch :: Behavior a -> Event(Behavior a) -> Behavior a
Bnm Either (.|.) and withElem
color1 = red `switch`
(lbp `withElem_` cycle [blue,red])
ex6 = paint color1 moon
color2 = red `switch`
((lbp ->> blue) .|. (key ->> yellow))
ex7 = paint color2 moon
>'X<n
Key and Snapshot`color3 = white `switch` (key =>> \c ->
case c of r' -> red
b' -> blue
y' -> yellow
_ -> white )
ex8 = paint color3 moon
color4 = white `switch` ((key `snapshot` color4) =>> \(c,old) ->
case c of r' -> red
b' -> blue
y' -> yellow
_ -> constB old)
ex9 = paint color4 moon"u"Step :: a -> Event a -> Behavior a#"Fsize '2' = 0.2 -- size :: Char -> Float
size '3' = 0.4
size '4' = 0.6
size '5' = 0.8
size '6' = 1.0
size '7' = 1.2
size '8' = 1.4
size '9' = 1.6
size _ = 0.1
growCircle :: Char -> Region
growCircle x = Shape(Ellipse (size x) (size x))
ex10 = paint red (Shape(Ellipse 1 1)
`step` (key =>> growCircle))GG>
s
v-stepAccum :: a -> Event(a -> a) -> Behavior a^. %@
stepAccum takes a value and an event of a function. Everytime the event occurs, the function is applied to the old value to get a new value.
power2 :: Event(Float -> Float)
power2 = (lbp ->> \ x -> x*2) .|.
(rbp ->> \ x -> x * 0.5)
dynSize = 1.0 `stepAccum` power2
ex11 = paint red (ell dynSize dynSize)( + {$ rIntegralThe combinator:
integral :: Behavior Float -> Behavior Float
has a lot of interesting uses.
If F :: Behavior Float (think function from time to Float) then integral F z is the area under the curve gotten by plotting F from 0 to z1-*,<
sBouncing Ball revisited1The bouncing ball has a constant velocity (either to the right, or to the left).
Its position can be thought of as the integral of its velocity.
At time t, the area under the curve is t, so the x position is t as well. If the ball had constant velocity 2, then the area under the curve is 2 * t, etc.tBouncing Ball again
ex12 = wander x 0 yellow
where xvel = 1 `stepAccum` (hit ->> negate)
x = integral xvel
left = x <=* -2.0 &&* xvel <*0
right = x >=* 2.0 &&* xvel >*0
hit = predicate (left ||* right)
0b( -$)6wMouse MotionThe variable mm :: Event Vertex
At every point in time it is an event that returns the mouse position.
mouseDot =
mm =>> \ (x,y) ->
translate (constB x,constB y)
dot
ex13 = paint red (dot `switch` mouseDot)(iiPi1JxHow does this work?@Events are real-time actions that happen in the world. How do we mix Events and behaviors in some rational way.
The Graphics Library supports a basic type that models these actions.
type Time = Float
data G.Event
= Key { char :: Char, isDown :: Bool }
| Button { pt :: Vertex, isLeft, isDown :: Bool }
| MouseMove { pt :: Vertex }
| Resize
| Closed
deriving Show
type UserAction = G.Event! =
yType of BehaviorIn simple animations, a Behavior was a function from time. But if we mix in events, then it must be a function from time and a list of events.
First try:
newtype Behavior1 a =
Behavior1 ([(UserAction,Time)] -> Time -> a)
User Actions are time stamped. Thus the value of a behavior (Behavior1 f) at time t is, f uas t, where uas is the list of user actions.
Expensive because f has to whittle down uas at every sampling
!"#&'(*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxy{|}~ point (time t), to find the events it is interested in.HF=
.*bm
HKzSolutionRSample at monotonically increasing times, and keep the events in time order.
Analogy: suppose we have two lists xs and ys and we want to test for each element in ys whether it is a member of xs
inList :: [Int] -> Int -> Bool
result :: [Bool] -- Same length as ys
result1 :: map (inList xs) ys
What s the cost of this operation?
This is analagous to sampling a behavior at many times.6]]q)9/ '{If xs and ys are ordered ...,
result2 :: [Bool]
result2 = manyInList xs ys
manyInList :: [Int] -> [Int] -> [Bool]
manyInList [] _ = []
manyInList _ [] = []
manyInList (x:xs) (y:ys) =
if y
[Time] ->
[a])
See how this has structure similar to the manyInList problem?
manyInList :: [Int] -> [Int] -> [Bool]Jp?'o?'e
}Refinements/newtype Behavior2 a =
Behavior2 ([(UserAction,Time)] -> [Time] -> [a])
newtype Behavior3 a =
Behavior3 ([UserAction] -> [Time] -> [a])
newtype Behavior4 a =
Behavior4 ([Maybe UserAction] -> [Time] -> [a])
Final Solution
newtype Behavior a
= Behavior (([Maybe UserAction],[Time]) -> [a])
DH H
$
%#~Events"
newtype Event a =
Event (([Maybe UserAction],[Time]) -> [Maybe a])
Note there is an isomorphism between the two types
Event a and Behavior (Maybe a)
We can think of an event, that at any particular time t, either occurs, or it doesn t.
Exercise: Write the two functions that make up the isomorphism:
toEvent :: Event a -> Behavior (Maybe a)
toBeh :: Behavior(Maybe a) -> Event azG5/OG5OP
"! IntuitionIntuitively it s useful to think of a Behavior m as transforming two streams, one of user actions, the other of the corresponding time (the two streams always proceed in lock-step) , into a stream of m things.
User actions include things like
left and right button presses
key presses
mouse movement
User Actions also include the clock tick that is used to time the animation.
p9O(
+9OThe Implementationxtime :: Behavior Time
time = Behavior (\(_,ts) -> ts)
constB :: a -> Behavior a
constB x = Behavior (\_ -> repeat x)yyP+-Simple Behaviorso
red, blue :: Behavior Color
red = constB Red
blue = constB Blue
lift0 :: a -> Behavior a
lift0 = constB
(oo>&(,NotationWe often have two versions of a function:
xxx :: Behavior a -> (a -> b) -> T b
xxx_ :: Behavior a -> b -> T b
And two versions of some operators:
(=>>) :: Event a -> (a->b) -> Event b
(->>) :: Event a -> b -> Event b`+F&H+F&GLifting ordinary functions_($*) :: Behavior (a->b) -> Behavior a -> Behavior b
Behavior ff $* Behavior fb
= Behavior (\uts -> zipWith ($) (ff uts) (fb uts)
where f $ x = f x
lift1 :: (a -> b) -> (Behavior a -> Behavior b)
lift1 f b1 = lift0 f $* b1
lift2 :: (a -> b -> c) ->
(Behavior a -> Behavior b -> Behavior c)
lift2 f b1 b2 = lift1 f b1 $* b2``tL Button Presses8data G.Event
= Key { char :: Char, isDown :: Bool }
| Button { pt :: Vertex, isLeft, isDown :: Bool }
| MouseMove { pt :: Vertex }
lbp :: Event ()
lbp = Event (\(uas,_) -> map getlbp uas)
where getlbp (Just (Button _ True True)) = Just ()
getlbp _ = NothingF,!
0' Key Strokeskey :: Event Char
key = Event (\(uas,_) -> map getkey uas)
where getkey (Just (Key ch True)) = Just ch
getkey _ = Nothing !
#!Mouse Movementmm :: Event Vertex
mm = Event (\(uas,_) -> map getmm uas)
where getmm (Just (MouseMove pt))
= Just (gPtToPt pt)
getmm _ = Nothing
mouse :: (Behavior Float, Behavior Float)
mouse = (fstB m, sndB m)
where m = (0,0) `step` mm
!
#F,"Behavior and Event Combinators]switch :: Behavior a -> Event (Behavior a) -> Behavior a
Behavior fb `switch` Event fe =
memoB
(Behavior
(\uts@(us,ts) -> loop us ts (fe uts) (fb uts)))
where loop (_:us) (_:ts) ~(e:es) (b:bs) =
b : case e of
Nothing -> loop us ts es bs
Just (Behavior fb')
-> loop us ts es (fb' (us,ts))
L^9 pB
8#Event Transformer (map?)
(=>>) :: Event a -> (a->b) -> Event b
Event fe =>> f = Event (\uts -> map aux (fe uts))
where aux (Just a) = Just (f a)
aux Nothing = Nothing
(->>) :: Event a -> b -> Event b
e ->> v = e =>> \_ -> v
P.
$withElem`withElem :: Event a -> [b] -> Event (a,b)
withElem (Event fe) bs
= Event (\uts -> loop (fe uts) bs)
where loop (Just a : evs) (b:bs)
= Just (a,b) : loop evs bs
loop (Nothing : evs) bs
= Nothing : loop evs bs
withElem_ :: Event a -> [b] -> Event b
withElem_ e bs = e `withElem` bs =>> snd
aa%
&&%Either one event or another
(.|.) :: Event a -> Event a -> Event a
Event fe1 .|. Event fe2
= Event (\uts -> zipWith aux (fe1 uts) (fe2 uts))
where aux Nothing Nothing = Nothing
aux (Just x) _ = Just x
aux _ (Just x) = Just xPN
&Snapshot'snapshot :: Event a -> Behavior b -> Event (a,b)
Event fe `snapshot` Behavior fb
= Event (\uts -> zipWith aux (fe uts) (fb uts))
where aux (Just x) y = Just (x,y)
aux Nothing _ = Nothing
snapshot_ :: Event a -> Behavior b -> Event b
snapshot_ e b = e `snapshot` b =>> snd
((8
'step and stepAccum step :: a -> Event a -> Behavior a
a `step` e = constB a `switch` e =>> constB
stepAccum :: a -> Event (a->a) -> Behavior a
a `stepAccum` e = b
where b = a `step`
(e `snapshot` b =>> uncurry ($))
b0 ' D( predicatepredicate :: Behavior Bool -> Event ()
predicate (Behavior fb)
= Event (\uts -> map aux (fb uts))
where aux True = Just ()
aux False = Nothingb"
?)integralintegral :: Behavior Float -> Behavior Float
integral (Behavior fb)
= Behavior (\uts@(us,t:ts) ->
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 ast@"*Putting it all together@reactimate :: String -> Behavior a -> (a -> IO Graphic) -> IO ()
reactimate title franProg toGraphic
= runGraphics $
do w <- openWindowEx title (Just (0,0))
(Just (xWin,yWin))
drawBufferedGraphic (Just 30)
(us,ts,addEvents) <- windowUser w
addEvents
let drawPic (Just p) =
do g <- toGraphic p
setGraphic w g
addEvents
getWindowTick w
drawPic Nothing = return ()
let Event fe = sample `snapshot_` franProg
mapM_ drawPic (fe (us,ts))$AA
7
*
"
'+The Channel Abstraction
(us,ts,addEvents) <- windowUser w
us, and ts are infinite streams made with channels.
A Channel is a special kind of abstraction, in the multiprocessing paradigm.
If you pull on the tail of a channel, and it is null, then you wait until something becomes available.
addEvents :: IO () is a action which adds the latest user actions, thus extending the streams us and ts"T" L b
\.Making a Stream from a Channel
makeStream :: IO ([a], a -> IO ())
makeStream = do
ch <- newChan
contents <- getChanContents ch
return (contents, writeChan ch)
/A Reactive window8windowUser :: Window -> IO ([Maybe UserAction], [Time], IO ())
windowUser w
= do (evs, addEv) <- makeStream
t0 <- timeGetTime
let addEvents =
let loop rt = do
mev <- maybeGetWindowEvent w
case mev of
Nothing -> return ()
Just e -> addEv(rt, Just e) >> loop rt
in do t <- timeGetTime
let rt = w32ToTime (t-t0)
loop rt
addEv (rt, Nothing)
return (map snd evs, map fst evs, addEvents)$9?
N, 0,The Paddle Ball Gamepaddleball vel = walls `over` paddle `over` ball 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))
x `between` (a,b) = x >* a &&* x <* b#GQQ_31&The reactive ball-ball vel =
let xvel = vel `stepAccum` xbounce ->> negate
xpos = integral xvel
xbounce = predicate (xpos >* 2 &&* xvel >* 0
||* xpos <* -2 &&* xvel <* 0)
yvel = vel `stepAccum` ybounce ->> negate
ypos = integral yvel
ybounce = predicate (ypos >* 1.5 &&* yvel >* 0
||* ypos `between` (-2.0,-1.5) &&*
fst mouse `between` (xpos-0.25,xpos+0.25) &&*
yvel <* 0)
in paint yellow (translate (xpos, ypos) (ell 0.2 0.2))
main = test (paddleball 1).. 3>$-2|Last homework assigned Wednesday. See webpage. Due Wednesday Dec. 8, 2004.
Final Exam scheduled for Wednesday Dec. 8, 2004
}|
\P$
p$(
pr
p Spk
k
r
p SkXk
H
p0h ? a(80___PPT10.COrrl2mNl=(@
0ReactAnim\Reactimate.lhs\..\..\..\AFunProgYale\ReactAnim\Reactimate.lhs/0( 0;[0
0000$([\{b00000000000 0=] 00
0000 2 3 !A0C0E0G0I0c00000000000000000!%),.
՜.+,D՜.+,t0
Letter Paper (8.5x11 in)Y"w2{
7Times New RomanArialGenevaCourier NewDefault DesignLecture #15, Nov. 15, 2004Review: BehaviorAbstractionExample: The bouncing ballSlide 5Slide 6ImplementationReactive AnimationsA Reactive VocabularyOperator and Event VocabularyCombinator Vocabulary
Analyse Ex3.Either (.|.) and withElemKey and Snapshot#Step :: a -> Event a -> Behavior a.stepAccum :: a -> Event(a -> a) -> Behavior a IntegralBouncing Ball revisitedBouncing Ball again
Mouse MotionHow does this work?Type of Behavior SolutionIf xs and ys are ordered ...Behavior: Second tryRefinementsEvents
IntuitionThe ImplementationSimple Behaviors NotationLifting ordinary functionsButton PressesKey StrokesMouse MovementBehavior and Event CombinatorsEvent Transformer (map?) withElemEither one event or another Snapshotstep and stepAccum
predicate integralPutting it all togetherThe Channel AbstractionMaking a Stream from a ChannelA Reactive windowThe Paddle Ball GameThe reactive ball Slide 50Fonts UsedDesign Template
Slide Titles2 8@_PID_HLINKSA/..\..\..\AFunProgYale\ReactAnim\Reactimate.lhs_"sheardsheard+
*xkCombinator Vocabulary
Event Combinators
(->>) :: Event a -> b -> Event b
(=>>) :: Event a -> (a->b) -> Event b
(.|.) :: Event a -> Event a -> Event a
withElem :: Event a -> [b] -> Event (a,b)
withElem_ :: Event a -> [b] -> Event b
Behavior and Event Combinators
switch :: Behavior a -> Event(Behavior a) -> Behavior a
snapshot_ :: Event a -> Behavior b -> Event b
step :: a -> Event a -> Behavior a
stepAccum :: a -> Event(a -> a) -> Behavior a~Gy Gy bp#3 %lAnalyse Ex3.red,blue :: Behavior Color
lbp :: Event ()
(->>) :: Event a -> b -> Event b
switch :: Behavior a -> Event(Behavior a) -> Behavior a
Bnm Either (.|.) and withElem
color1 = red `switch`
(lbp `withElem_` cycle [blue,red])
ex6 = paint color1 moon
color2 = red `switch`
((lbp ->> blue) .|. (key ->> yellow))
ex7 = paint color2 moon
>'X<n
Key and Snapshot`color3 = white `switch` (key =>> \c ->
case c of r' -> red
b' -> blue
y' -> yellow
_ -> white )
ex8 = paint color3 moon
color4 = white `switch` ((key `snapshot` color4) =>> \(c,old) ->
case c of r' -> red
b' -> blue
y' -> yellow
_ -> constB old)
ex9 = paint color4 moon"u"Step :: a -> Event a -> Behavior a#"Fsize '2' = 0.2 -- size :: Char -> Float
size '3' = 0.4
size '4' = 0.6
size '5' = 0.8
size '6' = 1.0
size '7' = 1.2
size '8' = 1.4
size '9' = 1.6
size _ = 0.1
growCircle :: Char -> Region
growCircle x = Shape(Ellipse (size x) (size x))
ex10 = paint red (Shape(Ellipse 1 1)
`step` (key =>> growCircle))GG>
s
v-stepAccum :: a -> Event(a -> a) -> Behavior a^. %@
stepAccum takes a value and an event of a function. Everytime the event occurs, the function is applied to the old value to get a new value.
power2 :: Event(Float -> Float)
power2 = (lbp ->> \ x -> x*2) .|.
(rbp ->> \ x -> x * 0.5)
dynSize = 1.0 `stepAccum` power2
ex11 = paint red (ell dynSize dynSize)( + {$ rIntegralThe combinator:
integral :: Behavior Float -> Behavior Float
has a lot of interesting uses.
If F :: Behavior Float (think function from time to Float) then integral F z is the area under the curve gotten by plotting F from 0 to z1-*,<
sBouncing Ball revisited1The bouncing ball has a constant velocity (either to the right, or to the left).
Its position can be thought of as the integral of its velocity.
At time t, the area under the curve is t, so the x position is t as well. If the ball had constant velocity 2, then the area under the curve is 2 * t, etc.tBouncing Ball again
ex12 = wander x 0 yellow
where xvel = 1 `stepAccum` (hit ->> negate)
x = integral xvel
left = x <=* -2.0 &&* xvel <*0
right = x >=* 2.0 &&* xvel >*0
hit = predicate (left ||* right)
0b( -$)6wMouse MotionThe variable mm :: Event Vertex
At every point in time it is an event that returns the mouse position.
mouseDot =
mm =>> \ (x,y) ->
translate (constB x,constB y)
dot
ex13 = paint red (dot `switch` mouseDot)(iiPi1JxHow does this work?@Events are real-time actions that happen in the world. How do we mix Events and behaviors in some rational way.
The Graphics Library supports a basic type that models these actions.
type Time = Float
data G.Event
= Key { char :: Char, isDown :: Bool }
| Button { pt :: Vertex, isLeft, isDown :: Bool }
| MouseMove { pt :: Vertex }
| Resize
| Closed
deriving Show
type UserAction = G.Event! =
yType of BehaviorIn simple animations, a Behavior was a function from time. But if we mix in events, then it must be a function from time and a list of events.
First try:
newtype Behavior1 a =
Behavior1 ([(UserAction,Time)] -> Time -> a)
User Actions are time stamped. Thus the value of a behavior (Behavior1 f) at time t is, f uas t, where uas is the list of user actions.
Expensive because f has to whittle down uas at every sampling point (time t), to find the events it is interested in.HF=
.*bm
HKzSolutionRSample at monotonically increasing times, and keep the events in time order.
Analogy: suppose we have two lists xs and ys and we want to test for each element in ys whether it is a member of xs
inList :: [Int] -> Int -> Bool
result :: [Bool] -- Same length as ys
result1 :: map (inList xs) ys
What s the cost of this operation?
This is analagous to sampling a behavior at many times.6]]q)9/ '{If xs and ys are ordered ...,
result2 :: [Bool]
result2 = manyInList xs ys
manyInList :: [Int] -> [Int] -> [Bool]
manyInList [] _ = []
manyInList _ [] = []
manyInList (x:xs) (y:ys) =
if y
[Time] ->
[a])
See how this has structure similar to the manyInList problem?
manyInList :: [Int] -> [Int] -> [Bool]Jp?'o?'e
}Refinements/newtype Behavior2 a =
Behavior2 ([(UserAction,Time)] -> [Time] -> [a])
newtype Behavior3 a =
Behavior3 ([UserAction] -> [Time] -> [a])
newtype Behavior4 a =
Behavior4 ([Maybe UserAction] -> [Time] -> [a])
Final Solution
newtype Behavior a
= Behavior (([Maybe UserAction],[Time]) -> [a])
DH H
$
%#~Events"
newtype Event a =
Event (([Maybe UserAction],[Time]) -> [Maybe a])
Note there is an isomorphism between the two types
Event a and Behavior (Maybe a)
We can think of an event, that at any particular time t, either occurs, or it doesn t.
Exercise: Write the two functions that make up the isomorphism:
toEvent :: Event a -> Behavior (Maybe a)
toBeh :: Behavior(Maybe a) -> Event azG5/OG5OP
"! IntuitionIntuitively it s useful to think of a Behavior m as transforming two streams, one of user actions, the other of the corresponding time (the two streams always proceed in lock-step) , into a stream of m things.
User actions include things like
left and right button presses
key presses
mouse movement
User Actions also include the clock tick that is used to time the animation.
p9O(
+9OThe Implementationxtime :: Behavior Time
time = Behavior (\(_,ts) -> ts)
constB :: a -> Behavior a
constB x = Behavior (\_ -> repeat x)yyP+-Simple Behaviorso
red, blue :: Behavior Color
red = constB Red
blue = constB Blue
lift0 :: a -> Behavior a
lift0 = constB
(oo>&(,NotationWe often have two versions of a function:
xxx :: Behavior a -> (a -> b) -> T b
xxx_ :: Behavior a -> b -> T b
And two versions of some operators:
(=>>) :: Event a -> (a->b) -> Event b
(->>) :: Event a -> b -> Event b`+F&H+F&GLifting ordinary functions`($*) :: Behavior (a->b) -> Behavior a -> Behavior b
Behavior ff $* Behavior fb
= Behavior (\uts -> zipWith ($) (ff uts) (fb uts)
where f $ x = f x
lift1 :: (a -> b) -> (Behavior a -> Behavior b)
lift1 f b1 = lift0 f $* b1
lift2 :: (a -> b -> c) ->
(Behavior a -> Behavior b -> Behavior c)
lift2 f b1 b2 = lift1 f b1 $* b2$atL Button Presses8data G.Event
= Key { char :: Char, isDown :: Bool }
| Button { pt :: Vertex, isLeft, isDown :: Bool }
| MouseMove { pt :: Vertex }
lbp :: Event ()
lbp = Event (\(uas,_) -> map getlbp uas)
where getlbp (Just (Button _ True True)) = Just ()
getlbp _ = NothingF,!
0' Key Strokeskey :: Event Char
key = Event (\(uas,_) -> map getkey uas)
where getkey (Just (Key ch True)) = Just ch
getkey _ = Nothing !
#!Mouse Movementmm :: Event Vertex
mm = Event (\(uas,_) -> map getmm uas)
where getmm (Just (MouseMove pt))
= Just (gPtToPt pt)
getmm _ = Nothing
mouse :: (Behavior Float, Behavior Float)
mouse = (fstB m, sndB m)
where m = (0,0) `step` mm
!
#F,"Behavior and Event Combinators]switch :: Behavior a -> Event (Behavior a) -> Behavior a
Behavior fb `switch` Event fe =
memoB
(Behavior
(\uts@(us,ts) -> loop us ts (fe uts) (fb uts)))
where loop (_:us) (_:ts) ~(e:es) (b:bs) =
b : case e of
Nothing -> loop us ts es bs
Just (Behavior fb')
-> loop us ts es (fb' (us,ts))
L^9 pB
8#Event Transformer (map?)
(=>>) :: Event a -> (a->b) -> Event b
Event fe =>> f = Event (\uts -> map aux (fe uts))
where aux (Just a) = Just (f a)
aux Nothing = Nothing
(->>) :: Event a -> b -> Event b
e ->> v = e =>> \_ -> v
P.
$withElem`withElem :: Event a -> [b] -> Event (a,b)
withElem (Event fe) bs
= Event (\uts -> loop (fe uts) bs)
where loop (Just a : evs) (b:bs)
= Just (a,b) : loop evs bs
loop (Nothing : evs) bs
= Nothing : loop evs bs
withElem_ :: Event a -> [b] -> Event b
withElem_ e bs = e `withElem` bs =>> snd
aa%
&&%Either one event or another
(.|.) :: Event a -> Event a -> Event a
Event fe1 .|. Event fe2
= Event (\uts -> zipWith aux (fe1 uts) (fe2 uts))
where aux Nothing Nothing = Nothing
aux (Just x) _ = Just x
aux _ (Just x) = Just xPN
&Snapshot'snapshot :: Event a -> Behavior b -> Event (a,b)
Event fe `snapshot` Behavior fb
= Event (\uts -> zipWith aux (fe uts) (fb uts))
where aux (Just x) y = Just (x,y)
aux Nothing _ = Nothing
snapshot_ :: Event a -> Behavior b -> Event b
snapshot_ e b = e `snapshot` b =>> snd
((8
'step and stepAccum step :: a -> Event a -> Behavior a
a `step` e = constB a `switch` e =>> constB
stepAccum :: a -> Event (a->a) -> Behavior a
a `stepAccum` e = b
where b = a `step`
(e `snapshot` b =>> uncurry ($))
b0 ' D( predicatepredicate :: Behavior Bool -> Event ()
predicate (Behavior fb)
= Event (\uts -> map aux (fb uts))
where aux True = Just ()
aux False = Nothingb"
?)integralintegral :: Behavior Float -> Behavior Float
integral (Behavior fb)
= Behavior (\uts@(us,t:ts) ->
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 ast@"*Putting it all together@reactimate :: String -> Behavior a -> (a -> IO Graphic) -> IO ()
reactimate title franProg toGraphic
= runGraphics $
do w <- openWindowEx title (Just (0,0))
(Just (xWin,yWin))
drawBufferedGraphic (Just 30)
(us,ts,addEvents) <- windowUser w
addEvents
let drawPic (Just p) =
do g <- toGraphic p
setGraphic w g
addEvents
getWindowTick w
drawPic Nothing = return ()
let Event fe = sample `snapshot_` franProg
mapM_ drawPic (fe (us,ts))$AA
7
*
"
'+The Channel Abstraction
(us,ts,addEvents) <- windowUser w
us, and ts are infinite streams made with channels.
A Channel is a special kind of abstraction, in the multiprocessing paradigm.
If you pull on the tail of a channel, and it is null, then you wait until something becomes available.
addEvents :: IO () is a action which adds the latest user actions, thus extending the streams us and ts"T" L b
\.Making a Stream from a Channel
makeStream :: IO ([a], a -> IO ())
makeStream = do
ch <- newChan
contents <- getChanContents ch
return (contents, writeChan ch)
/A Reactive window8windowUser :: Window -> IO ([Maybe UserAction], [Time], IO ())
windowUser w
= do (evs, addEv) <- makeStream
t0 <- timeGetTime
let addEvents =
let loop rt = do
mev <- maybeGetWindowEvent w
case mev of
Nothing -> return ()
Just e -> addEv(rt, Just e) >> loop rt
in do t <- timeGetTime
let rt = w32ToTime (t-t0)
loop rt
addEv (rt, Nothing)
return (map snd evs, map fst evs, addEvents)$9?
N, 0,The Paddle Ball Gamepaddleball vel = walls `over` paddle `over` ball 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))
x `between` (a,b) = x >* a &&* x <* b#GQQ_31&The reactive ball-ball vel =
let xvel = vel `stepAccum` xbounce ->> negate
xpos = integral xvel
xbounce = predicate (xpos >* 2 &&* xvel >* 0
||* xpos <* -2 &&* xvel <* 0)
yvel = vel `stepAccum` ybounce ->> negate
ypos = integral yvel
ybounce = predicate (ypos >* 1.5 &&* yvel >* 0
||* ypos `between` (-2.0,-1.5) &&*
fst mouse `between` (xpos-0.25,xpos+0.25) &&*
yvel <* 0)
in paint yellow (translate (xpos, ypos) (ell 0.2 0.2))
main = test (paddleball 1).. 3>$-2|Last homework assigned Wednesday. See webpage. Due Wednesday Dec. 8, 2004.
Final Exam scheduled for Wednesday Dec. 8, 2004
}|P
P( L
l
C.
.
l
C.X.
~
<.1?~
([t1,t2,t3, & ],[f1,f2,f3, & ]) --->
([t1,t2,t3, & ],[x1,x2,x3, & ]) --->
([t1,t2,t3, & ],[f1 x1, f2 x2, f3 x3, & ]o 2oH
0h ? a(y___PPT10Y+D=' =
@B +r4ymh3(@
0ReactAnim\Reactimate.lhs\..\..\..\AFunProgYale\ReactAnim\Reactimate.lhs/0( 0;[0
0000$([\{b00000000000 0=] 00
0000 2 3 !A0C0E0G0I0c00000000000000000!%),.:;?]}acdeghijklmnop0DTimes New Roman<$0<:A 04DArialNew Roman<$0<:A 04" DGenevaew Roman<$0<:A 040DCourier Newman<$0<:A 041C.@ @@``
@n?" dd@ @@``p'543
78
(-
.(
23469#lAA1?f@fg4KdKdT:A 0:ppp@<4BdBd$ 0 ʚ;ʚ;<4!d!dT# 0l<4ddddT# 0lr0___PPT10
2___PPT9/0?%Lecture #15, Nov. 15, 2004Todays Topics
Simple Animations - Review
Reactive animations
Vocabulary
Examples
Implementation
behaviors
events
Reading
Read Chapter 15 - A Module of Reactive Animations
Read Chapter 17 Rendering Reactive Animations
Homework
Assignment #7 on back of this handout
Due Monday Nov 29, 2004 After Thanksgiving BreakUd YUd Y<fReview: BehaviorhA Behavior a can be thought of abstractly as a function from Time to a.
In the chapter on functional animation, we animated Shape s, Region s, and Picture s.
For example:
dot = (ell 0.2 0.2)
ex1 = paint red (translate (0, time / 2) dot)
Try It
ex2 = paint blue (translate (sin time,cos time) dot)
35C7*$
B
0gAbstraction
The power of animations is the ease with which they can be abstracted over, to flexibly create new animations from old.
wander x y color = paint color (translate (x,y) dot)
ex3 = wander (time /2) (sin time) red
*y^y^oExample: The bouncing ballSuppose we wanted to animate a ball bouncing horizontally from wall to wall
The Y position is constant, but the x position varies like:epq
Implementation
bounce t = f fraction
where (period,fraction) = modula t 2
f = funs !! (period `mod` 4)
funs = [id,(2.0 -),negate,(\x -> x - 2.0)]
ex4 = wander (lift1 bounce time) 0 yellow
Remember this example. Reactive animations will make this much easier to do.,MM5hReactive AnimationsWith a reactive animation, things do more than just change and move with time according to some algorithm.
Reactive programs react to user stimuli, and real-time events, even virtual events, such as:
key press
button press
hardware interrupts
virtual event - program variable takes on some particular value
We will try and illustrate this first by example, and then only later explain how it is implemented
Example:
color0 = red `switch` (lbp ->> blue)
moon = (translate (sin time,cos time) dot)
ex5 = paint color0 moonzPkPmPPhPkmg,"$iA Reactive VocabularyColors
Red,Blue,Yellow,Green,White :: Color
red, blue, yellow, green, white :: Behavior Color
Shapes and Regions
Shape :: Shape -> Region
shape :: Behavior Shape -> Behavior Region
Ellipse,Rectangle :: Float -> Float -> Region
ell, rec :: Behavior Float -> Behavior Float -> Behavior Region
Translate :: (Float,Float) -> Region -> Region
translate :: (Behavior Float, Behavior Float) -> Behavior Region -> Behavior RegionZWBWAjOperator and Event VocabularyNumeric and Boolean Operators
(+), (*) :: Num a => Behavior a -> Behavior a -> Behavior a
negate :: Num a => Behavior a -> Behavior a
(>*),(<*),(>=*),(<=*) :: Ord a => Behavior a -> Behavior a -> Behavior Bool
(&&*),(||*) :: Behavior Bool -> Behavior Bool -> Behavior Bool
Events
lbp :: Event () -- left button press
rbp :: Event () -- right button press
key :: Event Char -- key press
mm :: Event Vertex -- mouse motion`+
*xkCombinator Vocabulary
Event Combinators
(->>) :: Event a -> b -> Event b
(=>>) :: Event a -> (a->b) -> Event b
(.|.) :: Event a -> Event a -> Event a
withElem :: Event a -> [b] -> Event (a,b)
withElem_ :: Event a -> [b] -> Event b
Behavior and Event Combinators
switch :: Behavior a -> Event(Behavior a) -> Behavior a
snapshot_ :: Event a -> Behavior b -> Event b
step :: a -> Event a -> Behavior a
stepAccum :: a -> Event(a -> a) -> Behavior a~Gy Gy bp#3 %lAnalyse Ex3.red,blue :: Behavior Color
lbp :: Event ()
(->>) :: Event a -> b -> Event b
switch :: Behavior a -> Event(Behavior a) -> Behavior a
Bnm Either (.|.) and withElem
color1 = red `switch`
(lbp `withElem_` cycle [blue,red])
ex6 = paint color1 moon
color2 = red `switch`
((lbp ->> blue) .|. (key ->> yellow))
ex7 = paint color2 moon
>'X<n
Key and Snapshot`color3 = white `switch` (key =>> \c ->
case c of r' -> red
b' -> blue
y' -> yellow
_ -> white )
ex8 = paint color3 moon
color4 = white `switch` ((key `snapshot` color4) =>> \(c,old) ->
case c of r' -> red
b' -> blue
y' -> yellow
_ -> constB old)
ex9 = paint color4 moon"u"Step :: a -> Event a -> Behavior a#"Fsize '2' = 0.2 -- size :: Char -> Float
size '3' = 0.4
size '4' = 0.6
size '5' = 0.8
size '6' = 1.0
size '7' = 1.2
size '8' = 1.4
size '9' = 1.6
size _ = 0.1
growCircle :: Char -> Region
growCircle x = Shape(Ellipse (size x) (size x))
ex10 = paint red (Shape(Ellipse 1 1)
`step` (key =>> growCircle))GG>
s
v-stepAccum :: a -> Event(a -> a) -> Behavior a^. %@
stepAccum takes a value and an event of a function. Everytime the event occurs, the function is applied to the old value to get a new value.
power2 :: Event(Float -> Float)
power2 = (lbp ->> \ x -> x*2) .|.
(rbp ->> \ x -> x * 0.5)
dynSize = 1.0 `stepAccum` power2
ex11 = paint red (ell dynSize dynSize)( + {$ rIntegralThe combinator:
integral :: Behavior Float -> Behavior Float
has a lot of interesting uses.
If F :: Behavior Float (think function from time to Float) then integral F z is the area under the curve gotten by plotting F from 0 to z1-*,<
sBouncing Ball revisited1The bouncing ball has a constant velocity (either to the right, or to the left).
Its position can be thought of as the integral of its velocity.
At time t, the area under the curve is t, so the x position is t as well. If the ball had constant velocity 2, then the area under the curve is 2 * t, etc.tBouncing Ball again
ex12 = wander x 0 yellow
where xvel = 1 `stepAccum` (hit ->> negate)
x = integral xvel
left = x <=* -2.0 &&* xvel <*0
right = x >=* 2.0 &&* xvel >*0
hit = predicate (left ||* right)
0b( -$)6wMouse MotionThe variable mm :: Event Vertex
At every point in time it is an event that returns the mouse position.
mouseDot =
mm =>> \ (x,y) ->
translate (constB x,constB y)
dot
ex13 = paint red (dot `switch` mouseDot)(iiPi1JxHow does this work?@Events are real-time actions that happen in the world. How do we mix Events and behaviors in some rational way.
The Graphics Library supports a basic type that models these actions.
type Time = Float
data G.Event
= Key { char :: Char, isDown :: Bool }
| Button { pt :: Vertex, isLeft, isDown :: Bool }
| MouseMove { pt :: Vertex }
| Resize
| Closed
deriving Show
type UserAction = G.Event! =
yType of BehaviorIn simple animations, a Behavior was a function from time. But if we mix in events, then it must be a function from time and a list of events.
First try:
newtype Behavior1 a =
Behavior1 ([(UserAction,Time)] -> Time -> a)
User Actions are time stamped. Thus the value of a behavior (Behavior1 f) at time t is, f uas t, where uas is the list of user actions.
Expensive because f has to whittle down uas at every sampling point (time t), to find the events it is interested in.HF=
.*bm
HKzSolutionRSample at monotonically increasing times, and keep the events in time order.
Analogy: suppose we have two lists xs and ys and we want to test for each element in ys whether it is a member of xs
inList :: [Int] -> Int -> Bool
result :: [Bool] -- Same length as ys
result1 :: map (inList xs) ys
What s the cost of this operation?
This is analagous to sampling a behavior at many times.6]]q)9/ '{If xs and ys are ordered ...,
result2 :: [Bool]
result2 = manyInList xs ys
manyInList :: [Int] -> [Int] -> [Bool]
manyInList [] _ = []
manyInList _ [] = []
manyInList (x:xs) (y:ys) =
if y
[Time] ->
[a])
See how this has structure similar to the manyInList problem?
manyInList :: [Int] -> [Int] -> [Bool]Jp?'o?'e
}Refinements/newtype Behavior2 a =
Behavior2 ([(UserAction,Time)] -> [Time] -> [a])
newtype Behavior3 a =
Behavior3 ([UserAction] -> [Time] -> [a])
newtype Behavior4 a =
Behavior4 ([Maybe UserAction] -> [Time] -> [a])
Final Solution
newtype Behavior a
= Behavior (([Maybe UserAction],[Time]) -> [a])
DH H
$
%#~Events"
newtype Event a =
Event (([Maybe UserAction],[Time]) -> [Maybe a])
Note there is an isomorphism between the two types
Event a and Behavior (Maybe a)
We can think of an event, that at any particular time t, either occurs, or it doesn t.
Exercise: Write the two functions that make up the isomorphism:
toEvent :: Event a -> Behavior (Maybe a)
toBeh :: Behavior(Maybe a) -> Event azG5/OG5OP
"! IntuitionIntuitively it s useful to think of a Behavior m as transforming two streams, one of user actions, the other of the corresponding time (the two streams always proceed in lock-step) , into a stream of m things.
User actions include things like
left and right button presses
key presses
mouse movement
User Actions also include the clock tick that is used to time the animation.
p9O(
+9OThe Implementationxtime :: Behavior Time
time = Behavior (\(_,ts) -> ts)
constB :: a -> Behavior a
constB x = Behavior (\_ -> repeat x)yyP+-Simple Behaviorso
red, blue :: Behavior Color
red = constB Red
blue = constB Blue
lift0 :: a -> Behavior a
lift0 = constB
(oo>&(,NotationWe often have two versions of a function:
xxx :: Behavior a -> (a -> b) -> T b
xxx_ :: Behavior a -> b -> T b
And two versions of some operators:
(=>>) :: Event a -> (a->b) -> Event b
(->>) :: Event a -> b -> Event b`+F&H+F&GLifting ordinary functions`($*) :: Behavior (a->b) -> Behavior a -> Behavior b
Behavior ff $* Behavior fb
= Behavior (\uts -> zipWith ($) (ff uts) (fb uts)
where f $ x = f x
lift1 :: (a -> b) -> (Behavior a -> Behavior b)
lift1 f b1 = lift0 f $* b1
lift2 :: (a -> b -> c) ->
(Behavior a -> Behavior b -> Behavior c)
lift2 f b1 b2 = lift1 f b1 $* b2$atL Button Presses8data G.Event
= Key { char :: Char, isDown :: Bool }
| Button { pt :: Vertex, isLeft, isDown :: Bool }
| MouseMove { pt :: Vertex }
lbp :: Event ()
lbp = Event (\(uas,_) -> map getlbp uas)
where getlbp (Just (Button _ True True)) = Just ()
getlbp _ = NothingF,!
0' Key Strokeskey :: Event Char
key = Event (\(uas,_) -> map getkey uas)
where getkey (Just (Key ch True)) = Just ch
getkey _ = Nothing !
#!Mouse Movementmm :: Event Vertex
mm = Event (\(uas,_) -> map getmm uas)
where getmm (Just (MouseMove pt))
= Just (gPtToPt pt)
getmm _ = Nothing
mouse :: (Behavior Float, Behavior Float)
mouse = (fstB m, sndB m)
where m = (0,0) `step` mm
!
#F,"Behavior and Event Combinators]switch :: Behavior a -> Event (Behavior a) -> Behavior a
Behavior fb `switch` Event fe =
memoB
(Behavior
(\uts@(us,ts) -> loop us ts (fe uts) (fb uts)))
where loop (_:us) (_:ts) ~(e:es) (b:bs) =
b : case e of
Nothing -> loop us ts es bs
Just (Behavior fb')
-> loop us ts es (fb' (us,ts))
L^9 pB
8#Event Transformer (map?)
(=>>) :: Event a -> (a->b) -> Event b
Event fe =>> f = Event (\uts -> map aux (fe uts))
where aux (Just a) = Just (f a)
aux Nothing = Nothing
(->>) :: Event a -> b -> Event b
e ->> v = e =>> \_ -> v
P.
$withElem`withElem :: Event a -> [b] -> Event (a,b)
withElem (Event fe) bs
= Event (\uts -> loop (fe uts) bs)
where loop (Just a : evs) (b:bs)
= Just (a,b) : loop evs bs
loop (Nothing : evs) bs
= Nothing : loop evs bs
withElem_ :: Event a -> [b] -> Event b
withElem_ e bs = e `withElem` bs =>> snd
aa%
&&%Either one event or another
(.|.) :: Event a -> Event a -> Event a
Event fe1 .|. Event fe2
= Event (\uts -> zipWith aux (fe1 uts) (fe2 uts))
where aux Nothing Nothing = Nothing
aux (Just x) _ = Just x
aux _ (Just x) = Just xPN
&Snapshot'snapshot :: Event a -> Behavior b -> Event (a,b)
Event fe `snapshot` Behavior fb
= Event (\uts -> zipWith aux (fe uts) (fb uts))
where aux (Just x) y = Just (x,y)
aux Nothing _ = Nothing
snapshot_ :: Event a -> Behavior b -> Event b
snapshot_ e b = e `snapshot` b =>> snd
((8
'step and stepAccum step :: a -> Event a -> Behavior a
a `step` e = constB a `switch` e =>> constB
stepAccum :: a -> Event (a->a) -> Behavior a
a `stepAccum` e = b
where b = a `step`
(e `snapshot` b =>> uncurry ($))
b0 ' D( predicatepredicate :: Behavior Bool -> Event ()
predicate (Behavior fb)
= Event (\uts -> map aux (fb uts))
where aux True = Just ()
aux False = Nothingb"
?)integralintegral :: Behavior Float -> Behavior Float
integral (Behavior fb)
= Behavior (\uts@(us,t:ts) ->
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 ast@"*Putting it all together@reactimate :: String -> Behavior a -> (a -> IO Graphic) -> IO ()
reactimate title franProg toGraphic
= runGraphics $
do w <- openWindowEx title (Just (0,0))
(Just (xWin,yWin))
drawBufferedGraphic (Just 30)
(us,ts,addEvents) <- windowUser w
addEvents
let drawPic (Just p) =
do g <- toGraphic p
setGraphic w g
addEvents
getWindowTick w
drawPic Nothing = return ()
let Event fe = sample `snapshot_` franProg
mapM_ drawPic (fe (us,ts))$AA
7
*
"
'+The Channel Abstraction
(us,ts,addEvents) <- windowUser w
us, and ts are infinite streams made with channels.
A Channel is a special kind of abstraction, in the multiprocessing paradigm.
If you pull on the tail of a channel, and it is null, then you wait until something becomes available.
addEvents :: IO () is a action which adds the latest user actions, thus extending the streams us and ts"T"Lb
\.Making a Stream from a Channel
makeStream :: IO ([a], a -> IO ())
makeStream = do
ch <- newChan
contents <- getChanContents ch
return (contents, writeChan ch)
/A Reactive window8windowUser :: Window -> IO ([Maybe UserAction], [Time], IO ())
windowUser w
= do (evs, addEv) <- makeStream
t0 <- timeGetTime
let addEvents =
let loop rt = do
mev <- maybeGetWindowEvent w
case mev of
Nothing -> return ()
Just e -> addEv(rt, Just e) >> loop rt
in do t <- timeGetTime
let rt = w32ToTime (t-t0)
loop rt
addEv (rt, Nothing)
return (map snd evs, map fst evs, addEvents)$9?
N, 0,The Paddle Ball Gamepaddleball vel = walls `over` paddle `over` ball 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))
x `between` (a,b) = x >* a &&* x <* b#GQQ_31&The reactive ball-ball vel =
let xvel = vel `stepAccum` xbounce ->> negate
xpos = integral xvel
xbounce = predicate (xpos >* 2 &&* xvel >* 0
||* xpos <* -2 &&* xvel <* 0)
yvel = vel `stepAccum` ybounce ->> negate
ypos = integral yvel
ybounce = predicate (ypos >* 1.5 &&* yvel >* 0
||* ypos `between` (-2.0,-1.5) &&*
fst mouse `between` (xpos-0.25,xpos+0.25) &&*
yvel <* 0)
in paint yellow (translate (xpos, ypos) (ell 0.2 0.2))
main = test (paddleball 1).. 3>$-2|Last homework assigned Wednesday. See webpage. Due Wednesday Dec. 8, 2004.
Final Exam scheduled for Wednesday Dec. 8, 2004
}|P
L( 8
Ll
L C/
/
l
L C\/X/
H
L0h ? a(r 2m"*