diff options
Diffstat (limited to 'Demos/Pong/Main.hs')
| -rw-r--r-- | Demos/Pong/Main.hs | 22 |
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 | |||
| 8 | import Spear.App | 8 | import Spear.App |
| 9 | import Spear.Game | 9 | import Spear.Game |
| 10 | import Spear.Math.AABB | 10 | import Spear.Math.AABB |
| 11 | import Spear.Math.Spatial | ||
| 11 | import Spear.Math.Spatial2 | 12 | import Spear.Math.Spatial2 |
| 12 | import Spear.Math.Vector | 13 | import Spear.Math.Vector |
| 13 | import Spear.Window | 14 | import Spear.Window |
| @@ -28,10 +29,10 @@ step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | |||
| 28 | step elapsed dt inputEvents = do | 29 | step 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 = | |||
| 63 | renderGO :: GameObject -> IO () | 64 | renderGO :: GameObject -> IO () |
| 64 | renderGO go = do | 65 | renderGO 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 | |||
| 76 | process = mapM_ procEvent | 77 | process = mapM_ procEvent |
| 77 | 78 | ||
| 78 | procEvent (Resize w h) = | 79 | procEvent (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 |
| 91 | procEvent _ = return () | 92 | procEvent _ = return () |
| 92 | 93 | ||
| 93 | translate = mapMaybe translate' | 94 | translateEvents = mapMaybe translateEvents' |
| 94 | 95 | where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft | |
| 95 | translate' (KeyDown KEY_LEFT) = Just MoveLeft | 96 | translateEvents' (KeyDown KEY_RIGHT) = Just MoveRight |
| 96 | translate' (KeyDown KEY_RIGHT) = Just MoveRight | 97 | translateEvents' (KeyUp KEY_LEFT) = Just StopLeft |
| 97 | translate' (KeyUp KEY_LEFT) = Just StopLeft | 98 | translateEvents' (KeyUp KEY_RIGHT) = Just StopRight |
| 98 | translate' (KeyUp KEY_RIGHT) = Just StopRight | 99 | translateEvents' _ = Nothing |
| 99 | translate' _ = Nothing | ||
| 100 | 100 | ||
| 101 | exitRequested = elem (KeyDown KEY_ESC) | 101 | exitRequested = elem (KeyDown KEY_ESC) |
| 102 | 102 | ||
