Game loop in reactive-banana

GameLoop.hs

{------------------------------------------------------------------------------
    reactive-banana

    Implementation of an "industry strength" game loop with fixed time step
    and variable fps.

    See also  http://gafferongames.com/game-physics/fix-your-timestep/
-------------------------------------------------------------------------------}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where

import Reactive.Banana

{------------------------------------------------------------------------------
    Game Loop
-------------------------------------------------------------------------------}
main = do
    SDL.init [InitEverything]
    SDL.setVideoMode 800 600 32 []
    
    gamestate <- initGameState
    Prelude.flip evalStateT gamestate gameLoop
    return ()


    -- timing helpers
fps  = 30                     -- physics framerate
dt   = (1000 `div` fps) * ms  -- physics timestep


type Duration = Integer
type Time     = Integer

type GameNetworkDescription
    =  Event ()      -- ^ physics timer
    -> Behavior Time -- ^ clock (synchronized with physics and user input)
    -> Event Input   -- ^ user input
    -> NetworkDescription (Behavior (IO ())) -- ^ graphics to be sampled

gameLoop
    :: Duration -- ^ physics time step
    -> Double   -- ^ maximal frames per second
    -> GameNetworkDescription -- ^ event network corresponding to the game
    -> IO ()
gameLoop dt maximalFps gameNetwork = do
    -- set up event network
    (ahInput   , fireInput)    <- newAddHandler
    (ahPhysics , firePhysics)  <- newAddHandler
    (ahGraphics, fireGraphics) <- newAddHandler
    clock <- newIORef 0
    
    network <- compile $ do
        eInput    <- fromAddHandler ahInput
        ePhysics  <- fromAddHandler ahPhysics
        bTime     <- fromPoll (readIORef clock)
        eGraphics <- fromAddHandler ahGraphics
        bGraphics <- gameNetwork ePhysics bTime eInput
        reactimate $ bGraphics <@ eGraphics
    actuate network
    
    -- game loop
    go clock 0 =<< getRealTime
    
    where
    go clock acc old = do
        -- acc  accumulates excess time (usually < dt)
        -- old  keeps track of the time of the previous iteration of the game loop
        input <- SDL.pollEvent
        unless (event == Quit) $ do
            new <- getRealTime

            -- FIXME: set clock properly for user input
            fireInput input         -- handle user input

            -- "physics" simulation
            -- invariant: the world time begins at 0 and is always a multiple of dt
            let (n,acc2) = (new - old + acc) `divMod` dt
            replicateM_ (fromIntegral n) $ do
                modifyIORef clock (+dt)  -- update clock
                firePhysics ()           -- handle physics

            -- no need to hog all the CPU
            -- FIXME: something with maximalFPS
            SDL.delay (dt `div` 3)

            -- graphics
            -- note: time might *not* be multiple of dt, for interpolation
            tempclock <- readIORef clock    -- remember multiple of dt
            modifyIORef clock (+acc2)       -- advance clock slightly
            fireGraphics ()                 -- interpolate graphics
            writeIORef  clock tempclock     -- reset clock to multiple of dt

            go clock acc2 new