Better event handling.

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
 import           Spear.Render.Immediate
 import           Spear.Window
 
+import           Control.Monad              (when)
 import           Data.Maybe                 (mapMaybe)
 
 
@@ -44,7 +45,8 @@ endGame = do
 step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
 step elapsed dt inputEvents = do
   gs <- getGameState
-  let events = translateEvents inputEvents
+  events <- processInput (window gs)
+  --when (events /= []) $ gameIO . putStrLn $ show events
   modifyGameState $ \gs ->
     gs
       { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs)
@@ -112,11 +114,11 @@ resize (ResizeEvent w h) =
       viewProjection = Matrix4.ortho left right bottom top (-1) 1
     }
 
-translateEvents = mapMaybe translateEvents'
-  where translateEvents' (KeyDown KEY_A) = Just MoveLeft
-        translateEvents' (KeyDown KEY_D) = Just MoveRight
-        translateEvents' (KeyUp KEY_A)   = Just StopLeft
-        translateEvents' (KeyUp KEY_D)   = Just StopRight
-        translateEvents' _               = Nothing
+
+processInput :: Window -> Game GameState [GameEvent]
+processInput window = processKeys window
+  [ (KEY_A, MoveLeft)
+  , (KEY_D, MoveRight)
+  ]
 
 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
 data GameEvent
   = MoveLeft
   | MoveRight
-  | StopLeft
-  | StopRight
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Show)
 
 -- Game objects
 
@@ -163,11 +161,10 @@ movePad = step $ \elapsed _ _ _ pad ->
 
 stepPlayer = sfold moveGO .> clamp
 
-moveGO =
-  mconcat
-    [ switch StopLeft  sid MoveLeft  (moveGO' $ vec2 (-playerSpeed) 0),
-      switch StopRight sid MoveRight (moveGO' $ vec2   playerSpeed  0)
-    ]
+moveGO = mconcat
+  [ swhen MoveLeft  $ moveGO' (vec2 (-playerSpeed) 0)
+  , swhen MoveRight $ moveGO' (vec2   playerSpeed  0)
+  ]
 
 moveGO' :: Vector2 -> Step s e GameObject GameObject
 moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir)