CSE 230 W11 - Reactive Programming



> module Fal where
>
> import Data.Char
> import SOE hiding (Region, Event)
> import qualified SOE as G (Region, Event)
> import Animation (picToGraphic)
> import Shape
> import Picture
> import Memo1
> import Draw (xWin,yWin,intToFloat)
> import Control.Concurrent.Chan
>
> infixr 1 =>>, ->>
> infixr 1 `untilB`, `switch`, `stepAccum`, `step`
> infixl 0 .|.
> infixr 4 <*, >*
> infixr 3 &&*
> infixr 2 ||*

Last time, we saw how to do animation in a functional style, where the meat of the animation was captured as a behavior which was essentially a function from each time step to some output a. We built up rich animations by composing different behaviors with an expressive set of combinators. Today, we will extend that model to include user actions in a style known as functional reactive programming(FRP).

Typically, reactive programs (eg GUIs) are written in an event-driven style where each user event triggers some function (eg a callback.) For example, in AJAX client-side programs one sees things like onClick(...) or onMouseOver(...) where the ellipses specify the callbacks that are triggered when particular user actions occur. However, such programs are inherently against the Haskell, functional style, and, more importantly, they are rather difficult to read and reason about because the flow of control leaps about all over the place. Its a bit like programming with goto !

Lets see how a bit of abstraction can help.

The basic idea is simple: in addition to the continuous Behavior type we will introduce a discrete Event type that will be a stream of actions (user generated or otherwise.)

Our programs will simple compose behaviours and events into one giant behavior that will be rendered by the function

> reAct s b =  reactimate s $ lift1 picToGraphic b

Warmup: Drawing Pictures Via Behaviors

Ok, as a warm up, lets draw a simple animation with a circling red ball.

> ball	= ell 0.2 0.2

Recall the function translate which takes a pair of float behaviors and a picture behavior and generates a behavior where the picture is moved to the relevant co-ordinates at each time step.

> circ  = translate (cos time, sin time) ball 

Finally, we can paint the circle with a color behavior and draw it on the screen.

> main0 = reAct "0" $ paint red circ

Recall that this red is not just the color Red but the color lifted into behaviors, that is, a function that returns red for each time step.

Toggling Colors Via Event Sampling

Now, lets get the user involved. Suppose that I want a color behavior where the color is red until the left mouse button is clicked, at which point, the color should turn blue. With our combinators we would write

> main1 = reAct "1" $ paint redBlue circ   
> where redBlue = red `untilB` (lbp ->> blue)
> booo = red `untilB` (lbp ->> (blue `untilB` (lbp ->> booo)))
> main1a = reAct "1" $ paint booo circ

Theres a lot going on here! First, lets look at

lbp :: Event ()

The name lbp represents an Event () value which you can think of as an infinite stream of left-button-presses, where each press returns a () value. Next, lets look at the combinator

(->>) :: Event a -> b -> Event b

This is a higher-order sampling combinator that says that if you have some event stream of a values, and a particular b value, then you can get an event stream of b values where at each event the b value is returned. (Note that the a value at each event is ignored here.) In this case, we sample the value

blue :: Behavior Color

which is a behavior, thus

(lbp ->> blue) :: Event (Behavior Color)

meaning that the second argument to the untilB combinator is a stream of behavior events (in this case, the same blue behavior at each button-click.) Lets look more closely at the the untilB combinator

untilB :: Behavior a -> Event (Behavior a) -> Behavior a

The type is almost completely descriptive (we will soon see another combinator with the same type that works rather differently.) In essence, the expression b untilB e returns a behavior that is identical to b upto the point in time when the first (behavior) event on the stream e is generated, at which point the behavior switches over to the new behavior event. Thus,

red `untilB` (lbp ->> blue) :: Behavior Color 

is a behavior that is the color red until the first mouse-click, at which point the behavior toggles over to blue.

Recursive Toggling

