{-# 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

-- | A description of joystick that can be opened using 'openJoystick'. To retrieve a list of
-- connected joysticks, use 'availableJoysticks'.
data JoystickDevice = JoystickDevice
  { JoystickDevice -> Text
joystickDeviceName :: Text
  , JoystickDevice -> CInt
joystickDeviceId :: CInt
  } deriving (JoystickDevice -> JoystickDevice -> Bool
(JoystickDevice -> JoystickDevice -> Bool)
-> (JoystickDevice -> JoystickDevice -> Bool) -> Eq JoystickDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoystickDevice -> JoystickDevice -> Bool
== :: JoystickDevice -> JoystickDevice -> Bool
$c/= :: JoystickDevice -> JoystickDevice -> Bool
/= :: JoystickDevice -> JoystickDevice -> Bool
Eq, (forall x. JoystickDevice -> Rep JoystickDevice x)
-> (forall x. Rep JoystickDevice x -> JoystickDevice)
-> Generic JoystickDevice
forall x. Rep JoystickDevice x -> JoystickDevice
forall x. JoystickDevice -> Rep JoystickDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoystickDevice -> Rep JoystickDevice x
from :: forall x. JoystickDevice -> Rep JoystickDevice x
$cto :: forall x. Rep JoystickDevice x -> JoystickDevice
to :: forall x. Rep JoystickDevice x -> JoystickDevice
Generic, ReadPrec [JoystickDevice]
ReadPrec JoystickDevice
Int -> ReadS JoystickDevice
ReadS [JoystickDevice]
(Int -> ReadS JoystickDevice)
-> ReadS [JoystickDevice]
-> ReadPrec JoystickDevice
-> ReadPrec [JoystickDevice]
-> Read JoystickDevice
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS JoystickDevice
readsPrec :: Int -> ReadS JoystickDevice
$creadList :: ReadS [JoystickDevice]
readList :: ReadS [JoystickDevice]
$creadPrec :: ReadPrec JoystickDevice
readPrec :: ReadPrec JoystickDevice
$creadListPrec :: ReadPrec [JoystickDevice]
readListPrec :: ReadPrec [JoystickDevice]
Read, Eq JoystickDevice
Eq JoystickDevice
-> (JoystickDevice -> JoystickDevice -> Ordering)
-> (JoystickDevice -> JoystickDevice -> Bool)
-> (JoystickDevice -> JoystickDevice -> Bool)
-> (JoystickDevice -> JoystickDevice -> Bool)
-> (JoystickDevice -> JoystickDevice -> Bool)
-> (JoystickDevice -> JoystickDevice -> JoystickDevice)
-> (JoystickDevice -> JoystickDevice -> JoystickDevice)
-> Ord JoystickDevice
JoystickDevice -> JoystickDevice -> Bool
JoystickDevice -> JoystickDevice -> Ordering
JoystickDevice -> JoystickDevice -> JoystickDevice
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoystickDevice -> JoystickDevice -> Ordering
compare :: JoystickDevice -> JoystickDevice -> Ordering
$c< :: JoystickDevice -> JoystickDevice -> Bool
< :: JoystickDevice -> JoystickDevice -> Bool
$c<= :: JoystickDevice -> JoystickDevice -> Bool
<= :: JoystickDevice -> JoystickDevice -> Bool
$c> :: JoystickDevice -> JoystickDevice -> Bool
> :: JoystickDevice -> JoystickDevice -> Bool
$c>= :: JoystickDevice -> JoystickDevice -> Bool
>= :: JoystickDevice -> JoystickDevice -> Bool
$cmax :: JoystickDevice -> JoystickDevice -> JoystickDevice
max :: JoystickDevice -> JoystickDevice -> JoystickDevice
$cmin :: JoystickDevice -> JoystickDevice -> JoystickDevice
min :: JoystickDevice -> JoystickDevice -> JoystickDevice
Ord, Int -> JoystickDevice -> ShowS
[JoystickDevice] -> ShowS
JoystickDevice -> String
(Int -> JoystickDevice -> ShowS)
-> (JoystickDevice -> String)
-> ([JoystickDevice] -> ShowS)
-> Show JoystickDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoystickDevice -> ShowS
showsPrec :: Int -> JoystickDevice -> ShowS
$cshow :: JoystickDevice -> String
show :: JoystickDevice -> String
$cshowList :: [JoystickDevice] -> ShowS
showList :: [JoystickDevice] -> ShowS
Show, Typeable)

-- | Identifies the state of a joystick button.
data JoyButtonState = JoyButtonPressed | JoyButtonReleased
  deriving (Typeable JoyButtonState
Typeable JoyButtonState
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JoyButtonState -> c JoyButtonState)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoyButtonState)
-> (JoyButtonState -> Constr)
-> (JoyButtonState -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoyButtonState))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoyButtonState))
-> ((forall b. Data b => b -> b)
    -> JoyButtonState -> JoyButtonState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoyButtonState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoyButtonState -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> JoyButtonState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoyButtonState -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> JoyButtonState -> m JoyButtonState)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoyButtonState -> m JoyButtonState)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoyButtonState -> m JoyButtonState)
