diff options
Diffstat (limited to 'Demos')
-rw-r--r-- | Demos/Pong/Main.hs | 22 |
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 | |||
18 | world :: [GameObject] | 18 | world :: [GameObject] |
19 | } | 19 | } |
20 | 20 | ||
21 | app = App step render resize | ||
22 | |||
21 | main = | 23 | main = |
22 | withWindow (900, 600) (2, 0) (Just "Pong") initGame $ | 24 | withWindow (900, 600) (2, 0) (Just "Pong") initGame $ |
23 | loop step | 25 | loop app |
24 | 26 | ||
25 | initGame :: Window -> Game () GameState | 27 | initGame :: Window -> Game () GameState |
26 | initGame window = return $ GameState window newWorld | 28 | initGame window = return $ GameState window newWorld |
@@ -28,16 +30,18 @@ initGame window = return $ GameState window newWorld | |||
28 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | 30 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool |
29 | step elapsed dt inputEvents = do | 31 | step elapsed dt inputEvents = do |
30 | gs <- getGameState | 32 | gs <- getGameState |
31 | gameIO . process $ inputEvents | ||
32 | let events = translateEvents inputEvents | 33 | let events = translateEvents inputEvents |
33 | modifyGameState $ \gs -> | 34 | modifyGameState $ \gs -> |
34 | gs | 35 | gs |
35 | { world = stepWorld (realToFrac elapsed) dt events (world gs) | 36 | { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs) |
36 | } | 37 | } |
37 | getGameState >>= \gs -> gameIO . render $ world gs | ||
38 | return (not $ exitRequested inputEvents) | 38 | return (not $ exitRequested inputEvents) |
39 | 39 | ||
40 | render world = do | 40 | render :: Game GameState () |
41 | render = getGameState >>= \gs -> gameIO . render' $ world gs | ||
42 | |||
43 | render' :: [GameObject] -> IO () | ||
44 | render' world = do | ||
41 | -- Clear the background to a different colour than the playable area to make | 45 | -- Clear the background to a different colour than the playable area to make |
42 | -- the latter distinguishable. | 46 | -- the latter distinguishable. |
43 | GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0 | 47 | GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0 |
@@ -74,22 +78,20 @@ renderGO go = do | |||
74 | GL.vertex (GL.Vertex2 xmax ymax) | 78 | GL.vertex (GL.Vertex2 xmax ymax) |
75 | GL.vertex (GL.Vertex2 xmax ymin) | 79 | GL.vertex (GL.Vertex2 xmax ymin) |
76 | 80 | ||
77 | process = mapM_ procEvent | 81 | resize :: WindowEvent -> Game s () |
78 | 82 | resize (ResizeEvent w h) = | |
79 | procEvent (Resize w h) = | ||
80 | let r = fromIntegral w / fromIntegral h | 83 | let r = fromIntegral w / fromIntegral h |
81 | pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 | 84 | pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 |
82 | left = if r > 1 then -pad else 0 | 85 | left = if r > 1 then -pad else 0 |
83 | right = if r > 1 then 1 + pad else 1 | 86 | right = if r > 1 then 1 + pad else 1 |
84 | bottom = if r > 1 then 0 else -pad | 87 | bottom = if r > 1 then 0 else -pad |
85 | top = if r > 1 then 1 else 1 + pad | 88 | top = if r > 1 then 1 else 1 + pad |
86 | in do | 89 | in gameIO $ do |
87 | GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) | 90 | GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) |
88 | GL.matrixMode $= GL.Projection | 91 | GL.matrixMode $= GL.Projection |
89 | GL.loadIdentity | 92 | GL.loadIdentity |
90 | GL.ortho left right bottom top (-1) 1 | 93 | GL.ortho left right bottom top (-1) 1 |
91 | GL.matrixMode $= GL.Modelview 0 | 94 | GL.matrixMode $= GL.Modelview 0 |
92 | procEvent _ = return () | ||
93 | 95 | ||
94 | translateEvents = mapMaybe translateEvents' | 96 | translateEvents = mapMaybe translateEvents' |
95 | where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft | 97 | where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft |