New Timer module and game loop with semi-fixed time step.

1 files changed, 12 insertions, 10 deletions

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index a49efec..ac0feab 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -18,9 +18,11 @@ data GameState = GameState
     world  :: [GameObject]
   }
 
+app = App step render resize
+
 main =
   withWindow (900, 600) (2, 0) (Just "Pong") initGame $
-    loop step
+    loop app
 
 initGame :: Window -> Game () GameState
 initGame window = return $ GameState window newWorld
@@ -28,16 +30,18 @@ initGame window = return $ GameState window newWorld
 step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
 step elapsed dt inputEvents = do
   gs <- getGameState
-  gameIO . process $ inputEvents
   let events = translateEvents inputEvents
   modifyGameState $ \gs ->
     gs
-      { world = stepWorld (realToFrac elapsed) dt events (world gs)
+      { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs)
       }
-  getGameState >>= \gs -> gameIO . render $ world gs
   return (not $ exitRequested inputEvents)
 
-render world = do
+render :: Game GameState ()
+render = getGameState >>= \gs -> gameIO . render' $ world gs
+
+render' :: [GameObject] -> IO ()
+render' world = do
   -- Clear the background to a different colour than the playable area to make
   -- the latter distinguishable.
   GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0
@@ -74,22 +78,20 @@ renderGO go = do
       GL.vertex (GL.Vertex2 xmax ymax)
       GL.vertex (GL.Vertex2 xmax ymin)
 
-process = mapM_ procEvent
-
-procEvent (Resize w h) =
+resize :: WindowEvent -> Game s ()
+resize (ResizeEvent w h) =
   let r = fromIntegral w / fromIntegral h
       pad    = if r > 1 then (r-1) / 2 else (1/r - 1) / 2
       left   = if r > 1 then -pad else 0
       right  = if r > 1 then 1 + pad else 1
       bottom = if r > 1 then 0 else -pad
       top    = if r > 1 then 1 else 1 + pad
-  in do
+  in gameIO $ do
     GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
     GL.matrixMode $= GL.Projection
     GL.loadIdentity
     GL.ortho left right bottom top (-1) 1
     GL.matrixMode $= GL.Modelview 0
-procEvent _ = return ()
 
 translateEvents = mapMaybe translateEvents'
   where translateEvents' (KeyDown KEY_LEFT)  = Just MoveLeft