Now, we can fully exploit the power of the pure, combinator based approach to manipulating events and behaviors. We can write a simple color behavior that toggles between red and blue on each mouse click, by using recursion

> redBlueR = red  `untilB` lbp ->> 
> blue `untilB` lbp ->>
> redBlueR
>
> main2 = reAct "2" $ paint redBlueR circ

If you are confused, then note that the above expression is actually

redBlueR = red `untilB` (lbp ->> blue `untilB` (lbp ->> redBlueR))

and you can work out the types inside-out to deduce that

red, blue, redBlueR :: Behavior Color

Recycling Colors

> cyclecolors cs = foldr (\c b -> c `untilB` (lbp ->> b)) red (cycle cs) 
> bazz = reAct "2" $ paint (cyclecolors [blue, yellow, green]) circ

Lets see if we can generalize the above to a behavior that toggles through an arbitrary set of colors. Our friend in this endeavor will be the standard library function

cycle :: [a] -> [a]

which takes a list, and generates an infinite version of the list that repeatedly cycles over the originial. In other words

cycle [1,2,3] = [1,2,3,1,2,3,1,2,3,1,2,3,...]

Now given a list of color (behaviors) we can first generate their cycled version and then at each click, we just move onto the tail of the list.

> clickThru cs = toggle $ cycle cs 
> where toggle (c:cs) = c `untilB` (lbp ->> toggle cs)

DO IN CLASS What do you think the type of clickThru is ?

> colors = [red, green, blue, yellow]
>
> main3 = reAct "s" $ paint rgby3 circ
> rgby3 = clickThru colors

Fusing Event Streams

Now the left mouse button is but one source of events. In general, one can imagine many others, the other mouse buttons, the keyboard, the network, on screen “collisions” and so on. Thus, to work with these sources, we need a means to combine the events generated by each source.

The following fuse-combinator .|. combinator provides this functionality.

(.|.) :: Event a -> Event a -> Event a

We can use it like so

> redBorY = red `untilB` ((lbp ->> blue) .|. (key ->> yellow))
> main4 = reAct "4" $ paint redBorY circ

Here we have two streams of (behavior) events

(lbp ->> blue)    :: Event (Behavior Color)
(key ->> yellow)) :: Event (Behavior Color)

which are fused into a single stream by the .|.

((lbp ->> blue) .|. (key ->> yellow)) :: Event (Behavior Color)

which is then composed with the initial red behavior by the untilB combinator. The result is a behavior that starts off as red, but upon receiving the first event from the fused stream, toggles over to the color returned by the stream; blue if the mouse click happens first, or yellow if a key press happens.

Of course, the fuse combinator can be used recursively as well, so here is a behavior like the above, but which uses recursion to allow to repeat toggling.

> main5 = reAct "5" $ paint redBorYR circ
> where redBorYR = red `untilB` e
> e = (lbp ->> blue `untilB` e) .|.
> (key ->> yellow `untilB` e)

Switching Between Many Choices

You know my feelings about explicit recursion; it is best caged inside a few powerful, easy-to-read and understand patterns. The only reason we have to use it in the above is because the untilB combinator is anemic, it simply uses the behavior returned by the first event while instead, we want one that keeps switching over to the behavior returned by each event in the stream.

Such a functionality is provided by the switch combinator

switch :: Behavior a -> Event (Behavior a) -> Behavior a

(whose type is exactly the same as untilB — the types don’t always tell you everything, so choose your names carefully!)

The expression b switch e is a behavior that starts off as b and then, at each event on the e stream, switches over to the behavior returned by that event. Thus, we can get our repeated toggling simply by

> main6 = reAct "6" $ paint redBorYR circ
> where redBorYR = red `switch` ((lbp ->> blue) .|. (key ->> yellow))

Sampling Between Many Choices

Let us revisit the example where we toggled over a bunch of colors. The pattern of using the same event stream to sample between an (infinite) list of values is so common, that we can capture it in a combinator

withElem_ :: Event a -> [b] -> Event b

