diff options
| author | 3gg <3gg@shellblade.net> | 2024-08-15 22:49:21 -0700 | 
|---|---|---|
| committer | 3gg <3gg@shellblade.net> | 2024-08-15 22:49:21 -0700 | 
| commit | 678a4631a36b55face6541c473d5dfb854225547 (patch) | |
| tree | c673a3597edd8a42a3b0cb15e9d6f8ea1a2235f7 /Demos/Pong/Main.hs | |
| parent | ae90f69c9fe6f21f698305232b453fcfbd3fdb02 (diff) | |
Better event handling.
Diffstat (limited to 'Demos/Pong/Main.hs')
| -rw-r--r-- | Demos/Pong/Main.hs | 16 | 
1 files changed, 9 insertions, 7 deletions
| diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs index c768142..ee55622 100644 --- a/Demos/Pong/Main.hs +++ b/Demos/Pong/Main.hs | |||
| @@ -14,6 +14,7 @@ import Spear.Render.Core.State | |||
| 14 | import Spear.Render.Immediate | 14 | import Spear.Render.Immediate | 
| 15 | import Spear.Window | 15 | import Spear.Window | 
| 16 | 16 | ||
| 17 | import Control.Monad (when) | ||
| 17 | import Data.Maybe (mapMaybe) | 18 | import Data.Maybe (mapMaybe) | 
| 18 | 19 | ||
| 19 | 20 | ||
| @@ -44,7 +45,8 @@ endGame = do | |||
| 44 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | 45 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | 
| 45 | step elapsed dt inputEvents = do | 46 | step elapsed dt inputEvents = do | 
| 46 | gs <- getGameState | 47 | gs <- getGameState | 
| 47 | let events = translateEvents inputEvents | 48 | events <- processInput (window gs) | 
| 49 | --when (events /= []) $ gameIO . putStrLn $ show events | ||
| 48 | modifyGameState $ \gs -> | 50 | modifyGameState $ \gs -> | 
| 49 | gs | 51 | gs | 
| 50 | { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs) | 52 | { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs) | 
| @@ -112,11 +114,11 @@ resize (ResizeEvent w h) = | |||
| 112 | viewProjection = Matrix4.ortho left right bottom top (-1) 1 | 114 | viewProjection = Matrix4.ortho left right bottom top (-1) 1 | 
| 113 | } | 115 | } | 
| 114 | 116 | ||
| 115 | translateEvents = mapMaybe translateEvents' | 117 | |
| 116 | where translateEvents' (KeyDown KEY_A) = Just MoveLeft | 118 | processInput :: Window -> Game GameState [GameEvent] | 
| 117 | translateEvents' (KeyDown KEY_D) = Just MoveRight | 119 | processInput window = processKeys window | 
| 118 | translateEvents' (KeyUp KEY_A) = Just StopLeft | 120 | [ (KEY_A, MoveLeft) | 
| 119 | translateEvents' (KeyUp KEY_D) = Just StopRight | 121 | , (KEY_D, MoveRight) | 
| 120 | translateEvents' _ = Nothing | 122 | ] | 
| 121 | 123 | ||
| 122 | exitRequested = elem (KeyDown KEY_ESC) | 124 | exitRequested = elem (KeyDown KEY_ESC) | 
