module Graphics.UI.SDL.Joystick
( countAvailable
, tryName
, name
, tryOpen
, open
, opened
, index
, axesAvailable
, ballsAvailable
, hatsAvailable
, buttonsAvailable
, update
, getAxis
, getHat
, getButton
, getBall
, close
) where
import Foreign (Int16, Word8, Ptr, FunPtr, Storable(peek),
finalizeForeignPtr, toBool, maybePeek, alloca, withForeignPtr, newForeignPtr)
import Foreign.C (peekCString, CString)
import System.IO.Unsafe (unsafePerformIO)
import Graphics.UI.SDL.General (unwrapMaybe)
import Graphics.UI.SDL.Utilities (fromBitmask)
import Graphics.UI.SDL.Types (Hat, Joystick, JoystickStruct)
type JoystickIndex = Int
foreign import ccall unsafe "SDL_NumJoysticks" countAvailable :: IO Int
foreign import ccall unsafe "SDL_JoystickName" sdlJoystickName :: JoystickIndex -> IO CString
tryName :: JoystickIndex -> IO (Maybe String)
tryName idx = sdlJoystickName idx >>= maybePeek peekCString
name :: JoystickIndex -> IO String
name = unwrapMaybe "SDL_JoystickName" . tryName
foreign import ccall unsafe "SDL_JoystickOpen" sdlJoystickOpen :: JoystickIndex -> IO (Ptr JoystickStruct)
tryOpen :: JoystickIndex -> IO (Maybe Joystick)
tryOpen idx = sdlJoystickOpen idx >>= maybePeek mkFinalizedJoystick
open :: JoystickIndex -> IO Joystick
open = unwrapMaybe "SDL_JoystickOpen" . tryOpen
foreign import ccall unsafe "SDL_JoystickOpened" sdlJoystickOpened :: JoystickIndex -> IO Int
opened :: JoystickIndex -> IO Bool
opened = fmap toBool . sdlJoystickOpened
foreign import ccall unsafe "SDL_JoystickIndex" sdlJoystickIndex :: Ptr JoystickStruct -> JoystickIndex
index :: Joystick -> JoystickIndex
index joystick
= unsafePerformIO $
withForeignPtr joystick $
return . sdlJoystickIndex
foreign import ccall unsafe "SDL_JoystickNumAxes" sdlJoystickNumAxes :: Ptr JoystickStruct -> Int
axesAvailable :: Joystick -> Int
axesAvailable joystick
= unsafePerformIO $
withForeignPtr joystick $
return . sdlJoystickNumAxes
foreign import ccall unsafe "SDL_JoystickNumBalls" sdlJoystickNumBalls :: Ptr JoystickStruct -> Int
ballsAvailable :: Joystick -> Int
ballsAvailable joystick
= unsafePerformIO $
withForeignPtr joystick $
return . sdlJoystickNumBalls
foreign import ccall unsafe "SDL_JoystickNumHats" sdlJoystickNumHats :: Ptr JoystickStruct -> Int
hatsAvailable :: Joystick -> Int
hatsAvailable joystick
= unsafePerformIO $
withForeignPtr joystick $
return . sdlJoystickNumHats
foreign import ccall unsafe "SDL_JoystickNumButtons" sdlJoystickNumButtons :: Ptr JoystickStruct -> Int
buttonsAvailable :: Joystick -> Int
buttonsAvailable joystick
= unsafePerformIO $
withForeignPtr joystick $
return . sdlJoystickNumButtons
foreign import ccall unsafe "SDL_JoystickUpdate" update :: IO ()
foreign import ccall unsafe "SDL_JoystickGetAxis" joystickGetAxis :: Ptr JoystickStruct -> Int -> IO Int16
getAxis :: Joystick -> Word8 -> IO Int16
getAxis joystick axis
= withForeignPtr joystick $ \ptr ->
joystickGetAxis ptr (fromIntegral axis)
foreign import ccall unsafe "SDL_JoystickGetHat" joystickGetHat :: Ptr JoystickStruct -> Int -> IO Word8
getHat :: Joystick -> Word8 -> IO [Hat]
getHat joystick axis
= withForeignPtr joystick $ \ptr ->
fmap (fromBitmask.fromIntegral) (joystickGetHat ptr (fromIntegral axis))
foreign import ccall unsafe "SDL_JoystickGetButton" joystickGetButton :: Ptr JoystickStruct -> Int -> IO Word8
getButton :: Joystick -> Word8 -> IO Bool
getButton joystick button
= withForeignPtr joystick $ \ptr ->
fmap toBool (joystickGetButton ptr (fromIntegral button))
foreign import ccall unsafe "SDL_JoystickGetBall" joystickGetBall
:: Ptr JoystickStruct -> Int -> Ptr Int -> Ptr Int -> IO Int
getBall :: Joystick -> Word8 -> IO (Maybe (Int16,Int16))
getBall joystick ball
= withForeignPtr joystick $ \ptr ->
alloca $ \xrelPtr ->
alloca $ \yrelPtr ->
do ret <- joystickGetBall ptr (fromIntegral ball) xrelPtr yrelPtr
case ret of
0 -> do [xrel,yrel] <- mapM (fmap fromIntegral . peek) [xrelPtr,yrelPtr]
return $! Just (xrel,yrel)
_ -> return Nothing
close :: Joystick -> IO ()
close =
finalizeForeignPtr
foreign import ccall unsafe "&SDL_JoystickClose" sdlCloseJoystickFinal :: FunPtr (Ptr JoystickStruct -> IO ())
mkFinalizedJoystick :: Ptr JoystickStruct -> IO Joystick
mkFinalizedJoystick = newForeignPtr sdlCloseJoystickFinal