feat: expand game controller bindings

ChangeLog.md

@@ -1,6 +1,12 @@
 2.5.X.Y
 =======
 
+* Added game controller helper functions: `isGameController`, `mkControllerDevice`, `mkControllerDevice'`, `controllerFromInstanceID`
+* Added raw bindings for player index, LED control, rumble triggers, and touchpad query functions
+* Added `JoystickIndex` type alias for clarity
+* `getControllerID` now returns `Raw.JoystickID` for improved type documentation
+* Fixed `controllerDeviceEventWhich` documentation to clarify index vs instance ID semantics
+
 2.5.5.1
 =======
 

src/SDL/Event.hs

@@ -428,7 +428,7 @@ data ControllerDeviceEventData =
   ControllerDeviceEventData {controllerDeviceEventConnection :: !ControllerDeviceConnection
                              -- ^ Was the device added, removed, or remapped?
                             ,controllerDeviceEventWhich :: !Raw.JoystickID
-                             -- ^ The joystick instance ID that reported the event.
+                             -- ^ The joystick device index for the ADDED event, instance id for the REMOVED or REMAPPED event
                             }
   deriving (Eq,Ord,Generic,Show,Typeable)
 

src/SDL/Input/GameController.hs

@@ -7,8 +7,15 @@
 
 module SDL.Input.GameController
   ( ControllerDevice (..)
+  , GameController
+  , JoystickIndex
+  , Raw.JoystickID
+
+  , isGameController
+  , mkControllerDevice
+  , mkControllerDevice'
+  , controllerFromInstanceID
   , availableControllers
-
   , openController
   , closeController
   , controllerAttached
@@ -29,27 +36,27 @@
   , ControllerDeviceConnection (..)
   ) where
 
-import Control.Monad (filterM)
+import Control.Monad (guard)
 import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Trans.Maybe (runMaybeT)
 import Data.Data (Data)
 import Data.Int
 import Data.Text (Text)
-import Data.Traversable (for)
 import Data.Typeable
 import Data.Word
 import Foreign.C (withCString)
 import Foreign.C.Types
 import Foreign.ForeignPtr
 import Foreign.Marshal.Alloc
 import Foreign.Ptr
 import Foreign.Storable
 import GHC.Generics (Generic)
 import GHC.Int (Int32)
 import SDL.Input.Joystick (numJoysticks)
 import SDL.Internal.Exception
 import SDL.Internal.Numbered
 import SDL.Internal.Types
 import SDL.Vect
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Internal as BSI
 import qualified SDL.Raw as Raw
@@ -60,26 +67,61 @@
 import Control.Applicative
 #endif
 
+type JoystickIndex = CInt
+
 {- | A description of game controller that can be opened using 'openController'.
  To retrieve a list of connected game controllers, use 'availableControllers'.
 -}
 data ControllerDevice = ControllerDevice
   { gameControllerDeviceName :: Text
-  , gameControllerDeviceId :: CInt
+  , gameControllerDeviceId :: JoystickIndex
   }
   deriving (Eq, Generic, Read, Ord, Show, Typeable)
 
+
+{- | Check if the given joystick is supported by the game controller interface.
+
+ See @<https://wiki.libsdl.org/SDL2/SDL_IsGameController SDL_IsGameController>@ for C documentation.
+-}
+isGameController :: MonadIO m => JoystickIndex -> m Bool
+isGameController = Raw.isGameController
+
+{- | Create a 'ControllerDevice' from a 'JoystickIndex'. Returns 'Nothing' if 
+     the 'JoystickIndex' does not support the game controller interface.
+-}
+mkControllerDevice :: MonadIO m => JoystickIndex -> m (Maybe ControllerDevice)
+mkControllerDevice i = runMaybeT $ do
+  isGC <- isGameController i
+  guard isGC
+  mkControllerDevice' i
+
+{- | Create a 'ControllerDevice' from a 'JoystickIndex'. Does not check whether
+     the 'JoystickIndex' supports the game controller interface.
+-}
+mkControllerDevice' :: MonadIO m => JoystickIndex -> m ControllerDevice
+mkControllerDevice' i = do
+  cstr <- liftIO $
+    throwIfNull "SDL.Input.GameController.mkControllerDevice'" "SDL_GameControllerNameForIndex" $
+      Raw.gameControllerNameForIndex (fromIntegral i)
+  name <- liftIO $ Text.decodeUtf8 <$> BS.packCString cstr
+  return (ControllerDevice name i)
+
+{- | Get the 'GameController' associated with a 'Raw.JoystickID'.
+
+ See @<https://wiki.libsdl.org/SDL2/SDL_GameControllerFromInstanceID SDL_GameControllerFromInstanceID>@ for C documentation.
+-}
+controllerFromInstanceID :: MonadIO m => Raw.JoystickID -> m GameController
+controllerFromInstanceID i =
+  fmap GameController $
+    throwIfNull "SDL.Input.GameController.controllerFromInstanceID" "SDL_GameControllerFromInstanceID" $
+      Raw.gameControllerFromInstanceID (fromIntegral i)
+
+
 -- | Enumerate all connected Controllers, retrieving a description of each.
 availableControllers :: MonadIO m => m (V.Vector ControllerDevice)
 availableControllers = liftIO $ do
