[reactive] An adapter for SDL

[Facundo Domínguez]

Dear list:

I've been trying to make an adapter for SDL, and it looks like I could
have found some sort of bug. My test program leaks memory as it runs
and does not react to clicks, but I cannot figure out why. I've tested
this on Mac Leopard with ghc-6.12.1 and debian lenny with ghc-6.12.3.

Here's the code:

module Adapter where

import qualified Graphics.UI.SDL as SDL
import Control.Monad(liftM)
import FRP.Reactive
import FRP.Reactive.LegacyAdapters(makeClock,makeEvent,Sink,cGetTime,mkUpdater)

import qualified Graphics.UI.SDL as SDL

-- |Configures a Behavior to run. The first return 'IO' action should be called
-- to update the screen. The second return 'IO' action must be called
-- regularly to poll for events.
configSDLBehavior :: (Event SDL.Event -> Behavior (IO ())) -> IO (IO (), IO ())
configSDLBehavior f = do clock <- makeClock
                         (evSink,evs) <- makeEvent clock
                         upd<-mkUpdater (cGetTime clock) (f evs)
                         return (upd, getNextEvents 30 >>= mapM_ evSink)

-- |Creates an source for sdl events and the 'IO' action that must be called
-- regularly to poll for events.
sdlEvents :: IO (Event SDL.Event, IO ())
sdlEvents = do clock <- makeClock
               (evSink,evs) <- makeEvent clock
               return (evs, getNextEvents 30 >>= mapM_ evSink)


-- |@getNextEvents n@ polls for at most the next n events.
getNextEvents :: Int -> IO [SDL.Event]
getNextEvents n | n<=0 = return []
    | otherwise = do ev<-SDL.pollEvent
                     case ev of
                      SDL.NoEvent -> return []
                      _ -> liftM (ev:)$ getNextEvents (n-1)

-----------
And here is my test program:

measureFPS :: IO Int -> IO ()
measureFPS frame =
    do t0<-SDL.getTicks
       n<-frame
       t1<-SDL.getTicks
       putStr$ show (toEnum n/ (toEnum (fromEnum (t1-t0))/1000)) ++ "\n"


testB :: IO () -> Event SDL.Event -> Behavior (IO ())
testB quit evs = return () `stepper` fmap (pure quit) (filterE isKeyDown evs)

isKeyDown e@(SDL.KeyDown _) = True
isKeyDown e = False

main = SDL.withInit [SDL.InitVideo]$
    do screen <- SDL.setVideoMode 640 480 8 [SDL.SWSurface,SDL.AnyFormat]
       SDL.setCaption "Test" ""
       SDL.enableUnicode True
       quitv <- newIORef False
       (upd,poll) <- configSDLBehavior (testB (writeIORef quitv True))
       measureFPS (loop 0 quitv upd poll)
  where
        loop n quitv upd poll | seq n True =
          do b <- readIORef quitv
             if b then return n
              else do poll
                      SDL.delay 10
                      -- threadDelay 10000
                      upd
                      loop (n+1) quitv upd poll

Best,
Facundo