{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module SDL.Input.Joystick
( numJoysticks
, availableJoysticks
, JoystickDevice(..)
, openJoystick
, closeJoystick
, getJoystickID
, Joystick
, buttonPressed
, ballDelta
, axisPosition
, numAxes
, numButtons
, numBalls
, JoyHatPosition(..)
, getHat
, numHats
) 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)
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)