{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}

module SDL.Input.GameController
  ( ControllerButton(..)
  , ControllerButtonState(..)
  , ControllerDeviceConnection(..)
  ) where

import Data.Data (Data)
import Data.Typeable
import Data.Word
import GHC.Generics (Generic)
import GHC.Int (Int32)
import SDL.Internal.Numbered
import qualified SDL.Raw as Raw

-- | Identifies a gamepad button.
data ControllerButton
  = ControllerButtonInvalid
  | ControllerButtonA
  | ControllerButtonB
  | ControllerButtonX
  | ControllerButtonY
  | ControllerButtonBack
  | ControllerButtonGuide
  | ControllerButtonStart
  | ControllerButtonLeftStick
  | ControllerButtonRightStick
  | ControllerButtonLeftShoulder
  | ControllerButtonRightShoulder
  | ControllerButtonDpadUp
  | ControllerButtonDpadDown
  | ControllerButtonDpadLeft
  | ControllerButtonDpadRight
  deriving (Typeable ControllerButton
ControllerButton -> DataType
ControllerButton -> Constr
(forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
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) -> ControllerButton -> u
forall u. (forall d. Data d => d -> u) -> ControllerButton -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerButton -> m ControllerButton
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ControllerButton -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ControllerButton -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ControllerButton -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ControllerButton -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ControllerButton -> r
gmapT :: (forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
$cgmapT :: (forall b. Data b => b -> b)
-> ControllerButton -> ControllerButton
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerButton)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ControllerButton)
dataTypeOf :: ControllerButton -> DataType
$cdataTypeOf :: ControllerButton -> DataType
toConstr :: ControllerButton -> Constr
$ctoConstr :: ControllerButton -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerButton
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ControllerButton -> c ControllerButton
Data, ControllerButton -> ControllerButton -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerButton -> ControllerButton -> Bool
$c/= :: ControllerButton -> ControllerButton -> Bool
== :: ControllerButton -> ControllerButton -> Bool
$c== :: ControllerButton -> ControllerButton -> Bool
Eq, forall x. Rep ControllerButton x -> ControllerButton
forall x. ControllerButton -> Rep ControllerButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ControllerButton x -> ControllerButton
$cfrom :: forall x. ControllerButton -> Rep ControllerButton x
Generic, Eq ControllerButton
ControllerButton -> ControllerButton -> Bool
ControllerButton -> ControllerButton -> Ordering
ControllerButton -> ControllerButton -> ControllerButton
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
min :: ControllerButton -> ControllerButton -> ControllerButton
$cmin :: ControllerButton -> ControllerButton -> ControllerButton
max :: ControllerButton -> ControllerButton -> ControllerButton
$cmax :: ControllerButton -> ControllerButton -> ControllerButton
>= :: ControllerButton -> ControllerButton -> Bool
$c>= :: ControllerButton -> ControllerButton -> Bool
> :: ControllerButton -> ControllerButton -> Bool
$c> :: ControllerButton -> ControllerButton -> Bool
<= :: ControllerButton -> ControllerButton -> Bool
$c<= :: ControllerButton -> ControllerButton -> Bool
< :: ControllerButton -> ControllerButton -> Bool
$c< :: ControllerButton -> ControllerButton -> Bool
compare :: ControllerButton -> ControllerButton -> Ordering
$ccompare :: ControllerButton -> ControllerButton -> Ordering
Ord, ReadPrec [ControllerButton]
ReadPrec ControllerButton
Int -> ReadS ControllerButton
ReadS [ControllerButton]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ControllerButton]
$creadListPrec :: ReadPrec [ControllerButton]
readPrec :: ReadPrec ControllerButton
$creadPrec :: ReadPrec ControllerButton
readList :: ReadS [ControllerButton]
$creadList :: ReadS [ControllerButton]
readsPrec :: Int -> ReadS ControllerButton
$creadsPrec :: Int -> ReadS ControllerButton
Read, Int -> ControllerButton -> ShowS
[ControllerButton] -> ShowS
ControllerButton -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControllerButton] -> ShowS
$cshowList :: [ControllerButton] -> ShowS
show :: ControllerButton -> String
$cshow :: ControllerButton -> String
showsPrec :: Int -> ControllerButton -> ShowS
$cshowsPrec :: Int -> ControllerButton -> ShowS
Show, Typeable)

instance FromNumber ControllerButton Int32 where
  fromNumber :: Int32 -> ControllerButton
fromNumber Int32
n = case Int32
n of
    Int32
