diff --git a/ChangeLog.md b/ChangeLog.md index 0edb0fd..f8d2e6c 100644 --- a/ChangeLog.md +++ b/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 ======= diff --git a/src/SDL/Event.hs b/src/SDL/Event.hs index 100ffde..4d0cbf7 100644 --- a/src/SDL/Event.hs +++ b/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) diff --git a/src/SDL/Input/GameController.hs b/src/SDL/Input/GameController.hs index c99b5ea..7bd26f2 100644 --- a/src/SDL/Input/GameController.hs +++ b/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,12 +36,12 @@ module SDL.Input.GameController , 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) @@ -60,26 +67,61 @@ import qualified Data.Vector as V 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 @@ 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 @@ 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 @@ openController => 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 @@ controllerAttached (GameController c) = Raw.gameControllerGetAttached c See @@ 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 diff --git a/src/SDL/Raw/Event.hs b/src/SDL/Raw/Event.hs index 8736735..403e8dd 100644 --- a/src/SDL/Raw/Event.hs +++ b/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 #-}