-> Data JoyButtonState
JoyButtonState -> Constr
JoyButtonState -> DataType
(forall b. Data b => b -> b) -> JoyButtonState -> JoyButtonState
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> JoyButtonState -> u
forall u. (forall d. Data d => d -> u) -> JoyButtonState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyButtonState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyButtonState -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyButtonState -> m JoyButtonState
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyButtonState -> m JoyButtonState
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyButtonState
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoyButtonState -> c JoyButtonState
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyButtonState)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyButtonState)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoyButtonState -> c JoyButtonState
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoyButtonState -> c JoyButtonState
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyButtonState
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyButtonState
$ctoConstr :: JoyButtonState -> Constr
toConstr :: JoyButtonState -> Constr
$cdataTypeOf :: JoyButtonState -> DataType
dataTypeOf :: JoyButtonState -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyButtonState)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyButtonState)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyButtonState)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyButtonState)
$cgmapT :: (forall b. Data b => b -> b) -> JoyButtonState -> JoyButtonState
gmapT :: (forall b. Data b => b -> b) -> JoyButtonState -> JoyButtonState
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyButtonState -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyButtonState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyButtonState -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyButtonState -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoyButtonState -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JoyButtonState -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoyButtonState -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoyButtonState -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyButtonState -> m JoyButtonState
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyButtonState -> m JoyButtonState
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyButtonState -> m JoyButtonState
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyButtonState -> m JoyButtonState
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyButtonState -> m JoyButtonState
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyButtonState -> m JoyButtonState
Data, JoyButtonState -> JoyButtonState -> Bool
(JoyButtonState -> JoyButtonState -> Bool)
-> (JoyButtonState -> JoyButtonState -> Bool) -> Eq JoyButtonState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoyButtonState -> JoyButtonState -> Bool
== :: JoyButtonState -> JoyButtonState -> Bool
$c/= :: JoyButtonState -> JoyButtonState -> Bool
/= :: JoyButtonState -> JoyButtonState -> Bool
Eq, (forall x. JoyButtonState -> Rep JoyButtonState x)
-> (forall x. Rep JoyButtonState x -> JoyButtonState)
-> Generic JoyButtonState
forall x. Rep JoyButtonState x -> JoyButtonState
forall x. JoyButtonState -> Rep JoyButtonState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoyButtonState -> Rep JoyButtonState x
from :: forall x. JoyButtonState -> Rep JoyButtonState x
$cto :: forall x. Rep JoyButtonState x -> JoyButtonState
to :: forall x. Rep JoyButtonState x -> JoyButtonState
Generic, Eq JoyButtonState
Eq JoyButtonState
-> (JoyButtonState -> JoyButtonState -> Ordering)
-> (JoyButtonState -> JoyButtonState -> Bool)
-> (JoyButtonState -> JoyButtonState -> Bool)
-> (JoyButtonState -> JoyButtonState -> Bool)
-> (JoyButtonState -> JoyButtonState -> Bool)
-> (JoyButtonState -> JoyButtonState -> JoyButtonState)
-> (JoyButtonState -> JoyButtonState -> JoyButtonState)
-> Ord JoyButtonState
JoyButtonState -> JoyButtonState -> Bool
JoyButtonState -> JoyButtonState -> Ordering
JoyButtonState -> JoyButtonState -> JoyButtonState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoyButtonState -> JoyButtonState -> Ordering
compare :: JoyButtonState -> JoyButtonState -> Ordering
$c< :: JoyButtonState -> JoyButtonState -> Bool
< :: JoyButtonState -> JoyButtonState -> Bool
$c<= :: JoyButtonState -> JoyButtonState -> Bool
<= :: JoyButtonState -> JoyButtonState -> Bool
$c> :: JoyButtonState -> JoyButtonState -> Bool
> :: JoyButtonState -> JoyButtonState -> Bool
$c>= :: JoyButtonState -> JoyButtonState -> Bool
>= :: JoyButtonState -> JoyButtonState -> Bool
$cmax :: JoyButtonState -> JoyButtonState -> JoyButtonState
max :: JoyButtonState -> JoyButtonState -> JoyButtonState
$cmin :: JoyButtonState -> JoyButtonState -> JoyButtonState
min :: JoyButtonState -> JoyButtonState -> JoyButtonState
Ord, ReadPrec [JoyButtonState]
ReadPrec JoyButtonState
Int -> ReadS JoyButtonState
ReadS [JoyButtonState]
(Int -> ReadS JoyButtonState)
-> ReadS [JoyButtonState]
-> ReadPrec JoyButtonState
-> ReadPrec [JoyButtonState]
-> Read JoyButtonState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS JoyButtonState
readsPrec :: Int -> ReadS JoyButtonState
$creadList :: ReadS [JoyButtonState]
readList :: ReadS [JoyButtonState]
$creadPrec :: ReadPrec JoyButtonState
readPrec :: ReadPrec JoyButtonState
$creadListPrec :: ReadPrec [JoyButtonState]
readListPrec :: ReadPrec [JoyButtonState]
Read, Int -> JoyButtonState -> ShowS
[JoyButtonState] -> ShowS
JoyButtonState -> String
(Int -> JoyButtonState -> ShowS)
-> (JoyButtonState -> String)
-> ([JoyButtonState] -> ShowS)
-> Show JoyButtonState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoyButtonState -> ShowS
showsPrec :: Int -> JoyButtonState -> ShowS
$cshow :: JoyButtonState -> String
show :: JoyButtonState -> String
$cshowList :: [JoyButtonState] -> ShowS
showList :: [JoyButtonState] -> ShowS
Show, Typeable)