The type is rather descriptive. Given a stream of events, and an (infinite) list of values, we can generate a stream of events where the values returned are the corresponding elements from the list. Thus, the expression

lbp `withElem_` [1..]
> blll = white `switch` (lbp `withElem_` (cycle colors))
> main1000 = reAct "7" $ paint blll circ

corresponds to an event stream where subsequent mouse clicks return 1, 2, 3, and so on. Thus,

cycle colors :: [Behavior Color]

and so

lbp `withElem_` cycle colors :: Event (Behavior Color)

is a stream of events where each mouse click returns a color behavior. When we compose this with an initial red behavior using switch we get a color behavior where each mouse click shifts over to the next color in the cycle.

> colsClk = red `switch` (lbp `withElem_` cycle colors)
> main7 = reAct "7" $ paint colsClk circ

Using Event Data

So far, we have mostly ignored the actual data being returned by the events. This is fine for, say mouse click events, but for key-press events we may want to know which key was pressed.

Indeed, the handicap is apparent from the type of the sampling operator

(->>) :: Event a -> b -> Event b

which ignores the a value altogether! We have an additional value sampling combinator

(=>>) :: Event a -> (a -> b) -> Event b

which bears a striking similarity to map. Indeed, e =>> f transforms a stream of a events to b events by using the supplied function. For example

(lbp `withElem_` [1..]) =>> (+1000)

is a stream of mouse click events that return the sequence of values 1001, 1002, 1003, and so on.

Next, we can encapsulate the events generated by key-presses as

key :: Event Char

which returns the character corresponding to the pressed key. Thus, to allow us to change the color of the rendered object differently based on the key pressed, we can simply map the key event to the appropriate color behavior and compose the result with switch like so

> rbChoose = white `switch` (key =>> \c ->
> case c of 'R' -> red
> 'B' -> blue
> 'Y' -> yellow
> _ -> white )
>
> main8 = reAct "8" $ paint rbChoose circ

Saving Old Values

The above color behavior simply resets the color to white if you press the wrong color. Instead, it would be useful to save the value of the behavior that held at the instant when the event occurred. We achieve this with the combinator

snapshot :: Event a -> Behavior b -> Event (a, b)

Here, the type is rather descriptive: it is another sampling combinator that returns at each event, the value that the behavior had at that event.

Thus, we can now fix the above so that the old color is preserved whenever some incorrect key is pressed, by using the snapshot combinator to generate an event stream with the colors that held at each keypress, and then switching over the result.

> rbRem = white `switch` ((key `snapshot` rbRem) =>> \(c,old) ->
> case c of 'R' -> red
> 'B' -> blue
> 'Y' -> yellow
> _ -> lift0 old)
>
> main9 = reAct "9" $ paint rbRem circ

Boolean Events

So far, all the events we’ve seen have come from the user doing something like pressing a button or key or such. What if we want to generate events algorithmically, for example when two (animated) objects collide with each other? In the reactive style, the trick is to think not in terms of one-off things being injected into the proceedings, but instead to step back and take a wider view in terms of behaviors and streams.

In essence, what we want is a combinator that takes some kind of continuous behavior signal, and generates an event stream with an event occurring at each time that the signal makes a big change. Enter the when combinator

when :: Behavior Bool -> Event ()

which takes a boolean behavior, intuitively, a signal that maps each time step to a boolean value, and returns a stream of () events every time the signal transitions from False to True.

Here’s how you might use it. Recall the time behavior? The expression

(time >* 5) :: Behavior Bool

is a boolean behavior that toggles to true after 5 seconds, and we can turn it into an event by

(when (time >* 5)) :: Event Bool

which in effect is like a timer that generates a True event after 5 seconds. Now, we can compose it with the sample and until combinator to build a color behavior that toggles after 5 seconds.

> main10 = reAct "10" $ paint w5b circ 
> where w5b = white `untilB` (when (time >* 5) ->> blue)

We could generate a repeated pulse event by applying some periodic operation to the time behavior

