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(a)(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