instance FromNumber JoyButtonState Word8 where
  fromNumber :: Word8 -> JoyButtonState
fromNumber Word8
n = case Word8
n of
    Word8
Raw.SDL_PRESSED -> JoyButtonState
JoyButtonPressed
    Word8
Raw.SDL_RELEASED -> JoyButtonState
JoyButtonReleased
    Word8
_ -> JoyButtonState
JoyButtonReleased

-- | Count the number of joysticks attached to the system.
--
-- See @<https://wiki.libsdl.org/SDL_NumJoysticks SDL_NumJoysticks>@ for C documentation.
numJoysticks :: MonadIO m => m (CInt)
numJoysticks :: forall (m :: Type -> Type). MonadIO m => m CInt
numJoysticks = Text -> Text -> m CInt -> m CInt
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Input.Joystick.availableJoysticks" Text
"SDL_NumJoysticks" m CInt
forall (m :: Type -> Type). MonadIO m => m CInt
Raw.numJoysticks

-- | Enumerate all connected joysticks, retrieving a description of each.
availableJoysticks :: MonadIO m => m (V.Vector JoystickDevice)
availableJoysticks :: forall (m :: Type -> Type). MonadIO m => m (Vector JoystickDevice)
availableJoysticks = IO (Vector JoystickDevice) -> m (Vector JoystickDevice)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Vector JoystickDevice) -> m (Vector JoystickDevice))
-> IO (Vector JoystickDevice) -> m (Vector JoystickDevice)
forall a b. (a -> b) -> a -> b
$ do
  CInt
n <- IO CInt
forall (m :: Type -> Type). MonadIO m => m CInt
numJoysticks
  ([JoystickDevice] -> Vector JoystickDevice)
-> IO [JoystickDevice] -> IO (Vector JoystickDevice)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([JoystickDevice] -> Vector JoystickDevice
forall a. [a] -> Vector a
V.fromList) (IO [JoystickDevice] -> IO (Vector JoystickDevice))
-> IO [JoystickDevice] -> IO (Vector JoystickDevice)
forall a b. (a -> b) -> a -> b
$
    [CInt] -> (CInt -> IO JoystickDevice) -> IO [JoystickDevice]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CInt
0 .. (CInt
n CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1)] ((CInt -> IO JoystickDevice) -> IO [JoystickDevice])
-> (CInt -> IO JoystickDevice) -> IO [JoystickDevice]
forall a b. (a -> b) -> a -> b
$ \CInt
i -> do
      Ptr CChar
cstr <-
        Text -> Text -> IO (Ptr CChar) -> IO (Ptr CChar)
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Input.Joystick.availableJoysticks" Text
"SDL_JoystickNameForIndex" (IO (Ptr CChar) -> IO (Ptr CChar))
-> IO (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$
          CInt -> IO (Ptr CChar)
forall (m :: Type -> Type). MonadIO m => CInt -> m (Ptr CChar)
Raw.joystickNameForIndex CInt
i
      Text
name <- ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO ByteString
BS.packCString Ptr CChar
cstr
      JoystickDevice -> IO JoystickDevice
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> CInt -> JoystickDevice
JoystickDevice Text
name CInt
i)

-- | Open a joystick so that you can start receiving events from interaction with this joystick.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickOpen SDL_JoystickOpen>@ for C documentation.
openJoystick :: (Functor m,MonadIO m)
             => JoystickDevice -- ^ The device to open. Use 'availableJoysticks' to find 'JoystickDevices's
             -> m Joystick
openJoystick :: forall (m :: Type -> Type).
(Functor m, MonadIO m) =>
JoystickDevice -> m Joystick
openJoystick (JoystickDevice Text
_ CInt
x) =
  (Joystick -> Joystick) -> m Joystick -> m Joystick
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Joystick -> Joystick
Joystick (m Joystick -> m Joystick) -> m Joystick -> m Joystick
forall a b. (a -> b) -> a -> b
$
  Text -> Text -> m Joystick -> m Joystick
forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Input.Joystick.openJoystick" Text
"SDL_OpenJoystick" (m Joystick -> m Joystick) -> m Joystick -> m Joystick
forall a b. (a -> b) -> a -> b
$
  CInt -> m Joystick
