{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module SDL.Input.Joystick
( numJoysticks
, availableJoysticks
, JoystickDevice(..)
, openJoystick
, closeJoystick
, getJoystickID
, Joystick
, JoyButtonState(..)
, buttonPressed
, ballDelta
, axisPosition
, numAxes
, numButtons
, numBalls
, JoyHatPosition(..)
, getHat
, numHats
, JoyDeviceConnection(..)
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Data (Data)
import Data.Int
import Data.Text (Text)
import Data.Traversable (for)
import Data.Typeable
import Data.Word
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Storable
import GHC.Generics (Generic)
import SDL.Vect
import SDL.Internal.Exception
import SDL.Internal.Numbered
import SDL.Internal.Types
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as Text
import qualified Data.Vector as V
import qualified SDL.Raw as Raw
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
data JoystickDevice = JoystickDevice
{ joystickDeviceName :: Text
, joystickDeviceId :: CInt
} deriving (Eq, Generic, Read, Ord, Show, Typeable)
data JoyButtonState = JoyButtonPressed | JoyButtonReleased
deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)
instance FromNumber JoyButtonState Word8 where
fromNumber n = case n of
Raw.SDL_PRESSED -> JoyButtonPressed
Raw.SDL_RELEASED -> JoyButtonReleased
_ -> JoyButtonReleased
numJoysticks :: MonadIO m => m (CInt)
numJoysticks = throwIfNeg "SDL.Input.Joystick.availableJoysticks" "SDL_NumJoysticks" Raw.numJoysticks
availableJoysticks :: MonadIO m => m (V.Vector JoystickDevice)
availableJoysticks = liftIO $ do
n <- numJoysticks
fmap (V.fromList) $
for [0 .. (n - 1)] $ \i -> do
cstr <-
throwIfNull "SDL.Input.Joystick.availableJoysticks" "SDL_JoystickNameForIndex" $
Raw.joystickNameForIndex i
name <- Text.decodeUtf8 <$> BS.packCString cstr
return (JoystickDevice name i)
openJoystick :: (Functor m,MonadIO m)
=> JoystickDevice
-> m Joystick
openJoystick (JoystickDevice _ x) =
fmap Joystick $
throwIfNull "SDL.Input.Joystick.openJoystick" "SDL_OpenJoystick" $
Raw.joystickOpen x
closeJoystick :: MonadIO m => Joystick -> m ()
closeJoystick (Joystick j) = Raw.joystickClose j
getJoystickID :: MonadIO m => Joystick -> m (Int32)
getJoystickID (Joystick j) =
throwIfNeg "SDL.Input.Joystick.getJoystickID" "SDL_JoystickInstanceID" $
Raw.joystickInstanceID j
buttonPressed :: (Functor m, MonadIO m)
=> Joystick
-> CInt
-> m Bool
buttonPressed (Joystick j) buttonIndex = (== 1) <$> Raw.joystickGetButton j buttonIndex
ballDelta :: MonadIO m
=> Joystick
-> CInt
-> m (V2 CInt)
ballDelta (Joystick j) ballIndex = liftIO $
alloca $ \xptr ->
alloca $ \yptr -> do
throwIfNeg_ "SDL.Input.Joystick.ballDelta" "SDL_JoystickGetBall" $
Raw.joystickGetBall j ballIndex xptr yptr
V2 <$> peek xptr <*> peek yptr
axisPosition :: MonadIO m => Joystick -> CInt -> m Int16
axisPosition (Joystick j) axisIndex = Raw.joystickGetAxis j axisIndex
numAxes :: (MonadIO m) => Joystick -> m CInt
numAxes (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numAxis" "SDL_JoystickNumAxes" (Raw.joystickNumAxes j)
numButtons :: (MonadIO m) => Joystick -> m CInt
numButtons (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numButtons" "SDL_JoystickNumButtons" (Raw.joystickNumButtons j)
numBalls :: (MonadIO m) => Joystick -> m CInt
numBalls (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numBalls" "SDL_JoystickNumBalls" (Raw.joystickNumBalls j)
data JoyHatPosition
= HatCentered
| HatUp
| HatRight
| HatDown
| HatLeft
| HatRightUp
| HatRightDown
| HatLeftUp
| HatLeftDown
deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)
instance FromNumber JoyHatPosition Word8 where
fromNumber n = case n of
Raw.SDL_HAT_CENTERED -> HatCentered
Raw.SDL_HAT_UP -> HatUp
Raw.SDL_HAT_RIGHT -> HatRight
Raw.SDL_HAT_DOWN -> HatDown
Raw.SDL_HAT_LEFT -> HatLeft
Raw.SDL_HAT_RIGHTUP -> HatRightUp
Raw.SDL_HAT_RIGHTDOWN -> HatRightDown
Raw.SDL_HAT_LEFTUP -> HatLeftUp
Raw.SDL_HAT_LEFTDOWN -> HatLeftDown
_ -> HatCentered
getHat :: (Functor m, MonadIO m)
=> Joystick
-> CInt
-> m JoyHatPosition
getHat (Joystick j) hatIndex = fromNumber <$> Raw.joystickGetHat j hatIndex
numHats :: (MonadIO m) => Joystick -> m CInt
numHats (Joystick j) = liftIO $ throwIfNeg "SDL.Input.Joystick.numHats" "SDL_JoystickNumHats" (Raw.joystickNumHats j)
data JoyDeviceConnection = JoyDeviceAdded | JoyDeviceRemoved
deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)
instance FromNumber JoyDeviceConnection Word32 where
fromNumber n = case n of
Raw.SDL_JOYDEVICEADDED -> JoyDeviceAdded
Raw.SDL_JOYDEVICEREMOVED -> JoyDeviceRemoved
_ -> JoyDeviceAdded