[reactive] Re: An adapter for SDL

[Facundo Domínguez]

> My test program leaks memory as it runs and does not react to clicks,

Sorry, I meant keyboard presses.

Facundo

2010/8/5 Facundo Domínguez <facundominguez at gmail.com>:
> 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
>