forall (m :: Type -> Type). MonadIO m => CInt -> m Joystick
Raw.joystickOpen CInt
x

-- | Close a joystick previously opened with 'openJoystick'.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickClose SDL_JoystickClose>@ for C documentation.
closeJoystick :: MonadIO m => Joystick -> m ()
closeJoystick :: forall (m :: Type -> Type). MonadIO m => Joystick -> m ()
closeJoystick (Joystick Joystick
j) = Joystick -> m ()
forall (m :: Type -> Type). MonadIO m => Joystick -> m ()
Raw.joystickClose Joystick
j

-- | Get the instance ID of an opened joystick. The instance ID is used to identify the joystick
-- in future SDL events.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickInstanceID SDL_JoystickInstanceID>@ for C documentation.
getJoystickID :: MonadIO m => Joystick -> m Raw.JoystickID
getJoystickID :: forall (m :: Type -> Type). MonadIO m => Joystick -> m JoystickID
getJoystickID (Joystick Joystick
j) =
  Text -> Text -> m JoystickID -> m JoystickID
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Input.Joystick.getJoystickID" Text
"SDL_JoystickInstanceID" (m JoystickID -> m JoystickID) -> m JoystickID -> m JoystickID
forall a b. (a -> b) -> a -> b
$
  Joystick -> m JoystickID
forall (m :: Type -> Type). MonadIO m => Joystick -> m JoystickID
Raw.joystickInstanceID Joystick
j

-- | Determine if a given button is currently held.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickGetButton SDL_JoystickGetButton>@ for C documentation.
buttonPressed :: (Functor m, MonadIO m)
              => Joystick
              -> CInt -- ^ The index of the button. You can use 'numButtons' to determine how many buttons a given joystick has.
              -> m Bool
buttonPressed :: forall (m :: Type -> Type).
(Functor m, MonadIO m) =>
Joystick -> CInt -> m Bool
buttonPressed (Joystick Joystick
j) CInt
buttonIndex = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1) (Word8 -> Bool) -> m Word8 -> m Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Joystick -> CInt -> m Word8
forall (m :: Type -> Type).
MonadIO m =>
Joystick -> CInt -> m Word8
Raw.joystickGetButton Joystick
j CInt
buttonIndex

-- | Get the ball axis change since the last poll.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickGetBall SDL_JoystickGetBall>@ for C documentation.
ballDelta :: MonadIO m
          => Joystick
          -> CInt -- ^ The index of the joystick ball. You can use 'numBalls' to determine how many balls a given joystick has.
          -> m (V2 CInt)
ballDelta :: forall (m :: Type -> Type).
MonadIO m =>
Joystick -> CInt -> m (V2 CInt)
ballDelta (Joystick Joystick
j) CInt
ballIndex = IO (V2 CInt) -> m (V2 CInt)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (V2 CInt) -> m (V2 CInt)) -> IO (V2 CInt) -> m (V2 CInt)
forall a b. (a -> b) -> a -> b
$
  (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
xptr ->
  (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt))
-> (Ptr CInt -> IO (V2 CInt)) -> IO (V2 CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
yptr -> do
    Text -> Text -> IO CInt -> IO ()
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Input.Joystick.ballDelta" Text
"SDL_JoystickGetBall" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      Joystick -> CInt -> Ptr CInt -> Ptr CInt -> IO CInt
forall (m :: Type -> Type).
MonadIO m =>
Joystick -> CInt -> Ptr CInt -> Ptr CInt -> m CInt
Raw.joystickGetBall Joystick
j CInt
ballIndex Ptr CInt
xptr Ptr CInt
yptr

    CInt -> CInt -> V2 CInt
forall a. a -> a -> V2 a
V2 (CInt -> CInt -> V2 CInt) -> IO CInt -> IO (CInt -> V2 CInt)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
xptr IO (CInt -> V2 CInt) -> IO CInt -> IO (V2 CInt)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
yptr

-- | Get the current state of an axis control on a joystick.
--
-- Returns a 16-bit signed integer representing the current position of the axis. The state is a value ranging from -32768 to 32767.
--
-- On most modern joysticks the x-axis is usually represented by axis 0 and the y-axis by axis 1. The value returned by 'axisPosition' is a signed integer (-32768 to 32767) representing the current position of the axis. It may be necessary to impose certain tolerances on these values to account for jitter.
--
-- Some joysticks use axes 2 and 3 for extra buttons.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickGetAxis SDL_JoystickGetAxis>@ for C documentation.
axisPosition :: MonadIO m => Joystick -> CInt -> m Int16
axisPosition :: forall (m :: Type -> Type).
MonadIO m =>
Joystick -> CInt -> m Int16
axisPosition (Joystick Joystick
j) CInt
axisIndex = Joystick -> CInt -> m Int16
forall (m :: Type -> Type).
MonadIO m =>
Joystick -> CInt -> m Int16
Raw.joystickGetAxis Joystick
j CInt
axisIndex

-- | Get the number of general axis controls on a joystick.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickNumAxes SDL_JoystickNumAxes>@ for C documentation.
numAxes :: (MonadIO m) => Joystick -> m CInt
numAxes :: forall (m :: Type -> Type). MonadIO m => Joystick -> m CInt
numAxes (Joystick Joystick
j) = IO CInt -> m CInt
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> m CInt) -> IO CInt -> m CInt
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO CInt -> IO CInt
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Input.Joystick.numAxis" Text
"SDL_JoystickNumAxes" (Joystick -> IO CInt
forall (m :: Type -> Type). MonadIO m => Joystick -> m CInt
Raw.joystickNumAxes Joystick
j)

