aboutsummaryrefslogtreecommitdiff
path: root/Demos
diff options
context:
space:
mode:
Diffstat (limited to 'Demos')
-rw-r--r--Demos/Pong/Main.hs16
-rw-r--r--Demos/Pong/Pong.hs13
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
14import Spear.Render.Immediate 14import Spear.Render.Immediate
15import Spear.Window 15import Spear.Window
16 16
17import Control.Monad (when)
17import Data.Maybe (mapMaybe) 18import Data.Maybe (mapMaybe)
18 19
19 20
@@ -44,7 +45,8 @@ endGame = do
44step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool 45step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
45step elapsed dt inputEvents = do 46step 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
115translateEvents = mapMaybe translateEvents' 117
116 where translateEvents' (KeyDown KEY_A) = Just MoveLeft 118processInput :: Window -> Game GameState [GameEvent]
117 translateEvents' (KeyDown KEY_D) = Just MoveRight 119processInput 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
122exitRequested = elem (KeyDown KEY_ESC) 124exitRequested = 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
40data GameEvent 40data 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
164stepPlayer = sfold moveGO .> clamp 162stepPlayer = sfold moveGO .> clamp
165 163
166moveGO = 164moveGO = 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
172moveGO' :: Vector2 -> Step s e GameObject GameObject 169moveGO' :: Vector2 -> Step s e GameObject GameObject
173moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir) 170moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir)