aboutsummaryrefslogtreecommitdiff
path: root/Demos/Pong/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Demos/Pong/Main.hs')
-rw-r--r--Demos/Pong/Main.hs22
1 files changed, 11 insertions, 11 deletions
diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index 0644f9d..a49efec 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -8,6 +8,7 @@ import Pong
8import Spear.App 8import Spear.App
9import Spear.Game 9import Spear.Game
10import Spear.Math.AABB 10import Spear.Math.AABB
11import Spear.Math.Spatial
11import Spear.Math.Spatial2 12import Spear.Math.Spatial2
12import Spear.Math.Vector 13import Spear.Math.Vector
13import Spear.Window 14import Spear.Window
@@ -28,10 +29,10 @@ step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
28step elapsed dt inputEvents = do 29step elapsed dt inputEvents = do
29 gs <- getGameState 30 gs <- getGameState
30 gameIO . process $ inputEvents 31 gameIO . process $ inputEvents
31 let events = translate inputEvents 32 let events = translateEvents inputEvents
32 modifyGameState $ \gs -> 33 modifyGameState $ \gs ->
33 gs 34 gs
34 { world = stepWorld elapsed dt events (world gs) 35 { world = stepWorld (realToFrac elapsed) dt events (world gs)
35 } 36 }
36 getGameState >>= \gs -> gameIO . render $ world gs 37 getGameState >>= \gs -> gameIO . render $ world gs
37 return (not $ exitRequested inputEvents) 38 return (not $ exitRequested inputEvents)
@@ -63,7 +64,7 @@ renderBackground =
63renderGO :: GameObject -> IO () 64renderGO :: GameObject -> IO ()
64renderGO go = do 65renderGO go = do
65 let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go 66 let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go
66 (Vector2 xcenter ycenter) = pos go 67 (Vector2 xcenter ycenter) = position go
67 (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax') 68 (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax')
68 GL.preservingMatrix $ do 69 GL.preservingMatrix $ do
69 GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0) 70 GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0)
@@ -76,7 +77,7 @@ renderGO go = do
76process = mapM_ procEvent 77process = mapM_ procEvent
77 78
78procEvent (Resize w h) = 79procEvent (Resize w h) =
79 let r = (fromIntegral w) / (fromIntegral h) 80 let r = fromIntegral w / fromIntegral h
80 pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 81 pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2
81 left = if r > 1 then -pad else 0 82 left = if r > 1 then -pad else 0
82 right = if r > 1 then 1 + pad else 1 83 right = if r > 1 then 1 + pad else 1
@@ -90,13 +91,12 @@ procEvent (Resize w h) =
90 GL.matrixMode $= GL.Modelview 0 91 GL.matrixMode $= GL.Modelview 0
91procEvent _ = return () 92procEvent _ = return ()
92 93
93translate = mapMaybe translate' 94translateEvents = mapMaybe translateEvents'
94 95 where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft
95translate' (KeyDown KEY_LEFT) = Just MoveLeft 96 translateEvents' (KeyDown KEY_RIGHT) = Just MoveRight
96translate' (KeyDown KEY_RIGHT) = Just MoveRight 97 translateEvents' (KeyUp KEY_LEFT) = Just StopLeft
97translate' (KeyUp KEY_LEFT) = Just StopLeft 98 translateEvents' (KeyUp KEY_RIGHT) = Just StopRight
98translate' (KeyUp KEY_RIGHT) = Just StopRight 99 translateEvents' _ = Nothing
99translate' _ = Nothing
100 100
101exitRequested = elem (KeyDown KEY_ESC) 101exitRequested = elem (KeyDown KEY_ESC)
102 102