From 678a4631a36b55face6541c473d5dfb854225547 Mon Sep 17 00:00:00 2001 From: 3gg <3gg@shellblade.net> Date: Thu, 15 Aug 2024 22:49:21 -0700 Subject: Better event handling. --- Demos/Pong/Main.hs | 16 +++++++++------- Demos/Pong/Pong.hs | 13 +++++-------- 2 files changed, 14 insertions(+), 15 deletions(-) (limited to 'Demos/Pong') 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) -- cgit v1.2.3