Better Gamepad support handling connection/disconnection

2 files changed, 69 insertions, 58 deletions

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
diff --git a/src/Game/Utils.hs b/src/Game/Utils.hs
index e2b320a..d4dae94 100644
--- a/src/Game/Utils.hs
+++ b/src/Game/Utils.hs
@@ -1,30 +1,8 @@
-module Game.Utils (rect, isPressed, isPressedGamepad) where
+module Game.Utils (rect) where
 
 import Foreign.C.Types (CInt)
 import qualified SDL
-import qualified SDL.Input.GameController as SDL
 import SDL.Vect (V2 (..))
 
 rect :: Int -> Int -> Int -> Int -> SDL.Rectangle CInt
 rect x y w h = SDL.Rectangle (SDL.P $ V2 (fromIntegral x) (fromIntegral y)) (V2 (fromIntegral w) (fromIntegral h))
-
-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 :: SDL.ControllerButton -> [SDL.EventPayload] -> Maybe Bool
-isPressedGamepad 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
-    -- FIXME: may be don't hardcode it to joystick 0
-    isEventButton expected bu (SDL.ControllerButtonEvent (SDL.ControllerButtonEventData 0 b state)) = expected == state && bu == b
-    isEventButton _ _ _ = False