Now with a repeated clock

> pulse  = when (sin time >* 0)

and we can use the pulse behavior to switch the color

> main11 = reAct "11" $ paint rgby circ
> where rgby = red `switch` (pulse `withElem_` colors)

Integrating over the past

Often, it is useful to have a primitive that can accumulate the values of previous behaviors. For example, recall the equations

s(t) = s0 + \Sum_0^t v(t).dt
v(t) = v0 + \Sum_0^t f(t).dt

which govern the position and velocity of a moving object at time t where f is some (constant) that denotes acceleration. We can define a notion of integration over time as a combinator for behaviors

integral :: Behavior Float -> Behavior Float

where integral b is simply the behavior

ib(t) = b(0) + \Sum_0^t b(t).dt

Armed with this combinator, we can write a very declarative description of a bouncing ball animation.

> bball g hv  = translate (x,y) ball
> where x = -3 + integral hv
> y = 1.5 + integral vv
> vv = integral g `switch`
> (when (y <* -1.5) `snapshot_` vv =>> \v' ->
> lift0 (-v') + integral g)
>
> main12 = reAct "bball" $ paint red (bball (-4) 0.5)

Note how the x coordinate is simply integrating the (constant) horizontal velocity hv over time. The y coordinate integrates the vertical velocity vv over time, but vv is itself made of two parts

Converting Events Into Behaviors

> cball xy  = translate xy ball
> stepY hv = (x, y) 
> where x = -3 + integral hv
> y = 0 `step` (key =>> ((0.3 *) . fromIntegral . digitToInt))
>
> main13 = reAct "cball" $ paint red $ cball (stepY 0.5)

Accumulating Events Into Behaviors

> ladderY hv = (x, y)
> where x = -3 + integral hv
> y = 0 `stepAccum` (lbp ->> (0.2 +))
>
> main14 = reAct "cball" $ paint red $ cball (ladderY 0.5)
> main15 = reAct "15" $ paint colsClk $ translate mouse ball

PaddleBall

> paddleball speed = walls `over` paddle `over` pball speed
> walls = upper `over` left `over` right
> where upper = paint green $ translate ( 0,1.7) (rec 4.4 0.05)
> left = paint green $ translate (-2.2,0) (rec 0.05 3.4)
> right = paint green $ translate ( 2.2,0) (rec 0.05 3.4)
> paddle = paint red $ translate (fst mouse, -1.7) (rec 0.5 0.05)
> pball vel = paint yellow $ translate (xpos, ypos) ball
> where xvel = vel `stepAccum` xhit ->> negate
> xpos = integral xvel
> xhit = when (xpos >* 2 ||* xpos <* -2)
> yvel = vel `stepAccum` yhit ->> negate
> ypos = integral yvel
> yhit = when (ypos >* 1.5
> ||* ypos `between` (-2.0,-1.5) &&*
> fst mouse `between` (xpos-0.25,xpos+0.25))
> x `between` (a,b) = x >* a &&* x <* b
> main16 = reAct "paddleball" $ paddleball 2

FRP was invented in 1997 by Elliot and Hudak1. It has, over time, been adopted in a variety of domains. Recent variants include FlapJax2 which shows how FRP can be used to build elegant Ajax programs, and Microsoft has released the Reactive Extensions3 for .Net that brings FRP to the .Net platform. Finally, FRP is not only about GUIs, a recent effort aims to use these ideas to make OpenFlow networks more easily programmable4.

Implementation

Since events are a discrete entity that will be composed with behaviors, we will, for efficiency reasons want a sparse sample-based representation of the two kinds of values.

TODO: Define Behavior Type here Recall “lift” Recall “red”, “translate”, etc. behaviors

TODO: Define Event Type here Show definition of ->> Show definition of untilB

TODO: * Introduce switch with its type Show definition of switch

TODO: Introduce withElem_ with its type Show definition of withElem_

TODO: Introduce =>> with its type Show definition of =>>

TODO: Introduce snapshot with its type Show definition of snapshot

TODO: Introduce when with its type Show definition of when

TODO: Introduce integral with its type Show definition of integral

TODO: Introduce step with its type Show definition of step

TODO: Introduce stepAccum with its type Show definition of stepAccum

> type Time          = Float
> type UserAction = G.Event
> newtype Behavior a = Behavior (([Maybe UserAction],[Time]) -> [a])
> newtype Event a = Event (([Maybe UserAction],[Time]) -> [Maybe a])
> time :: Behavior Time
> time = Behavior (\(_,ts) -> ts)
>
> constB :: a -> Behavior a
> constB x = Behavior (\_ -> repeat x)
>
> ($*) :: Behavior (a->b) -> Behavior a -> Behavior b
> Behavior ff $* Behavior fb
> = Behavior (\uts -> zipWith ($) (ff uts) (fb uts))
> lift0 :: a -> Behavior a
> lift0 = constB
> 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
> lift3 :: (a -> b -> c -> d) -> 
> (Behavior a -> Behavior b -> Behavior c -> Behavior d)
> lift3 f b1 b2 b3
> = lift2 f b1 b2 $* b3
> pairB :: Behavior a -> Behavior b -> Behavior (a,b)
> pairB = lift2 (,)
> fstB :: Behavior (a,b) -> Behavior a
> fstB = lift1 fst
> sndB :: Behavior (a,b) -> Behavior b
> sndB = lift1 snd
> paint :: Behavior Color -> Behavior Region -> Behavior Picture
> paint = lift2 Region
> red, blue, yellow, green, white, black :: Behavior Color
> red = lift0 Red
> blue = lift0 Blue
> yellow = lift0 Yellow
> green = lift0 Green
> white = lift0 White
> black = lift0 Black
> shape :: Behavior Shape -> Behavior Region
> shape = lift1 Shape
> ell, rec :: Behavior Float -> Behavior Float -> Behavior Region
> ell x y = shape (lift2 Ellipse x y)
> rec x y = shape (lift2 Rectangle x y)
> translate :: (Behavior Float, Behavior Float) 
> -> Behavior Region -> Behavior Region
> translate (Behavior fx, Behavior fy) (Behavior fp)
> = Behavior (\uts -> zipWith3 aux (fx uts) (fy uts) (fp uts))
> where aux x y p = Translate (x,y) p
> (>*),(<*) :: Ord a => Behavior a -> Behavior a -> Behavior Bool
> (>*) = lift2 (>)
> (<*) = lift2 (<)
> (&&*),(||*) :: Behavior Bool -> Behavior Bool -> Behavior Bool
> (&&*) = lift2 (&&)
> (||*) = lift2 (||)
> over :: Behavior Picture -> Behavior Picture -> Behavior Picture
> over = lift2 Over
> instance Fractional a => Fractional (Behavior a) where
> (/) = lift2 (/)
> fromRational = lift0 . fromRational
> instance Num a => Num (Behavior a) where
> (+) = lift2 (+)
> (*) = lift2 (*)
> negate = lift1 negate
> abs = lift1 abs
> signum = lift1 signum
> fromInteger = lift0 . fromInteger
> instance Show (Behavior a)  where
> showsPrec n a s = "<< Behavior >>"
> instance Eq (Behavior a) where
> a1 == a2 = error "Can't compare behaviors."
> instance Floating a => Floating (Behavior a) where
> pi = lift0 pi
> sqrt = lift1 sqrt
> exp = lift1 exp
> log = lift1 log
> sin = lift1 sin
> cos = lift1 cos
> tan = lift1 tan
> asin = lift1 asin
> acos = lift1 acos
> atan = lift1 atan
> sinh = lift1 sinh
> cosh = lift1 cosh
> tanh = lift1 tanh
> asinh = lift1 asinh
> acosh = lift1 acosh
> atanh = lift1 atanh
> -- untilB, switch :: Behavior a -> Event (Behavior a) -> Behavior a
> Behavior fb `untilB` 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') -> fb' (us,ts)
> memoB :: Behavior a -> Behavior a
> memoB (Behavior fb) = Behavior (memo1 fb)
> 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))
> lbp :: Event ()
> lbp = Event (\(uas,_) -> map getlbp uas)
> where getlbp (Just (Button _ True True)) = Just ()
> getlbp _ = Nothing
> (=>>) :: Event a -> (a->b) -> Event b
> Event fe =>> f = Event (map (fmap f) . fe)
> e ->> v = e =>> \_ -> v
> while :: Behavior Bool -> Event ()
> while (Behavior fb) 
> = Event (\uts -> map aux (fb uts))
> where aux True = Just ()
> aux False = Nothing
> unique :: (Show a, Eq a) => Event a -> Event a
> unique (Event fe) =
> Event (\uts -> aux (fe uts))
> where aux xs = zipWith remdup (Nothing:xs) xs
> remdup x y | x==y = Nothing
> | otherwise = y
> when :: Behavior Bool -> Event ()
> when = unique . while
> integral :: 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 as
> 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
>
> (.|.) :: 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 y) = Just y
> key :: Event Char
> key = Event (\(uas,_) -> map getkey uas)
> where getkey (Just (Key ch True)) = Just ch
> getkey _ = Nothing
>
> 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
> zipWith' f ~(x:xs) ~(y:ys) = f x y : zipWith' f xs ys
> snapshot_ :: Event a -> Behavior b -> Event b
> snapshot_ e b = e `snapshot` b =>> snd
> 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 ($))
> mm :: Event Coordinate
> mm = Event (\(uas,_) -> map getmm uas)
> where getmm (Just (MouseMove pt)) = Just (gPtToPt pt)
> getmm _ = Nothing
>
>
> gPtToPt :: (Int, Int) -> Coordinate
> gPtToPt (x,y) = ( pixelToInch (x - 300)
> , pixelToInch (250 - y) )
>
> pixelToInch :: Int -> Float
> pixelToInch n = intToFloat n / 100
>
> mouse :: (Behavior Float, Behavior Float)
>
> mouse = (fstB m, sndB m)
> where m = (0,0) `step` mm
>
> reactimate :: String -> Behavior Graphic -> IO ()
> reactimate title franProg
> = runGraphics $
> do w <- openWindowEx title (Just (0,0)) (Just (xWin,yWin))
> drawBufferedGraphic
> (us,ts,addEvents) <- windowUser w
> addEvents
> let drawPic (Just g) =
> do setGraphic w g
> quit <- addEvents
> if quit
> then return True
> else return False
> drawPic Nothing = return False
> let Event fe = sample `snapshot_` franProg
> run drawPic (fe (us,ts))
> closeWindow w
> where
> run f (x:xs) = do
> quit <- f x
> if quit
> then return ()
> else run f xs
> run f [] = return ()
>
> sample :: Event ()
> sample = Event (\(us,_) -> map aux us)
> where aux Nothing = Just ()
> aux (Just _) = Nothing
> windowUser :: Window -> IO ([Maybe UserAction], [Time], IO Bool)
> windowUser w
> = do (evs, addEv) <- makeStream
> t0 <- timeGetTime
> let addEvents =
> let loop rt = do
> mev <- maybeGetWindowEvent w
> case mev of
> Nothing -> return False
> Just e -> case e of
> Key ' ' True -> return True
> Closed -> return True
> _ -> addEv (rt, Just e) >> loop rt
> in do t <- timeGetTime
> let rt = w32ToTime (t-t0)
> quit <- loop rt
> addEv (rt, Nothing)
> return quit
> return (map snd evs, map fst evs, addEvents)
>
> w32ToTime t = intToFloat (fromInteger (toInteger t)) / 1000
>
> makeStream :: IO ([a], a -> IO ())
> makeStream = do
> ch <- newChan
> contents <- getChanContents ch
> return (contents, writeChan ch)