{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module SDL.Internal.Types
  ( Joystick(..)
  , GameController(..)
  , Window(..)
  , Renderer(..)
  ) where

import Data.Data (Data)
import Data.Typeable
import GHC.Generics (Generic)

import qualified SDL.Raw as Raw

newtype Joystick = Joystick { Joystick -> Joystick
joystickPtr :: Raw.Joystick }
  deriving (Typeable Joystick
Typeable Joystick =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Joystick -> c Joystick)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Joystick)
-> (Joystick -> Constr)
-> (Joystick -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Joystick))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Joystick))
-> ((forall b. Data b => b -> b) -> Joystick -> Joystick)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Joystick -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Joystick -> r)
-> (forall u. (forall d. Data d => d -> u) -> Joystick -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Joystick -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> Joystick -> m Joystick)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Joystick -> m Joystick)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Joystick -> m Joystick)
-> Data Joystick
Joystick -> Constr
Joystick -> DataType
(forall b. Data b => b -> b) -> Joystick -> Joystick
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) -> Joystick -> u
forall u. (forall d. Data d => d -> u) -> Joystick -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Joystick
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Joystick -> c Joystick
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Joystick)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Joystick)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Joystick -> c Joystick
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Joystick -> c Joystick
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Joystick
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Joystick
$ctoConstr :: Joystick -> Constr
toConstr :: Joystick -> Constr
$cdataTypeOf :: Joystick -> DataType
dataTypeOf :: Joystick -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Joystick)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Joystick)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Joystick)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Joystick)
$cgmapT :: (forall b. Data b => b -> b) -> Joystick -> Joystick
gmapT :: (forall b. Data b => b -> b) -> Joystick -> Joystick
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Joystick -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Joystick -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Joystick -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Joystick -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Joystick -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Joystick -> m Joystick
Data, Joystick -> Joystick -> Bool
(Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Bool) -> Eq Joystick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Joystick -> Joystick -> Bool
== :: Joystick -> Joystick -> Bool
$c/= :: Joystick -> Joystick -> Bool
/= :: Joystick -> Joystick -> Bool
Eq, (forall x. Joystick -> Rep Joystick x)
-> (forall x. Rep Joystick x -> Joystick) -> Generic Joystick
forall x. Rep Joystick x -> Joystick
forall x. Joystick -> Rep Joystick x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Joystick -> Rep Joystick x
from :: forall x. Joystick -> Rep Joystick x
$cto :: forall x. Rep Joystick x -> Joystick
to :: forall x. Rep Joystick x -> Joystick
Generic, Eq Joystick
Eq Joystick =>
(Joystick -> Joystick -> Ordering)
-> (Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Bool)
-> (Joystick -> Joystick -> Joystick)
-> (Joystick -> Joystick -> Joystick)
-> Ord Joystick
Joystick -> Joystick -> Bool
Joystick -> Joystick -> Ordering
Joystick -> Joystick -> Joystick
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 :: Joystick -> Joystick -> Ordering
compare :: Joystick -> Joystick -> Ordering
$c< :: Joystick -> Joystick -> Bool
< :: Joystick -> Joystick -> Bool
$c<= :: Joystick -> Joystick -> Bool
<= :: Joystick -> Joystick -> Bool
$c> :: Joystick -> Joystick -> Bool
> :: Joystick -> Joystick -> Bool
$c>= :: Joystick -> Joystick -> Bool
>= :: Joystick -> Joystick -> Bool
$cmax :: Joystick -> Joystick -> Joystick
max :: Joystick -> Joystick -> Joystick
$cmin :: Joystick -> Joystick -> Joystick
min :: Joystick -> Joystick -> Joystick
Ord, Int -> Joystick -> ShowS
[Joystick] -> ShowS
Joystick -> String
(Int -> Joystick -> ShowS)
-> (Joystick -> String) -> ([Joystick] -> ShowS) -> Show Joystick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Joystick -> ShowS
showsPrec :: Int -> Joystick -> ShowS
$cshow :: Joystick -> String
show :: Joystick -> String
$cshowList :: [Joystick] -> ShowS
showList :: [Joystick] -> ShowS
Show, Typeable)