-- | Get the number of buttons on a joystick.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickNumButtons SDL_JoystickNumButtons>@ for C documentation.
numButtons :: (MonadIO m) => Joystick -> m CInt
numButtons :: forall (m :: Type -> Type). MonadIO m => Joystick -> m CInt
numButtons (Joystick Joystick
j) = IO CInt -> m CInt
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> m CInt) -> IO CInt -> m CInt
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO CInt -> IO CInt
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Input.Joystick.numButtons" Text
"SDL_JoystickNumButtons" (Joystick -> IO CInt
forall (m :: Type -> Type). MonadIO m => Joystick -> m CInt
Raw.joystickNumButtons Joystick
j)

-- | Get the number of trackballs on a joystick.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickNumBalls SDL_JoystickNumBalls>@ for C documentation.
numBalls :: (MonadIO m) => Joystick -> m CInt
numBalls :: forall (m :: Type -> Type). MonadIO m => Joystick -> m CInt
numBalls (Joystick Joystick
j) = IO CInt -> m CInt
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> m CInt) -> IO CInt -> m CInt
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO CInt -> IO CInt
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Input.Joystick.numBalls" Text
"SDL_JoystickNumBalls" (Joystick -> IO CInt
forall (m :: Type -> Type). MonadIO m => Joystick -> m CInt
Raw.joystickNumBalls Joystick
j)

-- | Identifies the state of the POV hat on a joystick.
data JoyHatPosition
  = HatCentered  -- ^ Centered position
  | HatUp        -- ^ Up position
  | HatRight     -- ^ Right position
  | HatDown      -- ^ Down position
  | HatLeft      -- ^ Left position
  | HatRightUp   -- ^ Right-up position
  | HatRightDown -- ^ Right-down position
  | HatLeftUp    -- ^ Left-up position
  | HatLeftDown  -- ^ Left-down position
  deriving (Typeable JoyHatPosition
Typeable JoyHatPosition
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JoyHatPosition -> c JoyHatPosition)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoyHatPosition)
-> (JoyHatPosition -> Constr)
-> (JoyHatPosition -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoyHatPosition))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoyHatPosition))
-> ((forall b. Data b => b -> b)
    -> JoyHatPosition -> JoyHatPosition)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoyHatPosition -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoyHatPosition -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> JoyHatPosition -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoyHatPosition -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> JoyHatPosition -> m JoyHatPosition)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoyHatPosition -> m JoyHatPosition)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoyHatPosition -> m JoyHatPosition)