Raw.SDL_CONTROLLER_BUTTON_A -> ControllerButton
ControllerButtonA
    Int32
Raw.SDL_CONTROLLER_BUTTON_B -> ControllerButton
ControllerButtonB
    Int32
Raw.SDL_CONTROLLER_BUTTON_X -> ControllerButton
ControllerButtonX
    Int32
Raw.SDL_CONTROLLER_BUTTON_Y -> ControllerButton
ControllerButtonY
    Int32
Raw.SDL_CONTROLLER_BUTTON_BACK -> ControllerButton
ControllerButtonBack
    Int32
Raw.SDL_CONTROLLER_BUTTON_GUIDE -> ControllerButton
ControllerButtonGuide
    Int32
Raw.SDL_CONTROLLER_BUTTON_START -> ControllerButton
ControllerButtonStart
    Int32
Raw.SDL_CONTROLLER_BUTTON_LEFTSTICK -> ControllerButton
ControllerButtonLeftStick
    Int32
Raw.SDL_CONTROLLER_BUTTON_RIGHTSTICK -> ControllerButton
ControllerButtonRightStick
    Int32
Raw.SDL_CONTROLLER_BUTTON_LEFTSHOULDER -> ControllerButton
ControllerButtonLeftShoulder
    Int32
Raw.SDL_CONTROLLER_BUTTON_RIGHTSHOULDER -> ControllerButton
ControllerButtonRightShoulder
    Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_UP -> ControllerButton
ControllerButtonDpadUp
    Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_DOWN -> ControllerButton
ControllerButtonDpadDown
    Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_LEFT -> ControllerButton
ControllerButtonDpadLeft
    Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_RIGHT -> ControllerButton
ControllerButtonDpadRight
    Int32
_ -> ControllerButton
ControllerButtonInvalid

instance ToNumber ControllerButton Int32 where
  toNumber :: ControllerButton -> Int32
toNumber ControllerButton
c = case ControllerButton
c of
    ControllerButton
ControllerButtonA -> Int32
Raw.SDL_CONTROLLER_BUTTON_A
    ControllerButton
ControllerButtonB -> Int32
Raw.SDL_CONTROLLER_BUTTON_B
    ControllerButton
ControllerButtonX -> Int32
Raw.SDL_CONTROLLER_BUTTON_X
    ControllerButton
ControllerButtonY -> Int32
Raw.SDL_CONTROLLER_BUTTON_Y
    ControllerButton
ControllerButtonBack -> Int32
Raw.SDL_CONTROLLER_BUTTON_BACK
    ControllerButton
ControllerButtonGuide -> Int32
Raw.SDL_CONTROLLER_BUTTON_GUIDE
    ControllerButton
ControllerButtonStart -> Int32
Raw.SDL_CONTROLLER_BUTTON_START
    ControllerButton
ControllerButtonLeftStick -> Int32
Raw.SDL_CONTROLLER_BUTTON_LEFTSTICK
    ControllerButton
ControllerButtonRightStick -> Int32
Raw.SDL_CONTROLLER_BUTTON_RIGHTSTICK
    ControllerButton
ControllerButtonLeftShoulder -> Int32
Raw.SDL_CONTROLLER_BUTTON_LEFTSHOULDER
    ControllerButton
ControllerButtonRightShoulder -> Int32
Raw.SDL_CONTROLLER_BUTTON_RIGHTSHOULDER
    ControllerButton
ControllerButtonDpadUp -> Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_UP
    ControllerButton
ControllerButtonDpadDown -> Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_DOWN
    ControllerButton
ControllerButtonDpadLeft -> Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_LEFT
    ControllerButton
ControllerButtonDpadRight -> Int32
Raw.SDL_CONTROLLER_BUTTON_DPAD_RIGHT
    ControllerButton
ControllerButtonInvalid -> Int32
Raw.SDL_CONTROLLER_BUTTON_INVALID

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

instance FromNumber ControllerButtonState Word32 where
  fromNumber :: Word32 -> ControllerButtonState
fromNumber Word32
n = case Word32
n of
    Word32
Raw.SDL_CONTROLLERBUTTONDOWN -> ControllerButtonState
ControllerButtonPressed
    Word32
Raw.SDL_CONTROLLERBUTTONUP -> ControllerButtonState
ControllerButtonReleased
    Word32
_ -> ControllerButtonState
ControllerButtonInvalidState