-  n <- numJoysticks
-  indices <- filterM Raw.isGameController [0 .. (n - 1)]
-  fmap V.fromList $ for indices $ \i -> do
-    cstr <-
-      throwIfNull "SDL.Input.Controller.availableGameControllers" "SDL_GameControllerNameForIndex" $
-        Raw.gameControllerNameForIndex i
-    name <- Text.decodeUtf8 <$> BS.packCString cstr
-    return (ControllerDevice name i)
+  n <- fromIntegral <$> numJoysticks
+  V.catMaybes <$> V.generateM n (mkControllerDevice . fromIntegral)
 
 {- | Open a controller so that you can start receiving events from interaction with this controller.
 
@@ -90,10 +132,10 @@
   => ControllerDevice
   -- ^ The device to open. Use 'availableControllers' to find 'JoystickDevices's
   -> m GameController
-openController (ControllerDevice _ x) =
+openController (ControllerDevice _ i) =
   fmap GameController $
     throwIfNull "SDL.Input.GameController.openController" "SDL_GameControllerOpen" $
-      Raw.gameControllerOpen x
+      Raw.gameControllerOpen (fromIntegral i)
 
 {- | Close a controller previously opened with 'openController'.
 
@@ -114,7 +156,7 @@
 
  See @<https://wiki.libsdl.org/SDL2/SDL_GameControllerInstanceID SDL_GameControllerInstanceID>@ for C documentation.
 -}
-getControllerID :: MonadIO m => GameController -> m Int32
+getControllerID :: MonadIO m => GameController -> m Raw.JoystickID
 getControllerID (GameController c) =
   throwIfNeg "SDL.Input.GameController.getControllerID" "SDL_JoystickInstanceID" $
     Raw.joystickInstanceID c

src/SDL/Raw/Event.hs

@@ -96,6 +96,7 @@ module SDL.Raw.Event (
   gameControllerClose,
   gameControllerEventState,
   gameControllerFromInstanceID,
+  gameControllerFromPlayerIndex,
   gameControllerGetAttached,
   gameControllerGetAxis,
   gameControllerGetAxisFromString,
@@ -104,6 +105,12 @@ module SDL.Raw.Event (
   gameControllerGetButton,
   gameControllerGetButtonFromString,
   gameControllerGetJoystick,
+  gameControllerGetNumTouchpadFingers,
+  gameControllerGetNumTouchpads,
+  gameControllerGetPlayerIndex,
+  gameControllerHasLED,
+  gameControllerHasRumble,
+  gameControllerHasRumbleTriggers,
   gameControllerGetStringForAxis,
   gameControllerGetStringForButton,
   gameControllerMapping,
@@ -113,6 +120,9 @@ module SDL.Raw.Event (
   gameControllerOpen,
   gameControllerUpdate,
   gameControllerRumble,
+  gameControllerRumbleTriggers,
+  gameControllerSetLED,
+  gameControllerSetPlayerIndex,
   isGameController,
   eventBuffer,
   eventBufferSize
@@ -220,6 +230,7 @@ foreign import ccall "SDL.h SDL_GameControllerAddMappingsFromRW" gameControllerA
 foreign import ccall "SDL.h SDL_GameControllerClose" gameControllerCloseFFI :: GameController -> IO ()
 foreign import ccall "SDL.h SDL_GameControllerEventState" gameControllerEventStateFFI :: CInt -> IO CInt
 foreign import ccall "SDL.h SDL_GameControllerFromInstanceID" gameControllerFromInstanceIDFFI :: JoystickID -> IO GameController
+foreign import ccall "SDL.h SDL_GameControllerFromPlayerIndex" gameControllerFromPlayerIndexFFI :: CInt -> IO GameController
 foreign import ccall "SDL.h SDL_GameControllerGetAttached" gameControllerGetAttachedFFI :: GameController -> IO Bool
 foreign import ccall "SDL.h SDL_GameControllerGetAxis" gameControllerGetAxisFFI :: GameController -> GameControllerAxis -> IO Int16
 foreign import ccall "SDL.h SDL_GameControllerGetAxisFromString" gameControllerGetAxisFromStringFFI :: CString -> IO GameControllerAxis
@@ -228,6 +239,12 @@ foreign import ccall "sdlhelper.h SDLHelper_GameControllerGetBindForButton" game
 foreign import ccall "SDL.h SDL_GameControllerGetButton" gameControllerGetButtonFFI :: GameController -> GameControllerButton -> IO Word8
 foreign import ccall "SDL.h SDL_GameControllerGetButtonFromString" gameControllerGetButtonFromStringFFI :: CString -> IO GameControllerButton
 foreign import ccall "SDL.h SDL_GameControllerGetJoystick" gameControllerGetJoystickFFI :: GameController -> IO Joystick
+foreign import ccall "SDL.h SDL_GameControllerGetNumTouchpadFingers" gameControllerGetNumTouchpadFingersFFI :: GameController -> CInt -> IO CInt
+foreign import ccall "SDL.h SDL_GameControllerGetNumTouchpads" gameControllerGetNumTouchpadsFFI :: GameController -> IO CInt
+foreign import ccall "SDL.h SDL_GameControllerGetPlayerIndex" gameControllerGetPlayerIndexFFI :: GameController -> IO CInt
+foreign import ccall "SDL.h SDL_GameControllerHasLED" gameControllerHasLEDFFI :: GameController -> IO Bool
+foreign import ccall "SDL.h SDL_GameControllerHasRumble" gameControllerHasRumbleFFI :: GameController -> IO Bool
+foreign import ccall "SDL.h SDL_GameControllerHasRumbleTriggers" gameControllerHasRumbleTriggersFFI :: GameController -> IO Bool
 foreign import ccall "SDL.h SDL_GameControllerGetStringForAxis" gameControllerGetStringForAxisFFI :: GameControllerAxis -> IO CString
 foreign import ccall "SDL.h SDL_GameControllerGetStringForButton" gameControllerGetStringForButtonFFI :: GameControllerButton -> IO CString
 foreign import ccall "SDL.h SDL_GameControllerMapping" gameControllerMappingFFI :: GameController -> IO CString
@@ -237,6 +254,9 @@ foreign import ccall "SDL.h SDL_GameControllerNameForIndex" gameControllerNameFo
 foreign import ccall "SDL.h SDL_GameControllerOpen" gameControllerOpenFFI :: CInt -> IO GameController
 foreign import ccall "SDL.h SDL_GameControllerUpdate" gameControllerUpdateFFI :: IO ()
 foreign import ccall "SDL.h SDL_GameControllerRumble" gameControllerRumbleFFI :: GameController -> CUShort -> CUShort -> CUInt -> IO CInt
+foreign import ccall "SDL.h SDL_GameControllerRumbleTriggers" gameControllerRumbleTriggersFFI :: GameController -> CUShort -> CUShort -> CUInt -> IO CInt
+foreign import ccall "SDL.h SDL_GameControllerSetLED" gameControllerSetLEDFFI :: GameController -> Word8 -> Word8 -> Word8 -> IO CInt
+foreign import ccall "SDL.h SDL_GameControllerSetPlayerIndex" gameControllerSetPlayerIndexFFI :: GameController -> CInt -> IO ()
 foreign import ccall "SDL.h SDL_IsGameController" isGameControllerFFI :: CInt -> IO Bool
 
 foreign import ccall "sdlhelper.c SDLHelper_GetEventBufferSize" eventBufferSize :: CInt
@@ -607,6 +627,10 @@ gameControllerFromInstanceID :: MonadIO m => JoystickID -> m GameController
 gameControllerFromInstanceID v1 = liftIO $ gameControllerFromInstanceIDFFI v1
 {-# INLINE gameControllerFromInstanceID #-}
 
+gameControllerFromPlayerIndex :: MonadIO m => CInt -> m GameController
+gameControllerFromPlayerIndex v1 = liftIO $ gameControllerFromPlayerIndexFFI v1
+{-# INLINE gameControllerFromPlayerIndex #-}
+
 gameControllerGetAttached :: MonadIO m => GameController -> m Bool
 gameControllerGetAttached v1 = liftIO $ gameControllerGetAttachedFFI v1
 {-# INLINE gameControllerGetAttached #-}
@@ -643,6 +667,31 @@ gameControllerGetJoystick :: MonadIO m => GameController -> m Joystick
 gameControllerGetJoystick v1 = liftIO $ gameControllerGetJoystickFFI v1
 {-# INLINE gameControllerGetJoystick #-}
 
+gameControllerGetNumTouchpadFingers :: MonadIO m => GameController -> CInt -> m CInt
+gameControllerGetNumTouchpadFingers gamecontroller touchpad =
+  liftIO $ gameControllerGetNumTouchpadFingersFFI gamecontroller touchpad
+{-# INLINE gameControllerGetNumTouchpadFingers #-}
+
+gameControllerGetNumTouchpads :: MonadIO m => GameController -> m CInt
+gameControllerGetNumTouchpads gamecontroller = liftIO $ gameControllerGetNumTouchpadsFFI gamecontroller
+{-# INLINE gameControllerGetNumTouchpads #-}
+
+gameControllerGetPlayerIndex :: MonadIO m => GameController -> m CInt
+gameControllerGetPlayerIndex gamecontroller = liftIO $ gameControllerGetPlayerIndexFFI gamecontroller
+{-# INLINE gameControllerGetPlayerIndex #-}
+
+gameControllerHasLED :: MonadIO m => GameController -> m Bool
+gameControllerHasLED gamecontroller = liftIO $ gameControllerHasLEDFFI gamecontroller
+{-# INLINE gameControllerHasLED #-}
+
+gameControllerHasRumble :: MonadIO m => GameController -> m Bool
+gameControllerHasRumble gamecontroller = liftIO $ gameControllerHasRumbleFFI gamecontroller
+{-# INLINE gameControllerHasRumble #-}
+
+gameControllerHasRumbleTriggers :: MonadIO m => GameController -> m Bool
+gameControllerHasRumbleTriggers gamecontroller = liftIO $ gameControllerHasRumbleTriggersFFI gamecontroller
+{-# INLINE gameControllerHasRumbleTriggers #-}
+
 gameControllerGetStringForAxis :: MonadIO m => GameControllerAxis -> m CString
 gameControllerGetStringForAxis v1 = liftIO $ gameControllerGetStringForAxisFFI v1
 {-# INLINE gameControllerGetStringForAxis #-}
@@ -681,6 +730,18 @@ gameControllerRumble :: MonadIO m => GameController -> CUShort -> CUShort -> CUI
 gameControllerRumble v1 v2 v3 v4 = liftIO $ gameControllerRumbleFFI v1 v2 v3 v4
 {-# INLINE gameControllerRumble #-}
 
+gameControllerRumbleTriggers :: MonadIO m => GameController -> CUShort -> CUShort -> CUInt -> m CInt
+gameControllerRumbleTriggers gamecontroller v1 v2 v3 = liftIO $ gameControllerRumbleTriggersFFI gamecontroller v1 v2 v3
+{-# INLINE gameControllerRumbleTriggers #-}
+
+gameControllerSetLED :: MonadIO m => GameController -> Word8 -> Word8 -> Word8 -> m CInt
+gameControllerSetLED gamecontroller v1 v2 v3 = liftIO $ gameControllerSetLEDFFI gamecontroller v1 v2 v3
+{-# INLINE gameControllerSetLED #-}
+
+gameControllerSetPlayerIndex :: MonadIO m => GameController -> CInt -> m ()
+gameControllerSetPlayerIndex gamecontroller v1 = liftIO $ gameControllerSetPlayerIndexFFI gamecontroller v1
+{-# INLINE gameControllerSetPlayerIndex #-}
+
 isGameController :: MonadIO m => CInt -> m Bool
 isGameController v1 = liftIO $ isGameControllerFFI v1
 {-# INLINE isGameController #-}