-> Data JoyHatPosition
JoyHatPosition -> Constr
JoyHatPosition -> DataType
(forall b. Data b => b -> b) -> JoyHatPosition -> JoyHatPosition
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> JoyHatPosition -> u
forall u. (forall d. Data d => d -> u) -> JoyHatPosition -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyHatPosition -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyHatPosition -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyHatPosition -> m JoyHatPosition
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyHatPosition -> m JoyHatPosition
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyHatPosition
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoyHatPosition -> c JoyHatPosition
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyHatPosition)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyHatPosition)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoyHatPosition -> c JoyHatPosition
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JoyHatPosition -> c JoyHatPosition
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyHatPosition
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyHatPosition
$ctoConstr :: JoyHatPosition -> Constr
toConstr :: JoyHatPosition -> Constr
$cdataTypeOf :: JoyHatPosition -> DataType
dataTypeOf :: JoyHatPosition -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyHatPosition)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyHatPosition)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyHatPosition)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyHatPosition)
$cgmapT :: (forall b. Data b => b -> b) -> JoyHatPosition -> JoyHatPosition
gmapT :: (forall b. Data b => b -> b) -> JoyHatPosition -> JoyHatPosition
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyHatPosition -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyHatPosition -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyHatPosition -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyHatPosition -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JoyHatPosition -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JoyHatPosition -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoyHatPosition -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoyHatPosition -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyHatPosition -> m JoyHatPosition
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyHatPosition -> m JoyHatPosition
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyHatPosition -> m JoyHatPosition
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyHatPosition -> m JoyHatPosition
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyHatPosition -> m JoyHatPosition
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyHatPosition -> m JoyHatPosition
Data, JoyHatPosition -> JoyHatPosition -> Bool
(JoyHatPosition -> JoyHatPosition -> Bool)
-> (JoyHatPosition -> JoyHatPosition -> Bool) -> Eq JoyHatPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoyHatPosition -> JoyHatPosition -> Bool
== :: JoyHatPosition -> JoyHatPosition -> Bool
$c/= :: JoyHatPosition -> JoyHatPosition -> Bool
/= :: JoyHatPosition -> JoyHatPosition -> Bool
Eq, (forall x. JoyHatPosition -> Rep JoyHatPosition x)
-> (forall x. Rep JoyHatPosition x -> JoyHatPosition)
-> Generic JoyHatPosition
forall x. Rep JoyHatPosition x -> JoyHatPosition
forall x. JoyHatPosition -> Rep JoyHatPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoyHatPosition -> Rep JoyHatPosition x
from :: forall x. JoyHatPosition -> Rep JoyHatPosition x
$cto :: forall x. Rep JoyHatPosition x -> JoyHatPosition
to :: forall x. Rep JoyHatPosition x -> JoyHatPosition
Generic, Eq JoyHatPosition
Eq JoyHatPosition
-> (JoyHatPosition -> JoyHatPosition -> Ordering)
-> (JoyHatPosition -> JoyHatPosition -> Bool)
-> (JoyHatPosition -> JoyHatPosition -> Bool)
-> (JoyHatPosition -> JoyHatPosition -> Bool)
-> (JoyHatPosition -> JoyHatPosition -> Bool)
-> (JoyHatPosition -> JoyHatPosition -> JoyHatPosition)
-> (JoyHatPosition -> JoyHatPosition -> JoyHatPosition)
-> Ord JoyHatPosition
JoyHatPosition -> JoyHatPosition -> Bool
JoyHatPosition -> JoyHatPosition -> Ordering
JoyHatPosition -> JoyHatPosition -> JoyHatPosition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoyHatPosition -> JoyHatPosition -> Ordering
compare :: JoyHatPosition -> JoyHatPosition -> Ordering
$c< :: JoyHatPosition -> JoyHatPosition -> Bool
< :: JoyHatPosition -> JoyHatPosition -> Bool
$c<= :: JoyHatPosition -> JoyHatPosition -> Bool
<= :: JoyHatPosition -> JoyHatPosition -> Bool
$c> :: JoyHatPosition -> JoyHatPosition -> Bool
> :: JoyHatPosition -> JoyHatPosition -> Bool
$c>= :: JoyHatPosition -> JoyHatPosition -> Bool
>= :: JoyHatPosition -> JoyHatPosition -> Bool
$cmax :: JoyHatPosition -> JoyHatPosition -> JoyHatPosition
max :: JoyHatPosition -> JoyHatPosition -> JoyHatPosition
$cmin :: JoyHatPosition -> JoyHatPosition -> JoyHatPosition
min :: JoyHatPosition -> JoyHatPosition -> JoyHatPosition
Ord, ReadPrec [JoyHatPosition]
ReadPrec JoyHatPosition
Int -> ReadS JoyHatPosition
ReadS [JoyHatPosition]
(Int -> ReadS JoyHatPosition)
-> ReadS [JoyHatPosition]
-> ReadPrec JoyHatPosition
-> ReadPrec [JoyHatPosition]
-> Read JoyHatPosition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS JoyHatPosition
readsPrec :: Int -> ReadS JoyHatPosition
$creadList :: ReadS [JoyHatPosition]
readList :: ReadS [JoyHatPosition]
$creadPrec :: ReadPrec JoyHatPosition
readPrec :: ReadPrec JoyHatPosition
$creadListPrec :: ReadPrec [JoyHatPosition]
readListPrec :: ReadPrec [JoyHatPosition]
Read, Int -> JoyHatPosition -> ShowS
[JoyHatPosition] -> ShowS
JoyHatPosition -> String
(Int -> JoyHatPosition -> ShowS)
-> (JoyHatPosition -> String)
-> ([JoyHatPosition] -> ShowS)
-> Show JoyHatPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoyHatPosition -> ShowS
showsPrec :: Int -> JoyHatPosition -> ShowS
$cshow :: JoyHatPosition -> String
show :: JoyHatPosition -> String
$cshowList :: [JoyHatPosition] -> ShowS
showList :: [JoyHatPosition] -> ShowS
Show, Typeable)

instance FromNumber JoyHatPosition Word8 where
  fromNumber :: Word8 -> JoyHatPosition
fromNumber Word8
n = case Word8
n of
    Word8
Raw.SDL_HAT_CENTERED -> JoyHatPosition
HatCentered
    Word8
Raw.SDL_HAT_UP -> JoyHatPosition
HatUp
    Word8
Raw.SDL_HAT_RIGHT -> JoyHatPosition
HatRight
    Word8
Raw.SDL_HAT_DOWN -> JoyHatPosition
HatDown
    Word8
Raw.SDL_HAT_LEFT -> JoyHatPosition
HatLeft
    Word8