newtype GameController = GameController
  { GameController -> Joystick
gameControllerPtr :: Raw.GameController }
  deriving (Typeable GameController
Typeable GameController =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GameController -> c GameController)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GameController)
-> (GameController -> Constr)
-> (GameController -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GameController))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GameController))
-> ((forall b. Data b => b -> b)
    -> GameController -> GameController)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GameController -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GameController -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> GameController -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GameController -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> GameController -> m GameController)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GameController -> m GameController)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GameController -> m GameController)
-> Data GameController
GameController -> Constr
GameController -> DataType
(forall b. Data b => b -> b) -> GameController -> GameController
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) -> GameController -> u
forall u. (forall d. Data d => d -> u) -> GameController -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GameController -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GameController -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> GameController -> m GameController
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GameController -> m GameController
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GameController
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GameController -> c GameController
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GameController)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GameController)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GameController -> c GameController
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GameController -> c GameController
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GameController
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GameController
$ctoConstr :: GameController -> Constr
toConstr :: GameController -> Constr
$cdataTypeOf :: GameController -> DataType
dataTypeOf :: GameController -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GameController)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GameController)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GameController)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GameController)
$cgmapT :: (forall b. Data b => b -> b) -> GameController -> GameController
gmapT :: (forall b. Data b => b -> b) -> GameController -> GameController
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GameController -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GameController -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GameController -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GameController -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GameController -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> GameController -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GameController -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GameController -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> GameController -> m GameController
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> GameController -> m GameController
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GameController -> m GameController
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GameController -> m GameController
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GameController -> m GameController
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GameController -> m GameController
Data, GameController -> GameController -> Bool
(GameController -> GameController -> Bool)
-> (GameController -> GameController -> Bool) -> Eq GameController
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GameController -> GameController -> Bool
== :: GameController -> GameController -> Bool
$c/= :: GameController -> GameController -> Bool
/= :: GameController -> GameController -> Bool
Eq, (forall x. GameController -> Rep GameController x)
-> (forall x. Rep GameController x -> GameController)
-> Generic GameController
forall x. Rep GameController x -> GameController
forall x. GameController -> Rep GameController x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GameController -> Rep GameController x
from :: forall x. GameController -> Rep GameController x
$cto :: forall x. Rep GameController x -> GameController
to :: forall x. Rep GameController x -> GameController
Generic, Eq GameController
Eq GameController =>
(GameController -> GameController -> Ordering)
-> (GameController -> GameController -> Bool)
-> (GameController -> GameController -> Bool)
-> (GameController -> GameController -> Bool)
-> (GameController -> GameController -> Bool)
-> (GameController -> GameController -> GameController)
-> (GameController -> GameController -> GameController)
-> Ord GameController
GameController -> GameController -> Bool
GameController -> GameController -> Ordering
GameController -> GameController -> GameController
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 :: GameController -> GameController -> Ordering
compare :: GameController -> GameController -> Ordering
$c< :: GameController -> GameController -> Bool
< :: GameController -> GameController -> Bool
$c<= :: GameController -> GameController -> Bool
<= :: GameController -> GameController -> Bool
$c> :: GameController -> GameController -> Bool
> :: GameController -> GameController -> Bool
$c>= :: GameController -> GameController -> Bool
>= :: GameController -> GameController -> Bool
$cmax :: GameController -> GameController -> GameController
max :: GameController -> GameController -> GameController
$cmin :: GameController -> GameController -> GameController
min :: GameController -> GameController -> GameController
Ord, Int -> GameController -> ShowS
[GameController] -> ShowS
GameController -> String
(Int -> GameController -> ShowS)
-> (GameController -> String)
-> ([GameController] -> ShowS)
-> Show GameController
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GameController -> ShowS
showsPrec :: Int -> GameController -> ShowS
$cshow :: GameController -> String
show :: GameController -> String
$cshowList :: [GameController] -> ShowS
showList :: [GameController] -> ShowS
Show, Typeable)

