From 4fc298a611785ddac55cb0679953411638679edc Mon Sep 17 00:00:00 2001
From: 3gg <3gg@shellblade.net>
Date: Thu, 14 Sep 2023 09:12:19 -0700
Subject: New Timer module and game loop with semi-fixed time step.
---
Demos/Pong/Main.hs | 22 ++++++++++++----------
1 file changed, 12 insertions(+), 10 deletions(-)
(limited to 'Demos')
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
--
cgit v1.2.3