Raw.SDL_HAT_RIGHTUP -> JoyHatPosition
HatRightUp
    Word8
Raw.SDL_HAT_RIGHTDOWN -> JoyHatPosition
HatRightDown
    Word8
Raw.SDL_HAT_LEFTUP -> JoyHatPosition
HatLeftUp
    Word8
Raw.SDL_HAT_LEFTDOWN -> JoyHatPosition
HatLeftDown
    Word8
_ -> JoyHatPosition
HatCentered

-- | Get current position of a POV hat on a joystick.
--
-- See @<https://wiki.libsdl.org/SDL_JoystickGetHat SDL_JoystickGetHat>@ for C documentation.
getHat :: (Functor m, MonadIO m)
       => Joystick
       -> CInt -- ^ The index of the POV hat. You can use 'numHats' to determine how many POV hats a given joystick has.
       -> m JoyHatPosition
getHat :: forall (m :: Type -> Type).
(Functor m, MonadIO m) =>
Joystick -> CInt -> m JoyHatPosition
getHat (Joystick Joystick
j) CInt
hatIndex = Word8 -> JoyHatPosition
forall a b. FromNumber a b => b -> a
fromNumber (Word8 -> JoyHatPosition) -> m Word8 -> m JoyHatPosition
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Joystick -> CInt -> m Word8
forall (m :: Type -> Type).
MonadIO m =>
Joystick -> CInt -> m Word8
Raw.joystickGetHat Joystick
j CInt
hatIndex

-- | Get the number of POV hats on a joystick.
--
-- See @<https://wiki.libsdl.org/https://wiki.libsdl.org/SDL_JoystickNumHats SDL_JoystickNumHats>@ for C documentation.
numHats :: (MonadIO m) => Joystick -> m CInt
numHats :: forall (m :: Type -> Type). MonadIO m => Joystick -> m CInt
numHats (Joystick Joystick
j) = IO CInt -> m CInt
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> m CInt) -> IO CInt -> m CInt
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO CInt -> IO CInt
forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m a
throwIfNeg Text
"SDL.Input.Joystick.numHats" Text
"SDL_JoystickNumHats" (Joystick -> IO CInt
forall (m :: Type -> Type). MonadIO m => Joystick -> m CInt
Raw.joystickNumHats Joystick
j)

-- | Identifies whether a joystick has been connected or disconnected.
data JoyDeviceConnection = JoyDeviceAdded | JoyDeviceRemoved
  deriving (Typeable JoyDeviceConnection
Typeable JoyDeviceConnection
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> JoyDeviceConnection
    -> c JoyDeviceConnection)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JoyDeviceConnection)
-> (JoyDeviceConnection -> Constr)
-> (JoyDeviceConnection -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JoyDeviceConnection))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c JoyDeviceConnection))
-> ((forall b. Data b => b -> b)
    -> JoyDeviceConnection -> JoyDeviceConnection)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JoyDeviceConnection -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JoyDeviceConnection -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> JoyDeviceConnection -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JoyDeviceConnection -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> JoyDeviceConnection -> m JoyDeviceConnection)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoyDeviceConnection -> m JoyDeviceConnection)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> JoyDeviceConnection -> m JoyDeviceConnection)
-> Data JoyDeviceConnection
JoyDeviceConnection -> Constr
JoyDeviceConnection -> DataType
(forall b. Data b => b -> b)
-> JoyDeviceConnection -> JoyDeviceConnection
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> JoyDeviceConnection -> u
forall u.
(forall d. Data d => d -> u) -> JoyDeviceConnection -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyDeviceConnection -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyDeviceConnection -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyDeviceConnection -> m JoyDeviceConnection
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyDeviceConnection -> m JoyDeviceConnection
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyDeviceConnection
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> JoyDeviceConnection
-> c JoyDeviceConnection
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyDeviceConnection)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyDeviceConnection)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> JoyDeviceConnection
-> c JoyDeviceConnection
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> JoyDeviceConnection
-> c JoyDeviceConnection
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyDeviceConnection
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JoyDeviceConnection
$ctoConstr :: JoyDeviceConnection -> Constr
toConstr :: JoyDeviceConnection -> Constr
$cdataTypeOf :: JoyDeviceConnection -> DataType
dataTypeOf :: JoyDeviceConnection -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyDeviceConnection)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JoyDeviceConnection)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyDeviceConnection)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JoyDeviceConnection)
$cgmapT :: (forall b. Data b => b -> b)
-> JoyDeviceConnection -> JoyDeviceConnection
gmapT :: (forall b. Data b => b -> b)
-> JoyDeviceConnection -> JoyDeviceConnection
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyDeviceConnection -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JoyDeviceConnection -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyDeviceConnection -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JoyDeviceConnection -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> JoyDeviceConnection -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> JoyDeviceConnection -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoyDeviceConnection -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> JoyDeviceConnection -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyDeviceConnection -> m JoyDeviceConnection
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> JoyDeviceConnection -> m JoyDeviceConnection
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyDeviceConnection -> m JoyDeviceConnection
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyDeviceConnection -> m JoyDeviceConnection
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyDeviceConnection -> m JoyDeviceConnection
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> JoyDeviceConnection -> m JoyDeviceConnection
Data, JoyDeviceConnection -> JoyDeviceConnection -> Bool
(JoyDeviceConnection -> JoyDeviceConnection -> Bool)
-> (JoyDeviceConnection -> JoyDeviceConnection -> Bool)
-> Eq JoyDeviceConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
== :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
$c/= :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
/= :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
Eq, (forall x. JoyDeviceConnection -> Rep JoyDeviceConnection x)
-> (forall x. Rep JoyDeviceConnection x -> JoyDeviceConnection)
-> Generic JoyDeviceConnection
forall x. Rep JoyDeviceConnection x -> JoyDeviceConnection
forall x. JoyDeviceConnection -> Rep JoyDeviceConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JoyDeviceConnection -> Rep JoyDeviceConnection x
from :: forall x. JoyDeviceConnection -> Rep JoyDeviceConnection x
$cto :: forall x. Rep JoyDeviceConnection x -> JoyDeviceConnection
to :: forall x. Rep JoyDeviceConnection x -> JoyDeviceConnection
Generic, Eq JoyDeviceConnection
Eq JoyDeviceConnection
-> (JoyDeviceConnection -> JoyDeviceConnection -> Ordering)
-> (JoyDeviceConnection -> JoyDeviceConnection -> Bool)
-> (JoyDeviceConnection -> JoyDeviceConnection -> Bool)
-> (JoyDeviceConnection -> JoyDeviceConnection -> Bool)
-> (JoyDeviceConnection -> JoyDeviceConnection -> Bool)
-> (JoyDeviceConnection
    -> JoyDeviceConnection -> JoyDeviceConnection)