newtype Window = Window (Raw.Window)
  deriving (Typeable Window
Typeable Window =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Window -> c Window)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Window)
-> (Window -> Constr)
-> (Window -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Window))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Window))
-> ((forall b. Data b => b -> b) -> Window -> Window)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Window -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Window -> r)
-> (forall u. (forall d. Data d => d -> u) -> Window -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Window -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> Window -> m Window)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Window -> m Window)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Window -> m Window)
-> Data Window
Window -> Constr
Window -> DataType
(forall b. Data b => b -> b) -> Window -> Window
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) -> Window -> u
forall u. (forall d. Data d => d -> u) -> Window -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Window -> m Window
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Window -> m Window
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Window
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Window -> c Window
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Window)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Window)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Window -> c Window
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Window -> c Window
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Window
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Window
$ctoConstr :: Window -> Constr
toConstr :: Window -> Constr
$cdataTypeOf :: Window -> DataType
dataTypeOf :: Window -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Window)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Window)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Window)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Window)
$cgmapT :: (forall b. Data b => b -> b) -> Window -> Window
gmapT :: (forall b. Data b => b -> b) -> Window -> Window
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Window -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Window -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Window -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Window -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Window -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Window -> m Window
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Window -> m Window
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Window -> m Window
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Window -> m Window
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Window -> m Window
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Window -> m Window
Data, Window -> Window -> Bool
(Window -> Window -> Bool)
-> (Window -> Window -> Bool) -> Eq Window
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Window -> Window -> Bool
== :: Window -> Window -> Bool
$c/= :: Window -> Window -> Bool
/= :: Window -> Window -> Bool
Eq, (forall x. Window -> Rep Window x)
-> (forall x. Rep Window x -> Window) -> Generic Window
forall x. Rep Window x -> Window
forall x. Window -> Rep Window x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Window -> Rep Window x
from :: forall x. Window -> Rep Window x
$cto :: forall x. Rep Window x -> Window
to :: forall x. Rep Window x -> Window
Generic, Eq Window
Eq Window =>
(Window -> Window -> Ordering)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Bool)
-> (Window -> Window -> Window)
-> (Window -> Window -> Window)
-> Ord Window
Window -> Window -> Bool
Window -> Window -> Ordering
Window -> Window -> Window
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 :: Window -> Window -> Ordering
compare :: Window -> Window -> Ordering
$c< :: Window -> Window -> Bool
< :: Window -> Window -> Bool
$c<= :: Window -> Window -> Bool
<= :: Window -> Window -> Bool
$c> :: Window -> Window -> Bool
> :: Window -> Window -> Bool
$c>= :: Window -> Window -> Bool
>= :: Window -> Window -> Bool
$cmax :: Window -> Window -> Window
max :: Window -> Window -> Window
$cmin :: Window -> Window -> Window
min :: Window -> Window -> Window
Ord, Int -> Window -> ShowS
[Window] -> ShowS
Window -> String
(Int -> Window -> ShowS)
-> (Window -> String) -> ([Window] -> ShowS) -> Show Window
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Window -> ShowS
showsPrec :: Int -> Window -> ShowS
$cshow :: Window -> String
show :: Window -> String
$cshowList :: [Window] -> ShowS
showList :: [Window] -> ShowS
Show, Typeable)