-- | Identified whether the game controller was added, removed, or remapped.
data ControllerDeviceConnection
  = ControllerDeviceAdded
  | ControllerDeviceRemoved
  | ControllerDeviceRemapped
  deriving (Typeable ControllerDeviceConnection
ControllerDeviceConnection -> DataType
ControllerDeviceConnection -> Constr
(forall b. Data b => b -> b)
-> ControllerDeviceConnection -> ControllerDeviceConnection
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) -> ControllerDeviceConnection -> u
forall u.
(forall d. Data d => d -> u) -> ControllerDeviceConnection -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerDeviceConnection
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerDeviceConnection
-> c ControllerDeviceConnection
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ControllerDeviceConnection)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerDeviceConnection)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> ControllerDeviceConnection -> m ControllerDeviceConnection
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ControllerDeviceConnection -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> ControllerDeviceConnection -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ControllerDeviceConnection -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> ControllerDeviceConnection -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> ControllerDeviceConnection
-> r
gmapT :: (forall b. Data b => b -> b)
-> ControllerDeviceConnection -> ControllerDeviceConnection
$cgmapT :: (forall b. Data b => b -> b)
-> ControllerDeviceConnection -> ControllerDeviceConnection
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerDeviceConnection)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ControllerDeviceConnection)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ControllerDeviceConnection)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c ControllerDeviceConnection)
dataTypeOf :: ControllerDeviceConnection -> DataType
$cdataTypeOf :: ControllerDeviceConnection -> DataType
toConstr :: ControllerDeviceConnection -> Constr
$ctoConstr :: ControllerDeviceConnection -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerDeviceConnection
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ControllerDeviceConnection
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerDeviceConnection
-> c ControllerDeviceConnection
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ControllerDeviceConnection
-> c ControllerDeviceConnection
Data, ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c/= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
== :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c== :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
Eq, forall x.
Rep ControllerDeviceConnection x -> ControllerDeviceConnection
forall x.
ControllerDeviceConnection -> Rep ControllerDeviceConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ControllerDeviceConnection x -> ControllerDeviceConnection
$cfrom :: forall x.
ControllerDeviceConnection -> Rep ControllerDeviceConnection x
Generic, Eq ControllerDeviceConnection
ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
ControllerDeviceConnection
-> ControllerDeviceConnection -> Ordering
ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
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
min :: ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
$cmin :: ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
max :: ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
$cmax :: ControllerDeviceConnection
-> ControllerDeviceConnection -> ControllerDeviceConnection
>= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c>= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
> :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c> :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
<= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c<= :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
< :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
$c< :: ControllerDeviceConnection -> ControllerDeviceConnection -> Bool
compare :: ControllerDeviceConnection
-> ControllerDeviceConnection -> Ordering
$ccompare :: ControllerDeviceConnection
-> ControllerDeviceConnection -> Ordering
Ord, ReadPrec [ControllerDeviceConnection]
ReadPrec ControllerDeviceConnection
Int -> ReadS ControllerDeviceConnection
ReadS [ControllerDeviceConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ControllerDeviceConnection]
$creadListPrec :: ReadPrec [ControllerDeviceConnection]
readPrec :: ReadPrec ControllerDeviceConnection
$creadPrec :: ReadPrec ControllerDeviceConnection
readList :: ReadS [ControllerDeviceConnection]
$creadList :: ReadS [ControllerDeviceConnection]
readsPrec :: Int -> ReadS ControllerDeviceConnection
$creadsPrec :: Int -> ReadS ControllerDeviceConnection
Read, Int -> ControllerDeviceConnection -> ShowS
[ControllerDeviceConnection] -> ShowS
ControllerDeviceConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControllerDeviceConnection] -> ShowS
$cshowList :: [ControllerDeviceConnection] -> ShowS
show :: ControllerDeviceConnection -> String
$cshow :: ControllerDeviceConnection -> String
showsPrec :: Int -> ControllerDeviceConnection -> ShowS
$cshowsPrec :: Int -> ControllerDeviceConnection -> ShowS
Show, Typeable)

instance FromNumber ControllerDeviceConnection Word32 where
  fromNumber :: Word32 -> ControllerDeviceConnection
fromNumber Word32
n = case Word32
n of
    Word32
Raw.SDL_CONTROLLERDEVICEADDED -> ControllerDeviceConnection
ControllerDeviceAdded
    Word32
Raw.SDL_CONTROLLERDEVICEREMOVED -> ControllerDeviceConnection
ControllerDeviceRemoved
    Word32
_ -> ControllerDeviceConnection
ControllerDeviceRemapped