-> (JoyDeviceConnection
    -> JoyDeviceConnection -> JoyDeviceConnection)
-> Ord JoyDeviceConnection
JoyDeviceConnection -> JoyDeviceConnection -> Bool
JoyDeviceConnection -> JoyDeviceConnection -> Ordering
JoyDeviceConnection -> JoyDeviceConnection -> JoyDeviceConnection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JoyDeviceConnection -> JoyDeviceConnection -> Ordering
compare :: JoyDeviceConnection -> JoyDeviceConnection -> Ordering
$c< :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
< :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
$c<= :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
<= :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
$c> :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
> :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
$c>= :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
>= :: JoyDeviceConnection -> JoyDeviceConnection -> Bool
$cmax :: JoyDeviceConnection -> JoyDeviceConnection -> JoyDeviceConnection
max :: JoyDeviceConnection -> JoyDeviceConnection -> JoyDeviceConnection
$cmin :: JoyDeviceConnection -> JoyDeviceConnection -> JoyDeviceConnection
min :: JoyDeviceConnection -> JoyDeviceConnection -> JoyDeviceConnection
Ord, ReadPrec [JoyDeviceConnection]
ReadPrec JoyDeviceConnection
Int -> ReadS JoyDeviceConnection
ReadS [JoyDeviceConnection]
(Int -> ReadS JoyDeviceConnection)
-> ReadS [JoyDeviceConnection]
-> ReadPrec JoyDeviceConnection
-> ReadPrec [JoyDeviceConnection]
-> Read JoyDeviceConnection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS JoyDeviceConnection
readsPrec :: Int -> ReadS JoyDeviceConnection
$creadList :: ReadS [JoyDeviceConnection]
readList :: ReadS [JoyDeviceConnection]
$creadPrec :: ReadPrec JoyDeviceConnection
readPrec :: ReadPrec JoyDeviceConnection
$creadListPrec :: ReadPrec [JoyDeviceConnection]
readListPrec :: ReadPrec [JoyDeviceConnection]
Read, Int -> JoyDeviceConnection -> ShowS
[JoyDeviceConnection] -> ShowS
JoyDeviceConnection -> String
(Int -> JoyDeviceConnection -> ShowS)
-> (JoyDeviceConnection -> String)
-> ([JoyDeviceConnection] -> ShowS)
-> Show JoyDeviceConnection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoyDeviceConnection -> ShowS
showsPrec :: Int -> JoyDeviceConnection -> ShowS
$cshow :: JoyDeviceConnection -> String
show :: JoyDeviceConnection -> String
$cshowList :: [JoyDeviceConnection] -> ShowS
showList :: [JoyDeviceConnection] -> ShowS
Show, Typeable)

instance FromNumber JoyDeviceConnection Word32 where
  fromNumber :: Word32 -> JoyDeviceConnection
fromNumber Word32
n = case Word32
n of
    Word32
Raw.SDL_JOYDEVICEADDED -> JoyDeviceConnection
JoyDeviceAdded
    Word32
Raw.SDL_JOYDEVICEREMOVED -> JoyDeviceConnection
JoyDeviceRemoved
    Word32
_ -> JoyDeviceConnection
JoyDeviceAdded