diff options
Diffstat (limited to 'Demos/Pong')
-rw-r--r-- | Demos/Pong/Main.hs | 16 | ||||
-rw-r--r-- | Demos/Pong/Pong.hs | 13 |
2 files changed, 14 insertions, 15 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) |
diff --git a/Demos/Pong/Pong.hs b/Demos/Pong/Pong.hs index 943682f..2bd9df1 100644 --- a/Demos/Pong/Pong.hs +++ b/Demos/Pong/Pong.hs | |||
@@ -40,9 +40,7 @@ initialBallPos = vec2 0.5 0.5 | |||
40 | data GameEvent | 40 | data GameEvent |
41 | = MoveLeft | 41 | = MoveLeft |
42 | | MoveRight | 42 | | MoveRight |
43 | | StopLeft | 43 | deriving (Eq, Ord, Show) |
44 | | StopRight | ||
45 | deriving (Eq, Ord) | ||
46 | 44 | ||
47 | -- Game objects | 45 | -- Game objects |
48 | 46 | ||
@@ -163,11 +161,10 @@ movePad = step $ \elapsed _ _ _ pad -> | |||
163 | 161 | ||
164 | stepPlayer = sfold moveGO .> clamp | 162 | stepPlayer = sfold moveGO .> clamp |
165 | 163 | ||
166 | moveGO = | 164 | moveGO = mconcat |
167 | mconcat | 165 | [ swhen MoveLeft $ moveGO' (vec2 (-playerSpeed) 0) |
168 | [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0), | 166 | , swhen MoveRight $ moveGO' (vec2 playerSpeed 0) |
169 | switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) | 167 | ] |
170 | ] | ||
171 | 168 | ||
172 | moveGO' :: Vector2 -> Step s e GameObject GameObject | 169 | moveGO' :: Vector2 -> Step s e GameObject GameObject |
173 | moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir) | 170 | moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir) |