From d7a519f1aa04e489630c63318b200e89e164d280 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Sun, 5 Feb 2023 15:55:11 +0000
Subject: Basic gamepad support

---
 src/Game/Controller.hs | 51 +++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 44 insertions(+), 7 deletions(-)

(limited to 'src/Game/Controller.hs')

diff --git a/src/Game/Controller.hs b/src/Game/Controller.hs
index 3ec7e4c..ec1cdf3 100644
--- a/src/Game/Controller.hs
+++ b/src/Game/Controller.hs
@@ -1,8 +1,11 @@
 module Game.Controller (Controls (..), init, update) where
 
-import Data.Maybe (fromMaybe)
-import Game.Utils (isPressed)
+import Data.Maybe (fromMaybe, isNothing)
+import Data.Vector ((!?))
+import Game.Utils (isPressed, isPressedGamepad)
 import qualified SDL
+import qualified SDL.Input.GameController as SDL
+import qualified SDL.Raw
 import Prelude hiding (init)
 
 data Controls = Controls
@@ -12,15 +15,45 @@ data Controls = Controls
     cRight :: Bool,
     cA :: Bool,
     cB :: Bool,
-    cMenu :: Bool
+    cMenu :: Bool,
+    cJoy :: Maybe SDL.Raw.Joystick
   }
   deriving (Show)
 
-init :: Controls
-init = Controls False False False False False False False
+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
 
-update :: [SDL.EventPayload] -> Controls -> Controls
-update events controls =
+init :: IO Controls
+init = do
+  Controls False False False False False False False <$> getJoystick
+
+updateGamepad :: [SDL.EventPayload] -> Controls -> Controls
+updateGamepad events controls
+  | isNothing $ cJoy controls = controls
+  -- XXX: deal with disconnection/reconnection
+  | otherwise =
+      controls
+        { cUp = fromMaybe (cUp controls) $ isPressedGamepad SDL.ControllerButtonDpadUp events,
+          cDown = fromMaybe (cDown controls) $ isPressedGamepad SDL.ControllerButtonDpadDown events,
+          cLeft = fromMaybe (cLeft controls) $ isPressedGamepad SDL.ControllerButtonDpadLeft events,
+          cRight = fromMaybe (cRight controls) $ isPressedGamepad SDL.ControllerButtonDpadRight events,
+          cA = fromMaybe (cA controls) $ isPressedGamepad SDL.ControllerButtonA events,
+          cB = fromMaybe (cB controls) $ isPressedGamepad SDL.ControllerButtonB events,
+          cMenu = fromMaybe (cMenu controls) $ isPressedGamepad SDL.ControllerButtonStart events
+        }
+
+updateKeyboard :: [SDL.EventPayload] -> Controls -> Controls
+updateKeyboard events controls =
   controls
     { cUp = fromMaybe (cUp controls) $ isPressed SDL.KeycodeUp events,
       cDown = fromMaybe (cDown controls) $ isPressed SDL.KeycodeDown events,
@@ -30,3 +63,7 @@ update events controls =
       cB = fromMaybe (cB controls) $ isPressed SDL.KeycodeX events,
       cMenu = fromMaybe (cMenu controls) $ isPressed SDL.KeycodeReturn events
     }
+
+update :: [SDL.EventPayload] -> Controls -> Controls
+update events controls = do
+  updateGamepad events $ updateKeyboard events controls
-- 
cgit v1.2.3