-- | An SDL rendering device. This can be created with 'SDL.Video.createRenderer'.
newtype Renderer = Renderer Raw.Renderer
  deriving (Typeable Renderer
Typeable Renderer =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Renderer -> c Renderer)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Renderer)
-> (Renderer -> Constr)
-> (Renderer -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Renderer))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Renderer))
-> ((forall b. Data b => b -> b) -> Renderer -> Renderer)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Renderer -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Renderer -> r)
-> (forall u. (forall d. Data d => d -> u) -> Renderer -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Renderer -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> Renderer -> m Renderer)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Renderer -> m Renderer)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Renderer -> m Renderer)
-> Data Renderer
Renderer -> Constr
Renderer -> DataType
(forall b. Data b => b -> b) -> Renderer -> Renderer
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) -> Renderer -> u
forall u. (forall d. Data d => d -> u) -> Renderer -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Renderer -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Renderer -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Renderer -> m Renderer
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Renderer -> m Renderer
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Renderer
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Renderer -> c Renderer
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Renderer)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Renderer)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Renderer -> c Renderer
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Renderer -> c Renderer
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Renderer
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Renderer
$ctoConstr :: Renderer -> Constr
toConstr :: Renderer -> Constr
$cdataTypeOf :: Renderer -> DataType
dataTypeOf :: Renderer -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Renderer)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Renderer)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Renderer)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Renderer)
$cgmapT :: (forall b. Data b => b -> b) -> Renderer -> Renderer
gmapT :: (forall b. Data b => b -> b) -> Renderer -> Renderer
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Renderer -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Renderer -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Renderer -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Renderer -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Renderer -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Renderer -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Renderer -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Renderer -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Renderer -> m Renderer
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Renderer -> m Renderer
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Renderer -> m Renderer
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Renderer -> m Renderer
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Renderer -> m Renderer
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Renderer -> m Renderer
Data, Renderer -> Renderer -> Bool
(Renderer -> Renderer -> Bool)
-> (Renderer -> Renderer -> Bool) -> Eq Renderer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Renderer -> Renderer -> Bool
== :: Renderer -> Renderer -> Bool
$c/= :: Renderer -> Renderer -> Bool
/= :: Renderer -> Renderer -> Bool
Eq, (forall x. Renderer -> Rep Renderer x)
-> (forall x. Rep Renderer x -> Renderer) -> Generic Renderer
forall x. Rep Renderer x -> Renderer
forall x. Renderer -> Rep Renderer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Renderer -> Rep Renderer x
from :: forall x. Renderer -> Rep Renderer x
$cto :: forall x. Rep Renderer x -> Renderer
to :: forall x. Rep Renderer x -> Renderer
Generic, Eq Renderer
Eq Renderer =>
(Renderer -> Renderer -> Ordering)
-> (Renderer -> Renderer -> Bool)
-> (Renderer -> Renderer -> Bool)
-> (Renderer -> Renderer -> Bool)
-> (Renderer -> Renderer -> Bool)
-> (Renderer -> Renderer -> Renderer)
-> (Renderer -> Renderer -> Renderer)
-> Ord Renderer
Renderer -> Renderer -> Bool
Renderer -> Renderer -> Ordering
Renderer -> Renderer -> Renderer
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 :: Renderer -> Renderer -> Ordering
compare :: Renderer -> Renderer -> Ordering
$c< :: Renderer -> Renderer -> Bool
< :: Renderer -> Renderer -> Bool
$c<= :: Renderer -> Renderer -> Bool
<= :: Renderer -> Renderer -> Bool
$c> :: Renderer -> Renderer -> Bool
> :: Renderer -> Renderer -> Bool
$c>= :: Renderer -> Renderer -> Bool
>= :: Renderer -> Renderer -> Bool
$cmax :: Renderer -> Renderer -> Renderer
max :: Renderer -> Renderer -> Renderer
$cmin :: Renderer -> Renderer -> Renderer
min :: Renderer -> Renderer -> Renderer
Ord, Int -> Renderer -> ShowS
[Renderer] -> ShowS
Renderer -> String
(Int -> Renderer -> ShowS)
-> (Renderer -> String) -> ([Renderer] -> ShowS) -> Show Renderer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Renderer -> ShowS
showsPrec :: Int -> Renderer -> ShowS
$cshow :: Renderer -> String
show :: Renderer -> String
$cshowList :: [Renderer] -> ShowS
showList :: [Renderer] -> ShowS
Show, Typeable)