From b9353d40500dc27812a435d115fe9eaaed8a7cdc Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Fri, 3 Mar 2023 21:57:13 +0000 Subject: Better Gamepad support handling connection/disconnection --- src/Game/Controller.hs | 103 ++++++++++++++++++++++++++++++++----------------- 1 file changed, 68 insertions(+), 35 deletions(-) (limited to 'src/Game/Controller.hs') diff --git a/src/Game/Controller.hs b/src/Game/Controller.hs index 77039ac..47698f9 100644 --- a/src/Game/Controller.hs +++ b/src/Game/Controller.hs @@ -1,8 +1,9 @@ -module Game.Controller (Controls (..), init, update) where +module Game.Controller (Controls (..), init, update, isPressed) where -import Data.Maybe (fromMaybe, isJust, isNothing) -import Data.Vector ((!?)) -import Game.Utils (isPressed, isPressedGamepad) +import Control.Monad +import Data.Int (Int32) +import Data.Maybe (fromMaybe, isNothing) +import Foreign.C (peekCAString) import qualified SDL import qualified SDL.Input.GameController as SDL import qualified SDL.Raw @@ -16,40 +17,48 @@ data Controls = Controls a :: Bool, b :: Bool, menu :: Bool, - joy :: Maybe SDL.Raw.Joystick + joyId :: Maybe Int32, + gc :: Maybe SDL.Raw.GameController } deriving (Show) -getJoystick :: IO (Maybe SDL.Raw.Joystick) -getJoystick = do - joys <- SDL.availableJoysticks - case joys !? 0 of - Nothing -> pure Nothing - Just x -> - Just <$> do - -- XXX: are we sure this is a gamepad? - putStrLn ("gamepad: " ++ show x) - let joyId = SDL.joystickDeviceId x - g <- SDL.Raw.gameControllerOpen joyId - SDL.Raw.gameControllerGetJoystick g +processControllerEvents :: Controls -> [SDL.EventPayload] -> IO Controls +processControllerEvents controls (SDL.ControllerDeviceEvent (SDL.ControllerDeviceEventData SDL.ControllerDeviceAdded joyId) : t) = do + if isNothing controls.joyId + then do + joyName <- peekCAString =<< SDL.Raw.gameControllerNameForIndex (fromIntegral joyId) + putStrLn $ "Connected gamepad: " ++ show joyName + gc <- SDL.Raw.gameControllerOpen (fromIntegral joyId) + processControllerEvents controls {joyId = Just joyId, gc = Just gc} t + else processControllerEvents controls t +processControllerEvents controls (SDL.ControllerDeviceEvent (SDL.ControllerDeviceEventData SDL.ControllerDeviceRemoved joyId) : t) = do + c <- + if Just joyId == controls.joyId + then do + forM_ (controls.gc) SDL.Raw.gameControllerClose + putStrLn "Disconnected gamepad" + pure controls {joyId = Nothing, gc = Nothing} + else pure controls + processControllerEvents c t +processControllerEvents controls (_ : t) = processControllerEvents controls t +processControllerEvents controls [] = pure controls -init :: IO Controls -init = do - Controls False False False False False False False <$> getJoystick +init :: Controls +init = Controls False False False False False False False Nothing Nothing updateGamepad :: Controls -> [SDL.EventPayload] -> Controls -updateGamepad controls events - | isNothing $ controls.joy = controls - -- XXX: deal with disconnection/reconnection - | otherwise = +updateGamepad controls events = + case controls.joyId of + Nothing -> controls + Just joyId -> controls - { up = fromMaybe controls.up $ isPressedGamepad SDL.ControllerButtonDpadUp events, - down = fromMaybe controls.down $ isPressedGamepad SDL.ControllerButtonDpadDown events, - left = fromMaybe controls.left $ isPressedGamepad SDL.ControllerButtonDpadLeft events, - right = fromMaybe controls.right $ isPressedGamepad SDL.ControllerButtonDpadRight events, - a = fromMaybe False $ isPressedGamepad SDL.ControllerButtonA events, - b = fromMaybe False $ isPressedGamepad SDL.ControllerButtonB events, - menu = fromMaybe False $ isPressedGamepad SDL.ControllerButtonStart events + { up = fromMaybe controls.up $ isPressedGamepad joyId SDL.ControllerButtonDpadUp events, + down = fromMaybe controls.down $ isPressedGamepad joyId SDL.ControllerButtonDpadDown events, + left = fromMaybe controls.left $ isPressedGamepad joyId SDL.ControllerButtonDpadLeft events, + right = fromMaybe controls.right $ isPressedGamepad joyId SDL.ControllerButtonDpadRight events, + a = fromMaybe False $ isPressedGamepad joyId SDL.ControllerButtonA events, + b = fromMaybe False $ isPressedGamepad joyId SDL.ControllerButtonB events, + menu = fromMaybe False $ isPressedGamepad joyId SDL.ControllerButtonStart events } updateKeyboard :: Controls -> [SDL.EventPayload] -> Controls @@ -64,7 +73,31 @@ updateKeyboard controls events = menu = fromMaybe False $ isPressed SDL.KeycodeReturn events } -update :: Controls -> [SDL.EventPayload] -> Controls -update controls - | isJust controls.joy = updateGamepad controls - | otherwise = updateKeyboard controls +update :: Controls -> [SDL.EventPayload] -> IO Controls +update controls events = do + updated <- processControllerEvents controls events + pure $ case updated.joyId of + Just _ -> updateGamepad updated events + _ -> updateKeyboard updated events + +isPressed :: SDL.Keycode -> [SDL.EventPayload] -> Maybe Bool +isPressed code events + | any (isEventKey SDL.Pressed code) events = Just True + | any (isEventKey SDL.Released code) events = Just False + | otherwise = Nothing + where + isEventKey :: SDL.InputMotion -> SDL.Keycode -> SDL.EventPayload -> Bool + isEventKey expected keycode (SDL.KeyboardEvent (SDL.KeyboardEventData _ motion False ksym)) = expected == motion && SDL.keysymKeycode ksym == keycode + isEventKey _ _ _ = False + +isPressedGamepad :: Int32 -> SDL.ControllerButton -> [SDL.EventPayload] -> Maybe Bool +isPressedGamepad joyId button events + | any (isEventButton SDL.ControllerButtonPressed button) events = Just True + | any (isEventButton SDL.ControllerButtonReleased button) events = Just False + | otherwise = Nothing + where + isEventButton :: SDL.ControllerButtonState -> SDL.ControllerButton -> SDL.EventPayload -> Bool + isEventButton expected bu (SDL.ControllerButtonEvent (SDL.ControllerButtonEventData i b state)) + | i == joyId = expected == state && bu == b + | otherwise = False + isEventButton _ _ _ = False -- cgit v1.2.3