{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module SDL.Hint (
Hint(..),
setHintWithPriority,
HintPriority(..),
clearHints,
AccelerometerJoystickOptions(..),
FramebufferAccelerationOptions(..),
MacCTRLClickOptions(..),
MouseModeWarpOptions(..),
RenderDrivers(..),
RenderOpenGLShaderOptions(..),
RenderScaleQuality(..),
RenderVSyncOptions(..),
VideoWinD3DCompilerOptions(..)
) where
import Control.Exception
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Data (Data)
import Data.Maybe (fromMaybe)
import Data.StateVar
import Data.Typeable
import Foreign.C
import GHC.Generics (Generic)
import SDL.Exception
import qualified SDL.Raw as Raw
data AccelerometerJoystickOptions
= AccelerometerNotJoystick
| AccelerometerIsJoystick
deriving (AccelerometerJoystickOptions
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> Bounded AccelerometerJoystickOptions
forall a. a -> a -> Bounded a
$cminBound :: AccelerometerJoystickOptions
minBound :: AccelerometerJoystickOptions
$cmaxBound :: AccelerometerJoystickOptions
maxBound :: AccelerometerJoystickOptions
Bounded, Typeable AccelerometerJoystickOptions
Typeable AccelerometerJoystickOptions =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccelerometerJoystickOptions
-> c AccelerometerJoystickOptions)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c AccelerometerJoystickOptions)
-> (AccelerometerJoystickOptions -> Constr)
-> (AccelerometerJoystickOptions -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AccelerometerJoystickOptions))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccelerometerJoystickOptions))
-> ((forall b. Data b => b -> b)
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r)
-> (forall u.
(forall d. Data d => d -> u)
-> AccelerometerJoystickOptions -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u)
-> AccelerometerJoystickOptions
-> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions)
-> Data AccelerometerJoystickOptions
AccelerometerJoystickOptions -> Constr
AccelerometerJoystickOptions -> DataType
(forall b. Data b => b -> b)
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
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)
-> AccelerometerJoystickOptions
-> u
forall u.
(forall d. Data d => d -> u) -> AccelerometerJoystickOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccelerometerJoystickOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccelerometerJoystickOptions
-> c AccelerometerJoystickOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AccelerometerJoystickOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccelerometerJoystickOptions)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccelerometerJoystickOptions
-> c AccelerometerJoystickOptions
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccelerometerJoystickOptions
-> c AccelerometerJoystickOptions
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccelerometerJoystickOptions
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccelerometerJoystickOptions
$ctoConstr :: AccelerometerJoystickOptions -> Constr
toConstr :: AccelerometerJoystickOptions -> Constr
$cdataTypeOf :: AccelerometerJoystickOptions -> DataType
dataTypeOf :: AccelerometerJoystickOptions -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AccelerometerJoystickOptions)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AccelerometerJoystickOptions)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccelerometerJoystickOptions)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccelerometerJoystickOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
gmapT :: (forall b. Data b => b -> b)
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AccelerometerJoystickOptions -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AccelerometerJoystickOptions -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> AccelerometerJoystickOptions
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> AccelerometerJoystickOptions
-> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
Data, Int -> AccelerometerJoystickOptions
AccelerometerJoystickOptions -> Int
AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
AccelerometerJoystickOptions -> AccelerometerJoystickOptions
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> [AccelerometerJoystickOptions]
(AccelerometerJoystickOptions -> AccelerometerJoystickOptions)
-> (AccelerometerJoystickOptions -> AccelerometerJoystickOptions)
-> (Int -> AccelerometerJoystickOptions)
-> (AccelerometerJoystickOptions -> Int)
-> (AccelerometerJoystickOptions -> [AccelerometerJoystickOptions])
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions])
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions])
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> [AccelerometerJoystickOptions])
-> Enum AccelerometerJoystickOptions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AccelerometerJoystickOptions -> AccelerometerJoystickOptions
succ :: AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$cpred :: AccelerometerJoystickOptions -> AccelerometerJoystickOptions
pred :: AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$ctoEnum :: Int -> AccelerometerJoystickOptions
toEnum :: Int -> AccelerometerJoystickOptions
$cfromEnum :: AccelerometerJoystickOptions -> Int
fromEnum :: AccelerometerJoystickOptions -> Int
$cenumFrom :: AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
enumFrom :: AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
$cenumFromThen :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
enumFromThen :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
$cenumFromTo :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
enumFromTo :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
$cenumFromThenTo :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> [AccelerometerJoystickOptions]
enumFromThenTo :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> [AccelerometerJoystickOptions]
Enum, AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
(AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool)
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool)
-> Eq AccelerometerJoystickOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
== :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
$c/= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
/= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
Eq, (forall x.
AccelerometerJoystickOptions -> Rep AccelerometerJoystickOptions x)
-> (forall x.
Rep AccelerometerJoystickOptions x -> AccelerometerJoystickOptions)
-> Generic AccelerometerJoystickOptions
forall x.
Rep AccelerometerJoystickOptions x -> AccelerometerJoystickOptions
forall x.
AccelerometerJoystickOptions -> Rep AccelerometerJoystickOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
AccelerometerJoystickOptions -> Rep AccelerometerJoystickOptions x
from :: forall x.
AccelerometerJoystickOptions -> Rep AccelerometerJoystickOptions x
$cto :: forall x.
Rep AccelerometerJoystickOptions x -> AccelerometerJoystickOptions
to :: forall x.
Rep AccelerometerJoystickOptions x -> AccelerometerJoystickOptions
Generic, Eq AccelerometerJoystickOptions
Eq AccelerometerJoystickOptions =>
(AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Ordering)
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool)
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool)
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool)
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool)
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions)
-> (AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions)
-> Ord AccelerometerJoystickOptions
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Ordering
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
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 :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Ordering
compare :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Ordering
$c< :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
< :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
$c<= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
<= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
$c> :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
> :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
$c>= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
>= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
$cmax :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
max :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$cmin :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
min :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
Ord, ReadPrec [AccelerometerJoystickOptions]
ReadPrec AccelerometerJoystickOptions
Int -> ReadS AccelerometerJoystickOptions
ReadS [AccelerometerJoystickOptions]
(Int -> ReadS AccelerometerJoystickOptions)
-> ReadS [AccelerometerJoystickOptions]
-> ReadPrec AccelerometerJoystickOptions
-> ReadPrec [AccelerometerJoystickOptions]
-> Read AccelerometerJoystickOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AccelerometerJoystickOptions
readsPrec :: Int -> ReadS AccelerometerJoystickOptions
$creadList :: ReadS [AccelerometerJoystickOptions]
readList :: ReadS [AccelerometerJoystickOptions]
$creadPrec :: ReadPrec AccelerometerJoystickOptions
readPrec :: ReadPrec AccelerometerJoystickOptions
$creadListPrec :: ReadPrec [AccelerometerJoystickOptions]
readListPrec :: ReadPrec [AccelerometerJoystickOptions]
Read, Int -> AccelerometerJoystickOptions -> ShowS
[AccelerometerJoystickOptions] -> ShowS
AccelerometerJoystickOptions -> String
(Int -> AccelerometerJoystickOptions -> ShowS)
-> (AccelerometerJoystickOptions -> String)
-> ([AccelerometerJoystickOptions] -> ShowS)
-> Show AccelerometerJoystickOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccelerometerJoystickOptions -> ShowS
showsPrec :: Int -> AccelerometerJoystickOptions -> ShowS
$cshow :: AccelerometerJoystickOptions -> String
show :: AccelerometerJoystickOptions -> String
$cshowList :: [AccelerometerJoystickOptions] -> ShowS
showList :: [AccelerometerJoystickOptions] -> ShowS
Show, Typeable)
data FramebufferAccelerationOptions
= Disable3D
| Enable3DDefault
| Enable3DDirect3D
| Enable3DOpenGL
| Enable3DOpenGLES
| Enable3DOpenGLES2
| Enable3DSoftware
deriving (FramebufferAccelerationOptions
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> Bounded FramebufferAccelerationOptions
forall a. a -> a -> Bounded a
$cminBound :: FramebufferAccelerationOptions
minBound :: FramebufferAccelerationOptions
$cmaxBound :: FramebufferAccelerationOptions
maxBound :: FramebufferAccelerationOptions
Bounded, Typeable FramebufferAccelerationOptions
Typeable FramebufferAccelerationOptions =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FramebufferAccelerationOptions
-> c FramebufferAccelerationOptions)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c FramebufferAccelerationOptions)
-> (FramebufferAccelerationOptions -> Constr)
-> (FramebufferAccelerationOptions -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FramebufferAccelerationOptions))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FramebufferAccelerationOptions))
-> ((forall b. Data b => b -> b)
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r)
-> (forall u.
(forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions
-> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions)
-> Data FramebufferAccelerationOptions
FramebufferAccelerationOptions -> Constr
FramebufferAccelerationOptions -> DataType
(forall b. Data b => b -> b)
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
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)
-> FramebufferAccelerationOptions
-> u
forall u.
(forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c FramebufferAccelerationOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FramebufferAccelerationOptions
-> c FramebufferAccelerationOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FramebufferAccelerationOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FramebufferAccelerationOptions)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FramebufferAccelerationOptions
-> c FramebufferAccelerationOptions
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FramebufferAccelerationOptions
-> c FramebufferAccelerationOptions
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c FramebufferAccelerationOptions
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c FramebufferAccelerationOptions
$ctoConstr :: FramebufferAccelerationOptions -> Constr
toConstr :: FramebufferAccelerationOptions -> Constr
$cdataTypeOf :: FramebufferAccelerationOptions -> DataType
dataTypeOf :: FramebufferAccelerationOptions -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FramebufferAccelerationOptions)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FramebufferAccelerationOptions)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FramebufferAccelerationOptions)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FramebufferAccelerationOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
gmapT :: (forall b. Data b => b -> b)
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions
-> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions
-> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
Data, Int -> FramebufferAccelerationOptions
FramebufferAccelerationOptions -> Int
FramebufferAccelerationOptions -> [FramebufferAccelerationOptions]
FramebufferAccelerationOptions -> FramebufferAccelerationOptions
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
(FramebufferAccelerationOptions -> FramebufferAccelerationOptions)
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions)
-> (Int -> FramebufferAccelerationOptions)
-> (FramebufferAccelerationOptions -> Int)
-> (FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions])
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions])
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions])
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions])
-> Enum FramebufferAccelerationOptions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FramebufferAccelerationOptions -> FramebufferAccelerationOptions
succ :: FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$cpred :: FramebufferAccelerationOptions -> FramebufferAccelerationOptions
pred :: FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$ctoEnum :: Int -> FramebufferAccelerationOptions
toEnum :: Int -> FramebufferAccelerationOptions
$cfromEnum :: FramebufferAccelerationOptions -> Int
fromEnum :: FramebufferAccelerationOptions -> Int
$cenumFrom :: FramebufferAccelerationOptions -> [FramebufferAccelerationOptions]
enumFrom :: FramebufferAccelerationOptions -> [FramebufferAccelerationOptions]
$cenumFromThen :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
enumFromThen :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
$cenumFromTo :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
enumFromTo :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
$cenumFromThenTo :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
enumFromThenTo :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
Enum, FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
(FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool)
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool)
-> Eq FramebufferAccelerationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
== :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
$c/= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
/= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
Eq, (forall x.
FramebufferAccelerationOptions
-> Rep FramebufferAccelerationOptions x)
-> (forall x.
Rep FramebufferAccelerationOptions x
-> FramebufferAccelerationOptions)
-> Generic FramebufferAccelerationOptions
forall x.
Rep FramebufferAccelerationOptions x
-> FramebufferAccelerationOptions
forall x.
FramebufferAccelerationOptions
-> Rep FramebufferAccelerationOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
FramebufferAccelerationOptions
-> Rep FramebufferAccelerationOptions x
from :: forall x.
FramebufferAccelerationOptions
-> Rep FramebufferAccelerationOptions x
$cto :: forall x.
Rep FramebufferAccelerationOptions x
-> FramebufferAccelerationOptions
to :: forall x.
Rep FramebufferAccelerationOptions x
-> FramebufferAccelerationOptions
Generic, Eq FramebufferAccelerationOptions
Eq FramebufferAccelerationOptions =>
(FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Ordering)
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool)
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool)
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool)
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool)
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions)
-> (FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions)
-> Ord FramebufferAccelerationOptions
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Ordering
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
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 :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Ordering
compare :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Ordering
$c< :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
< :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
$c<= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
<= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
$c> :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
> :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
$c>= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
>= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
$cmax :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
max :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$cmin :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
min :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
Ord, ReadPrec [FramebufferAccelerationOptions]
ReadPrec FramebufferAccelerationOptions
Int -> ReadS FramebufferAccelerationOptions
ReadS [FramebufferAccelerationOptions]
(Int -> ReadS FramebufferAccelerationOptions)
-> ReadS [FramebufferAccelerationOptions]
-> ReadPrec FramebufferAccelerationOptions
-> ReadPrec [FramebufferAccelerationOptions]
-> Read FramebufferAccelerationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FramebufferAccelerationOptions
readsPrec :: Int -> ReadS FramebufferAccelerationOptions
$creadList :: ReadS [FramebufferAccelerationOptions]
readList :: ReadS [FramebufferAccelerationOptions]
$creadPrec :: ReadPrec FramebufferAccelerationOptions
readPrec :: ReadPrec FramebufferAccelerationOptions
$creadListPrec :: ReadPrec [FramebufferAccelerationOptions]
readListPrec :: ReadPrec [FramebufferAccelerationOptions]
Read, Int -> FramebufferAccelerationOptions -> ShowS
[FramebufferAccelerationOptions] -> ShowS
FramebufferAccelerationOptions -> String
(Int -> FramebufferAccelerationOptions -> ShowS)
-> (FramebufferAccelerationOptions -> String)
-> ([FramebufferAccelerationOptions] -> ShowS)
-> Show FramebufferAccelerationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FramebufferAccelerationOptions -> ShowS
showsPrec :: Int -> FramebufferAccelerationOptions -> ShowS
$cshow :: FramebufferAccelerationOptions -> String
show :: FramebufferAccelerationOptions -> String
$cshowList :: [FramebufferAccelerationOptions] -> ShowS
showList :: [FramebufferAccelerationOptions] -> ShowS
Show, Typeable)
data MacCTRLClickOptions
= NoRightClick
| EmulateRightClick
deriving (MacCTRLClickOptions
MacCTRLClickOptions
-> MacCTRLClickOptions -> Bounded MacCTRLClickOptions
forall a. a -> a -> Bounded a
$cminBound :: MacCTRLClickOptions
minBound :: MacCTRLClickOptions
$cmaxBound :: MacCTRLClickOptions
maxBound :: MacCTRLClickOptions
Bounded, Typeable MacCTRLClickOptions
Typeable MacCTRLClickOptions =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MacCTRLClickOptions
-> c MacCTRLClickOptions)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MacCTRLClickOptions)
-> (MacCTRLClickOptions -> Constr)
-> (MacCTRLClickOptions -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MacCTRLClickOptions))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MacCTRLClickOptions))
-> ((forall b. Data b => b -> b)
-> MacCTRLClickOptions -> MacCTRLClickOptions)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r)
-> (forall u.
(forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> MacCTRLClickOptions -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions)
-> Data MacCTRLClickOptions
MacCTRLClickOptions -> Constr
MacCTRLClickOptions -> DataType
(forall b. Data b => b -> b)
-> MacCTRLClickOptions -> MacCTRLClickOptions
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) -> MacCTRLClickOptions -> u
forall u.
(forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MacCTRLClickOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MacCTRLClickOptions
-> c MacCTRLClickOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MacCTRLClickOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MacCTRLClickOptions)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MacCTRLClickOptions
-> c MacCTRLClickOptions
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MacCTRLClickOptions
-> c MacCTRLClickOptions
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MacCTRLClickOptions
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MacCTRLClickOptions
$ctoConstr :: MacCTRLClickOptions -> Constr
toConstr :: MacCTRLClickOptions -> Constr
$cdataTypeOf :: MacCTRLClickOptions -> DataType
dataTypeOf :: MacCTRLClickOptions -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MacCTRLClickOptions)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MacCTRLClickOptions)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MacCTRLClickOptions)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MacCTRLClickOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> MacCTRLClickOptions -> MacCTRLClickOptions
gmapT :: (forall b. Data b => b -> b)
-> MacCTRLClickOptions -> MacCTRLClickOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MacCTRLClickOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MacCTRLClickOptions -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
Data, Int -> MacCTRLClickOptions
MacCTRLClickOptions -> Int
MacCTRLClickOptions -> [MacCTRLClickOptions]
MacCTRLClickOptions -> MacCTRLClickOptions
MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
MacCTRLClickOptions
-> MacCTRLClickOptions
-> MacCTRLClickOptions
-> [MacCTRLClickOptions]
(MacCTRLClickOptions -> MacCTRLClickOptions)
-> (MacCTRLClickOptions -> MacCTRLClickOptions)
-> (Int -> MacCTRLClickOptions)
-> (MacCTRLClickOptions -> Int)
-> (MacCTRLClickOptions -> [MacCTRLClickOptions])
-> (MacCTRLClickOptions
-> MacCTRLClickOptions -> [MacCTRLClickOptions])
-> (MacCTRLClickOptions
-> MacCTRLClickOptions -> [MacCTRLClickOptions])
-> (MacCTRLClickOptions
-> MacCTRLClickOptions
-> MacCTRLClickOptions
-> [MacCTRLClickOptions])
-> Enum MacCTRLClickOptions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MacCTRLClickOptions -> MacCTRLClickOptions
succ :: MacCTRLClickOptions -> MacCTRLClickOptions
$cpred :: MacCTRLClickOptions -> MacCTRLClickOptions
pred :: MacCTRLClickOptions -> MacCTRLClickOptions
$ctoEnum :: Int -> MacCTRLClickOptions
toEnum :: Int -> MacCTRLClickOptions
$cfromEnum :: MacCTRLClickOptions -> Int
fromEnum :: MacCTRLClickOptions -> Int
$cenumFrom :: MacCTRLClickOptions -> [MacCTRLClickOptions]
enumFrom :: MacCTRLClickOptions -> [MacCTRLClickOptions]
$cenumFromThen :: MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
enumFromThen :: MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
$cenumFromTo :: MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
enumFromTo :: MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
$cenumFromThenTo :: MacCTRLClickOptions
-> MacCTRLClickOptions
-> MacCTRLClickOptions
-> [MacCTRLClickOptions]
enumFromThenTo :: MacCTRLClickOptions
-> MacCTRLClickOptions
-> MacCTRLClickOptions
-> [MacCTRLClickOptions]
Enum, MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
(MacCTRLClickOptions -> MacCTRLClickOptions -> Bool)
-> (MacCTRLClickOptions -> MacCTRLClickOptions -> Bool)
-> Eq MacCTRLClickOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
== :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
$c/= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
/= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
Eq, (forall x. MacCTRLClickOptions -> Rep MacCTRLClickOptions x)
-> (forall x. Rep MacCTRLClickOptions x -> MacCTRLClickOptions)
-> Generic MacCTRLClickOptions
forall x. Rep MacCTRLClickOptions x -> MacCTRLClickOptions
forall x. MacCTRLClickOptions -> Rep MacCTRLClickOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MacCTRLClickOptions -> Rep MacCTRLClickOptions x
from :: forall x. MacCTRLClickOptions -> Rep MacCTRLClickOptions x
$cto :: forall x. Rep MacCTRLClickOptions x -> MacCTRLClickOptions
to :: forall x. Rep MacCTRLClickOptions x -> MacCTRLClickOptions
Generic, Eq MacCTRLClickOptions
Eq MacCTRLClickOptions =>
(MacCTRLClickOptions -> MacCTRLClickOptions -> Ordering)
-> (MacCTRLClickOptions -> MacCTRLClickOptions -> Bool)
-> (MacCTRLClickOptions -> MacCTRLClickOptions -> Bool)
-> (MacCTRLClickOptions -> MacCTRLClickOptions -> Bool)
-> (MacCTRLClickOptions -> MacCTRLClickOptions -> Bool)
-> (MacCTRLClickOptions
-> MacCTRLClickOptions -> MacCTRLClickOptions)
-> (MacCTRLClickOptions
-> MacCTRLClickOptions -> MacCTRLClickOptions)
-> Ord MacCTRLClickOptions
MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
MacCTRLClickOptions -> MacCTRLClickOptions -> Ordering
MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
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 :: MacCTRLClickOptions -> MacCTRLClickOptions -> Ordering
compare :: MacCTRLClickOptions -> MacCTRLClickOptions -> Ordering
$c< :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
< :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
$c<= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
<= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
$c> :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
> :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
$c>= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
>= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
$cmax :: MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
max :: MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
$cmin :: MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
min :: MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
Ord, ReadPrec [MacCTRLClickOptions]
ReadPrec MacCTRLClickOptions
Int -> ReadS MacCTRLClickOptions
ReadS [MacCTRLClickOptions]
(Int -> ReadS MacCTRLClickOptions)
-> ReadS [MacCTRLClickOptions]
-> ReadPrec MacCTRLClickOptions
-> ReadPrec [MacCTRLClickOptions]
-> Read MacCTRLClickOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MacCTRLClickOptions
readsPrec :: Int -> ReadS MacCTRLClickOptions
$creadList :: ReadS [MacCTRLClickOptions]
readList :: ReadS [MacCTRLClickOptions]
$creadPrec :: ReadPrec MacCTRLClickOptions
readPrec :: ReadPrec MacCTRLClickOptions
$creadListPrec :: ReadPrec [MacCTRLClickOptions]
readListPrec :: ReadPrec [MacCTRLClickOptions]
Read, Int -> MacCTRLClickOptions -> ShowS
[MacCTRLClickOptions] -> ShowS
MacCTRLClickOptions -> String
(Int -> MacCTRLClickOptions -> ShowS)
-> (MacCTRLClickOptions -> String)
-> ([MacCTRLClickOptions] -> ShowS)
-> Show MacCTRLClickOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MacCTRLClickOptions -> ShowS
showsPrec :: Int -> MacCTRLClickOptions -> ShowS
$cshow :: MacCTRLClickOptions -> String
show :: MacCTRLClickOptions -> String
$cshowList :: [MacCTRLClickOptions] -> ShowS
showList :: [MacCTRLClickOptions] -> ShowS
Show, Typeable)
data MouseModeWarpOptions
= MouseRawInput
| MouseWarping
deriving (MouseModeWarpOptions
MouseModeWarpOptions
-> MouseModeWarpOptions -> Bounded MouseModeWarpOptions
forall a. a -> a -> Bounded a
$cminBound :: MouseModeWarpOptions
minBound :: MouseModeWarpOptions
$cmaxBound :: MouseModeWarpOptions
maxBound :: MouseModeWarpOptions
Bounded, Typeable MouseModeWarpOptions
Typeable MouseModeWarpOptions =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MouseModeWarpOptions
-> c MouseModeWarpOptions)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseModeWarpOptions)
-> (MouseModeWarpOptions -> Constr)
-> (MouseModeWarpOptions -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseModeWarpOptions))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseModeWarpOptions))
-> ((forall b. Data b => b -> b)
-> MouseModeWarpOptions -> MouseModeWarpOptions)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r)
-> (forall u.
(forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> MouseModeWarpOptions -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions)
-> Data MouseModeWarpOptions
MouseModeWarpOptions -> Constr
MouseModeWarpOptions -> DataType
(forall b. Data b => b -> b)
-> MouseModeWarpOptions -> MouseModeWarpOptions
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) -> MouseModeWarpOptions -> u
forall u.
(forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseModeWarpOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MouseModeWarpOptions
-> c MouseModeWarpOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseModeWarpOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseModeWarpOptions)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MouseModeWarpOptions
-> c MouseModeWarpOptions
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MouseModeWarpOptions
-> c MouseModeWarpOptions
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseModeWarpOptions
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseModeWarpOptions
$ctoConstr :: MouseModeWarpOptions -> Constr
toConstr :: MouseModeWarpOptions -> Constr
$cdataTypeOf :: MouseModeWarpOptions -> DataType
dataTypeOf :: MouseModeWarpOptions -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseModeWarpOptions)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseModeWarpOptions)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseModeWarpOptions)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseModeWarpOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> MouseModeWarpOptions -> MouseModeWarpOptions
gmapT :: (forall b. Data b => b -> b)
-> MouseModeWarpOptions -> MouseModeWarpOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MouseModeWarpOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MouseModeWarpOptions -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
Data, Int -> MouseModeWarpOptions
MouseModeWarpOptions -> Int
MouseModeWarpOptions -> [MouseModeWarpOptions]
MouseModeWarpOptions -> MouseModeWarpOptions
MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
MouseModeWarpOptions
-> MouseModeWarpOptions
-> MouseModeWarpOptions
-> [MouseModeWarpOptions]
(MouseModeWarpOptions -> MouseModeWarpOptions)
-> (MouseModeWarpOptions -> MouseModeWarpOptions)
-> (Int -> MouseModeWarpOptions)
-> (MouseModeWarpOptions -> Int)
-> (MouseModeWarpOptions -> [MouseModeWarpOptions])
-> (MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions])
-> (MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions])
-> (MouseModeWarpOptions
-> MouseModeWarpOptions
-> MouseModeWarpOptions
-> [MouseModeWarpOptions])
-> Enum MouseModeWarpOptions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MouseModeWarpOptions -> MouseModeWarpOptions
succ :: MouseModeWarpOptions -> MouseModeWarpOptions
$cpred :: MouseModeWarpOptions -> MouseModeWarpOptions
pred :: MouseModeWarpOptions -> MouseModeWarpOptions
$ctoEnum :: Int -> MouseModeWarpOptions
toEnum :: Int -> MouseModeWarpOptions
$cfromEnum :: MouseModeWarpOptions -> Int
fromEnum :: MouseModeWarpOptions -> Int
$cenumFrom :: MouseModeWarpOptions -> [MouseModeWarpOptions]
enumFrom :: MouseModeWarpOptions -> [MouseModeWarpOptions]
$cenumFromThen :: MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
enumFromThen :: MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
$cenumFromTo :: MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
enumFromTo :: MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
$cenumFromThenTo :: MouseModeWarpOptions
-> MouseModeWarpOptions
-> MouseModeWarpOptions
-> [MouseModeWarpOptions]
enumFromThenTo :: MouseModeWarpOptions
-> MouseModeWarpOptions
-> MouseModeWarpOptions
-> [MouseModeWarpOptions]
Enum, MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
(MouseModeWarpOptions -> MouseModeWarpOptions -> Bool)
-> (MouseModeWarpOptions -> MouseModeWarpOptions -> Bool)
-> Eq MouseModeWarpOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
== :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
$c/= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
/= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
Eq, (forall x. MouseModeWarpOptions -> Rep MouseModeWarpOptions x)
-> (forall x. Rep MouseModeWarpOptions x -> MouseModeWarpOptions)
-> Generic MouseModeWarpOptions
forall x. Rep MouseModeWarpOptions x -> MouseModeWarpOptions
forall x. MouseModeWarpOptions -> Rep MouseModeWarpOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MouseModeWarpOptions -> Rep MouseModeWarpOptions x
from :: forall x. MouseModeWarpOptions -> Rep MouseModeWarpOptions x
$cto :: forall x. Rep MouseModeWarpOptions x -> MouseModeWarpOptions
to :: forall x. Rep MouseModeWarpOptions x -> MouseModeWarpOptions
Generic, Eq MouseModeWarpOptions
Eq MouseModeWarpOptions =>
(MouseModeWarpOptions -> MouseModeWarpOptions -> Ordering)
-> (MouseModeWarpOptions -> MouseModeWarpOptions -> Bool)
-> (MouseModeWarpOptions -> MouseModeWarpOptions -> Bool)
-> (MouseModeWarpOptions -> MouseModeWarpOptions -> Bool)
-> (MouseModeWarpOptions -> MouseModeWarpOptions -> Bool)
-> (MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions)
-> (MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions)
-> Ord MouseModeWarpOptions
MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
MouseModeWarpOptions -> MouseModeWarpOptions -> Ordering
MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
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 :: MouseModeWarpOptions -> MouseModeWarpOptions -> Ordering
compare :: MouseModeWarpOptions -> MouseModeWarpOptions -> Ordering
$c< :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
< :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
$c<= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
<= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
$c> :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
> :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
$c>= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
>= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
$cmax :: MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
max :: MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
$cmin :: MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
min :: MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
Ord, ReadPrec [MouseModeWarpOptions]
ReadPrec MouseModeWarpOptions
Int -> ReadS MouseModeWarpOptions
ReadS [MouseModeWarpOptions]
(Int -> ReadS MouseModeWarpOptions)
-> ReadS [MouseModeWarpOptions]
-> ReadPrec MouseModeWarpOptions
-> ReadPrec [MouseModeWarpOptions]
-> Read MouseModeWarpOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MouseModeWarpOptions
readsPrec :: Int -> ReadS MouseModeWarpOptions
$creadList :: ReadS [MouseModeWarpOptions]
readList :: ReadS [MouseModeWarpOptions]
$creadPrec :: ReadPrec MouseModeWarpOptions
readPrec :: ReadPrec MouseModeWarpOptions
$creadListPrec :: ReadPrec [MouseModeWarpOptions]
readListPrec :: ReadPrec [MouseModeWarpOptions]
Read, Int -> MouseModeWarpOptions -> ShowS
[MouseModeWarpOptions] -> ShowS
MouseModeWarpOptions -> String
(Int -> MouseModeWarpOptions -> ShowS)
-> (MouseModeWarpOptions -> String)
-> ([MouseModeWarpOptions] -> ShowS)
-> Show MouseModeWarpOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseModeWarpOptions -> ShowS
showsPrec :: Int -> MouseModeWarpOptions -> ShowS
$cshow :: MouseModeWarpOptions -> String
show :: MouseModeWarpOptions -> String
$cshowList :: [MouseModeWarpOptions] -> ShowS
showList :: [MouseModeWarpOptions] -> ShowS
Show, Typeable)
data RenderDrivers
= Direct3D
| OpenGL
| OpenGLES
| OpenGLES2
| Software
deriving (RenderDrivers
RenderDrivers -> RenderDrivers -> Bounded RenderDrivers
forall a. a -> a -> Bounded a
$cminBound :: RenderDrivers
minBound :: RenderDrivers
$cmaxBound :: RenderDrivers
maxBound :: RenderDrivers
Bounded, Typeable RenderDrivers
Typeable RenderDrivers =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RenderDrivers -> c RenderDrivers)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderDrivers)
-> (RenderDrivers -> Constr)
-> (RenderDrivers -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderDrivers))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderDrivers))
-> ((forall b. Data b => b -> b) -> RenderDrivers -> RenderDrivers)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r)
-> (forall u. (forall d. Data d => d -> u) -> RenderDrivers -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RenderDrivers -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers)
-> Data RenderDrivers
RenderDrivers -> Constr
RenderDrivers -> DataType
(forall b. Data b => b -> b) -> RenderDrivers -> RenderDrivers
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) -> RenderDrivers -> u
forall u. (forall d. Data d => d -> u) -> RenderDrivers -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderDrivers
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RenderDrivers -> c RenderDrivers
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderDrivers)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderDrivers)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RenderDrivers -> c RenderDrivers
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RenderDrivers -> c RenderDrivers
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderDrivers
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderDrivers
$ctoConstr :: RenderDrivers -> Constr
toConstr :: RenderDrivers -> Constr
$cdataTypeOf :: RenderDrivers -> DataType
dataTypeOf :: RenderDrivers -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderDrivers)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderDrivers)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderDrivers)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderDrivers)
$cgmapT :: (forall b. Data b => b -> b) -> RenderDrivers -> RenderDrivers
gmapT :: (forall b. Data b => b -> b) -> RenderDrivers -> RenderDrivers
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderDrivers -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RenderDrivers -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RenderDrivers -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RenderDrivers -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
Data, Int -> RenderDrivers
RenderDrivers -> Int
RenderDrivers -> [RenderDrivers]
RenderDrivers -> RenderDrivers
RenderDrivers -> RenderDrivers -> [RenderDrivers]
RenderDrivers -> RenderDrivers -> RenderDrivers -> [RenderDrivers]
(RenderDrivers -> RenderDrivers)
-> (RenderDrivers -> RenderDrivers)
-> (Int -> RenderDrivers)
-> (RenderDrivers -> Int)
-> (RenderDrivers -> [RenderDrivers])
-> (RenderDrivers -> RenderDrivers -> [RenderDrivers])
-> (RenderDrivers -> RenderDrivers -> [RenderDrivers])
-> (RenderDrivers
-> RenderDrivers -> RenderDrivers -> [RenderDrivers])
-> Enum RenderDrivers
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RenderDrivers -> RenderDrivers
succ :: RenderDrivers -> RenderDrivers
$cpred :: RenderDrivers -> RenderDrivers
pred :: RenderDrivers -> RenderDrivers
$ctoEnum :: Int -> RenderDrivers
toEnum :: Int -> RenderDrivers
$cfromEnum :: RenderDrivers -> Int
fromEnum :: RenderDrivers -> Int
$cenumFrom :: RenderDrivers -> [RenderDrivers]
enumFrom :: RenderDrivers -> [RenderDrivers]
$cenumFromThen :: RenderDrivers -> RenderDrivers -> [RenderDrivers]
enumFromThen :: RenderDrivers -> RenderDrivers -> [RenderDrivers]
$cenumFromTo :: RenderDrivers -> RenderDrivers -> [RenderDrivers]
enumFromTo :: RenderDrivers -> RenderDrivers -> [RenderDrivers]
$cenumFromThenTo :: RenderDrivers -> RenderDrivers -> RenderDrivers -> [RenderDrivers]
enumFromThenTo :: RenderDrivers -> RenderDrivers -> RenderDrivers -> [RenderDrivers]
Enum, RenderDrivers -> RenderDrivers -> Bool
(RenderDrivers -> RenderDrivers -> Bool)
-> (RenderDrivers -> RenderDrivers -> Bool) -> Eq RenderDrivers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderDrivers -> RenderDrivers -> Bool
== :: RenderDrivers -> RenderDrivers -> Bool
$c/= :: RenderDrivers -> RenderDrivers -> Bool
/= :: RenderDrivers -> RenderDrivers -> Bool
Eq, (forall x. RenderDrivers -> Rep RenderDrivers x)
-> (forall x. Rep RenderDrivers x -> RenderDrivers)
-> Generic RenderDrivers
forall x. Rep RenderDrivers x -> RenderDrivers
forall x. RenderDrivers -> Rep RenderDrivers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RenderDrivers -> Rep RenderDrivers x
from :: forall x. RenderDrivers -> Rep RenderDrivers x
$cto :: forall x. Rep RenderDrivers x -> RenderDrivers
to :: forall x. Rep RenderDrivers x -> RenderDrivers
Generic, Eq RenderDrivers
Eq RenderDrivers =>
(RenderDrivers -> RenderDrivers -> Ordering)
-> (RenderDrivers -> RenderDrivers -> Bool)
-> (RenderDrivers -> RenderDrivers -> Bool)
-> (RenderDrivers -> RenderDrivers -> Bool)
-> (RenderDrivers -> RenderDrivers -> Bool)
-> (RenderDrivers -> RenderDrivers -> RenderDrivers)
-> (RenderDrivers -> RenderDrivers -> RenderDrivers)
-> Ord RenderDrivers
RenderDrivers -> RenderDrivers -> Bool
RenderDrivers -> RenderDrivers -> Ordering
RenderDrivers -> RenderDrivers -> RenderDrivers
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 :: RenderDrivers -> RenderDrivers -> Ordering
compare :: RenderDrivers -> RenderDrivers -> Ordering
$c< :: RenderDrivers -> RenderDrivers -> Bool
< :: RenderDrivers -> RenderDrivers -> Bool
$c<= :: RenderDrivers -> RenderDrivers -> Bool
<= :: RenderDrivers -> RenderDrivers -> Bool
$c> :: RenderDrivers -> RenderDrivers -> Bool
> :: RenderDrivers -> RenderDrivers -> Bool
$c>= :: RenderDrivers -> RenderDrivers -> Bool
>= :: RenderDrivers -> RenderDrivers -> Bool
$cmax :: RenderDrivers -> RenderDrivers -> RenderDrivers
max :: RenderDrivers -> RenderDrivers -> RenderDrivers
$cmin :: RenderDrivers -> RenderDrivers -> RenderDrivers
min :: RenderDrivers -> RenderDrivers -> RenderDrivers
Ord, ReadPrec [RenderDrivers]
ReadPrec RenderDrivers
Int -> ReadS RenderDrivers
ReadS [RenderDrivers]
(Int -> ReadS RenderDrivers)
-> ReadS [RenderDrivers]
-> ReadPrec RenderDrivers
-> ReadPrec [RenderDrivers]
-> Read RenderDrivers
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RenderDrivers
readsPrec :: Int -> ReadS RenderDrivers
$creadList :: ReadS [RenderDrivers]
readList :: ReadS [RenderDrivers]
$creadPrec :: ReadPrec RenderDrivers
readPrec :: ReadPrec RenderDrivers
$creadListPrec :: ReadPrec [RenderDrivers]
readListPrec :: ReadPrec [RenderDrivers]
Read, Int -> RenderDrivers -> ShowS
[RenderDrivers] -> ShowS
RenderDrivers -> String
(Int -> RenderDrivers -> ShowS)
-> (RenderDrivers -> String)
-> ([RenderDrivers] -> ShowS)
-> Show RenderDrivers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderDrivers -> ShowS
showsPrec :: Int -> RenderDrivers -> ShowS
$cshow :: RenderDrivers -> String
show :: RenderDrivers -> String
$cshowList :: [RenderDrivers] -> ShowS
showList :: [RenderDrivers] -> ShowS
Show, Typeable)
data RenderOpenGLShaderOptions
= DisableShaders
| EnableShaders
deriving (RenderOpenGLShaderOptions
RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> Bounded RenderOpenGLShaderOptions
forall a. a -> a -> Bounded a
$cminBound :: RenderOpenGLShaderOptions
minBound :: RenderOpenGLShaderOptions
$cmaxBound :: RenderOpenGLShaderOptions
maxBound :: RenderOpenGLShaderOptions
Bounded, Typeable RenderOpenGLShaderOptions
Typeable RenderOpenGLShaderOptions =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderOpenGLShaderOptions
-> c RenderOpenGLShaderOptions)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderOpenGLShaderOptions)
-> (RenderOpenGLShaderOptions -> Constr)
-> (RenderOpenGLShaderOptions -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RenderOpenGLShaderOptions))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderOpenGLShaderOptions))
-> ((forall b. Data b => b -> b)
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions)
-> Data RenderOpenGLShaderOptions
RenderOpenGLShaderOptions -> Constr
RenderOpenGLShaderOptions -> DataType
(forall b. Data b => b -> b)
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
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) -> RenderOpenGLShaderOptions -> u
forall u.
(forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderOpenGLShaderOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderOpenGLShaderOptions
-> c RenderOpenGLShaderOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RenderOpenGLShaderOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderOpenGLShaderOptions)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderOpenGLShaderOptions
-> c RenderOpenGLShaderOptions
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderOpenGLShaderOptions
-> c RenderOpenGLShaderOptions
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderOpenGLShaderOptions
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderOpenGLShaderOptions
$ctoConstr :: RenderOpenGLShaderOptions -> Constr
toConstr :: RenderOpenGLShaderOptions -> Constr
$cdataTypeOf :: RenderOpenGLShaderOptions -> DataType
dataTypeOf :: RenderOpenGLShaderOptions -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RenderOpenGLShaderOptions)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RenderOpenGLShaderOptions)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderOpenGLShaderOptions)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderOpenGLShaderOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
gmapT :: (forall b. Data b => b -> b)
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
Data, Int -> RenderOpenGLShaderOptions
RenderOpenGLShaderOptions -> Int
RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> [RenderOpenGLShaderOptions]
(RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions)
-> (RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions)
-> (Int -> RenderOpenGLShaderOptions)
-> (RenderOpenGLShaderOptions -> Int)
-> (RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions])
-> (RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions])
-> (RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions])
-> (RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> [RenderOpenGLShaderOptions])
-> Enum RenderOpenGLShaderOptions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
succ :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$cpred :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
pred :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$ctoEnum :: Int -> RenderOpenGLShaderOptions
toEnum :: Int -> RenderOpenGLShaderOptions
$cfromEnum :: RenderOpenGLShaderOptions -> Int
fromEnum :: RenderOpenGLShaderOptions -> Int
$cenumFrom :: RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
enumFrom :: RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
$cenumFromThen :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
enumFromThen :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
$cenumFromTo :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
enumFromTo :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
$cenumFromThenTo :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> [RenderOpenGLShaderOptions]
enumFromThenTo :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> [RenderOpenGLShaderOptions]
Enum, RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
(RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool)
-> (RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool)
-> Eq RenderOpenGLShaderOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
== :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
$c/= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
/= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
Eq, (forall x.
RenderOpenGLShaderOptions -> Rep RenderOpenGLShaderOptions x)
-> (forall x.
Rep RenderOpenGLShaderOptions x -> RenderOpenGLShaderOptions)
-> Generic RenderOpenGLShaderOptions
forall x.
Rep RenderOpenGLShaderOptions x -> RenderOpenGLShaderOptions
forall x.
RenderOpenGLShaderOptions -> Rep RenderOpenGLShaderOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RenderOpenGLShaderOptions -> Rep RenderOpenGLShaderOptions x
from :: forall x.
RenderOpenGLShaderOptions -> Rep RenderOpenGLShaderOptions x
$cto :: forall x.
Rep RenderOpenGLShaderOptions x -> RenderOpenGLShaderOptions
to :: forall x.
Rep RenderOpenGLShaderOptions x -> RenderOpenGLShaderOptions
Generic, Eq RenderOpenGLShaderOptions
Eq RenderOpenGLShaderOptions =>
(RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> Ordering)
-> (RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool)
-> (RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool)
-> (RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool)
-> (RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool)
-> (RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions)
-> (RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions)
-> Ord RenderOpenGLShaderOptions
RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Ordering
RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
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 :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Ordering
compare :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Ordering
$c< :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
< :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
$c<= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
<= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
$c> :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
> :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
$c>= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
>= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
$cmax :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
max :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$cmin :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
min :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
Ord, ReadPrec [RenderOpenGLShaderOptions]
ReadPrec RenderOpenGLShaderOptions
Int -> ReadS RenderOpenGLShaderOptions
ReadS [RenderOpenGLShaderOptions]
(Int -> ReadS RenderOpenGLShaderOptions)
-> ReadS [RenderOpenGLShaderOptions]
-> ReadPrec RenderOpenGLShaderOptions
-> ReadPrec [RenderOpenGLShaderOptions]
-> Read RenderOpenGLShaderOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RenderOpenGLShaderOptions
readsPrec :: Int -> ReadS RenderOpenGLShaderOptions
$creadList :: ReadS [RenderOpenGLShaderOptions]
readList :: ReadS [RenderOpenGLShaderOptions]
$creadPrec :: ReadPrec RenderOpenGLShaderOptions
readPrec :: ReadPrec RenderOpenGLShaderOptions
$creadListPrec :: ReadPrec [RenderOpenGLShaderOptions]
readListPrec :: ReadPrec [RenderOpenGLShaderOptions]
Read, Int -> RenderOpenGLShaderOptions -> ShowS
[RenderOpenGLShaderOptions] -> ShowS
RenderOpenGLShaderOptions -> String
(Int -> RenderOpenGLShaderOptions -> ShowS)
-> (RenderOpenGLShaderOptions -> String)
-> ([RenderOpenGLShaderOptions] -> ShowS)
-> Show RenderOpenGLShaderOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderOpenGLShaderOptions -> ShowS
showsPrec :: Int -> RenderOpenGLShaderOptions -> ShowS
$cshow :: RenderOpenGLShaderOptions -> String
show :: RenderOpenGLShaderOptions -> String
$cshowList :: [RenderOpenGLShaderOptions] -> ShowS
showList :: [RenderOpenGLShaderOptions] -> ShowS
Show, Typeable)
data RenderScaleQuality
= ScaleNearest
| ScaleLinear
| ScaleBest
deriving (RenderScaleQuality
RenderScaleQuality
-> RenderScaleQuality -> Bounded RenderScaleQuality
forall a. a -> a -> Bounded a
$cminBound :: RenderScaleQuality
minBound :: RenderScaleQuality
$cmaxBound :: RenderScaleQuality
maxBound :: RenderScaleQuality
Bounded, Typeable RenderScaleQuality
Typeable RenderScaleQuality =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderScaleQuality
-> c RenderScaleQuality)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderScaleQuality)
-> (RenderScaleQuality -> Constr)
-> (RenderScaleQuality -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderScaleQuality))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderScaleQuality))
-> ((forall b. Data b => b -> b)
-> RenderScaleQuality -> RenderScaleQuality)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r)
-> (forall u.
(forall d. Data d => d -> u) -> RenderScaleQuality -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RenderScaleQuality -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality)
-> Data RenderScaleQuality
RenderScaleQuality -> Constr
RenderScaleQuality -> DataType
(forall b. Data b => b -> b)
-> RenderScaleQuality -> RenderScaleQuality
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) -> RenderScaleQuality -> u
forall u. (forall d. Data d => d -> u) -> RenderScaleQuality -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderScaleQuality
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderScaleQuality
-> c RenderScaleQuality
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderScaleQuality)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderScaleQuality)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderScaleQuality
-> c RenderScaleQuality
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderScaleQuality
-> c RenderScaleQuality
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderScaleQuality
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderScaleQuality
$ctoConstr :: RenderScaleQuality -> Constr
toConstr :: RenderScaleQuality -> Constr
$cdataTypeOf :: RenderScaleQuality -> DataType
dataTypeOf :: RenderScaleQuality -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderScaleQuality)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderScaleQuality)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderScaleQuality)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderScaleQuality)
$cgmapT :: (forall b. Data b => b -> b)
-> RenderScaleQuality -> RenderScaleQuality
gmapT :: (forall b. Data b => b -> b)
-> RenderScaleQuality -> RenderScaleQuality
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderScaleQuality -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RenderScaleQuality -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderScaleQuality -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderScaleQuality -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
Data, Int -> RenderScaleQuality
RenderScaleQuality -> Int
RenderScaleQuality -> [RenderScaleQuality]
RenderScaleQuality -> RenderScaleQuality
RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
RenderScaleQuality
-> RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
(RenderScaleQuality -> RenderScaleQuality)
-> (RenderScaleQuality -> RenderScaleQuality)
-> (Int -> RenderScaleQuality)
-> (RenderScaleQuality -> Int)
-> (RenderScaleQuality -> [RenderScaleQuality])
-> (RenderScaleQuality
-> RenderScaleQuality -> [RenderScaleQuality])
-> (RenderScaleQuality
-> RenderScaleQuality -> [RenderScaleQuality])
-> (RenderScaleQuality
-> RenderScaleQuality
-> RenderScaleQuality
-> [RenderScaleQuality])
-> Enum RenderScaleQuality
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RenderScaleQuality -> RenderScaleQuality
succ :: RenderScaleQuality -> RenderScaleQuality
$cpred :: RenderScaleQuality -> RenderScaleQuality
pred :: RenderScaleQuality -> RenderScaleQuality
$ctoEnum :: Int -> RenderScaleQuality
toEnum :: Int -> RenderScaleQuality
$cfromEnum :: RenderScaleQuality -> Int
fromEnum :: RenderScaleQuality -> Int
$cenumFrom :: RenderScaleQuality -> [RenderScaleQuality]
enumFrom :: RenderScaleQuality -> [RenderScaleQuality]
$cenumFromThen :: RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
enumFromThen :: RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
$cenumFromTo :: RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
enumFromTo :: RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
$cenumFromThenTo :: RenderScaleQuality
-> RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
enumFromThenTo :: RenderScaleQuality
-> RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
Enum, RenderScaleQuality -> RenderScaleQuality -> Bool
(RenderScaleQuality -> RenderScaleQuality -> Bool)
-> (RenderScaleQuality -> RenderScaleQuality -> Bool)
-> Eq RenderScaleQuality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderScaleQuality -> RenderScaleQuality -> Bool
== :: RenderScaleQuality -> RenderScaleQuality -> Bool
$c/= :: RenderScaleQuality -> RenderScaleQuality -> Bool
/= :: RenderScaleQuality -> RenderScaleQuality -> Bool
Eq, (forall x. RenderScaleQuality -> Rep RenderScaleQuality x)
-> (forall x. Rep RenderScaleQuality x -> RenderScaleQuality)
-> Generic RenderScaleQuality
forall x. Rep RenderScaleQuality x -> RenderScaleQuality
forall x. RenderScaleQuality -> Rep RenderScaleQuality x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RenderScaleQuality -> Rep RenderScaleQuality x
from :: forall x. RenderScaleQuality -> Rep RenderScaleQuality x
$cto :: forall x. Rep RenderScaleQuality x -> RenderScaleQuality
to :: forall x. Rep RenderScaleQuality x -> RenderScaleQuality
Generic, Eq RenderScaleQuality
Eq RenderScaleQuality =>
(RenderScaleQuality -> RenderScaleQuality -> Ordering)
-> (RenderScaleQuality -> RenderScaleQuality -> Bool)
-> (RenderScaleQuality -> RenderScaleQuality -> Bool)
-> (RenderScaleQuality -> RenderScaleQuality -> Bool)
-> (RenderScaleQuality -> RenderScaleQuality -> Bool)
-> (RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality)
-> (RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality)
-> Ord RenderScaleQuality
RenderScaleQuality -> RenderScaleQuality -> Bool
RenderScaleQuality -> RenderScaleQuality -> Ordering
RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
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 :: RenderScaleQuality -> RenderScaleQuality -> Ordering
compare :: RenderScaleQuality -> RenderScaleQuality -> Ordering
$c< :: RenderScaleQuality -> RenderScaleQuality -> Bool
< :: RenderScaleQuality -> RenderScaleQuality -> Bool
$c<= :: RenderScaleQuality -> RenderScaleQuality -> Bool
<= :: RenderScaleQuality -> RenderScaleQuality -> Bool
$c> :: RenderScaleQuality -> RenderScaleQuality -> Bool
> :: RenderScaleQuality -> RenderScaleQuality -> Bool
$c>= :: RenderScaleQuality -> RenderScaleQuality -> Bool
>= :: RenderScaleQuality -> RenderScaleQuality -> Bool
$cmax :: RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
max :: RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
$cmin :: RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
min :: RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
Ord, ReadPrec [RenderScaleQuality]
ReadPrec RenderScaleQuality
Int -> ReadS RenderScaleQuality
ReadS [RenderScaleQuality]
(Int -> ReadS RenderScaleQuality)
-> ReadS [RenderScaleQuality]
-> ReadPrec RenderScaleQuality
-> ReadPrec [RenderScaleQuality]
-> Read RenderScaleQuality
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RenderScaleQuality
readsPrec :: Int -> ReadS RenderScaleQuality
$creadList :: ReadS [RenderScaleQuality]
readList :: ReadS [RenderScaleQuality]
$creadPrec :: ReadPrec RenderScaleQuality
readPrec :: ReadPrec RenderScaleQuality
$creadListPrec :: ReadPrec [RenderScaleQuality]
readListPrec :: ReadPrec [RenderScaleQuality]
Read, Int -> RenderScaleQuality -> ShowS
[RenderScaleQuality] -> ShowS
RenderScaleQuality -> String
(Int -> RenderScaleQuality -> ShowS)
-> (RenderScaleQuality -> String)
-> ([RenderScaleQuality] -> ShowS)
-> Show RenderScaleQuality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderScaleQuality -> ShowS
showsPrec :: Int -> RenderScaleQuality -> ShowS
$cshow :: RenderScaleQuality -> String
show :: RenderScaleQuality -> String
$cshowList :: [RenderScaleQuality] -> ShowS
showList :: [RenderScaleQuality] -> ShowS
Show, Typeable)
data RenderVSyncOptions
= DisableVSync
| EnableVSync
deriving (RenderVSyncOptions
RenderVSyncOptions
-> RenderVSyncOptions -> Bounded RenderVSyncOptions
forall a. a -> a -> Bounded a
$cminBound :: RenderVSyncOptions
minBound :: RenderVSyncOptions
$cmaxBound :: RenderVSyncOptions
maxBound :: RenderVSyncOptions
Bounded, Typeable RenderVSyncOptions
Typeable RenderVSyncOptions =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderVSyncOptions
-> c RenderVSyncOptions)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderVSyncOptions)
-> (RenderVSyncOptions -> Constr)
-> (RenderVSyncOptions -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderVSyncOptions))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderVSyncOptions))
-> ((forall b. Data b => b -> b)
-> RenderVSyncOptions -> RenderVSyncOptions)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r)
-> (forall u.
(forall d. Data d => d -> u) -> RenderVSyncOptions -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RenderVSyncOptions -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions)
-> Data RenderVSyncOptions
RenderVSyncOptions -> Constr
RenderVSyncOptions -> DataType
(forall b. Data b => b -> b)
-> RenderVSyncOptions -> RenderVSyncOptions
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) -> RenderVSyncOptions -> u
forall u. (forall d. Data d => d -> u) -> RenderVSyncOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderVSyncOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderVSyncOptions
-> c RenderVSyncOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderVSyncOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderVSyncOptions)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderVSyncOptions
-> c RenderVSyncOptions
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderVSyncOptions
-> c RenderVSyncOptions
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderVSyncOptions
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderVSyncOptions
$ctoConstr :: RenderVSyncOptions -> Constr
toConstr :: RenderVSyncOptions -> Constr
$cdataTypeOf :: RenderVSyncOptions -> DataType
dataTypeOf :: RenderVSyncOptions -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderVSyncOptions)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderVSyncOptions)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderVSyncOptions)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderVSyncOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> RenderVSyncOptions -> RenderVSyncOptions
gmapT :: (forall b. Data b => b -> b)
-> RenderVSyncOptions -> RenderVSyncOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderVSyncOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RenderVSyncOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderVSyncOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderVSyncOptions -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
Data, Int -> RenderVSyncOptions
RenderVSyncOptions -> Int
RenderVSyncOptions -> [RenderVSyncOptions]
RenderVSyncOptions -> RenderVSyncOptions
RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
RenderVSyncOptions
-> RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
(RenderVSyncOptions -> RenderVSyncOptions)
-> (RenderVSyncOptions -> RenderVSyncOptions)
-> (Int -> RenderVSyncOptions)
-> (RenderVSyncOptions -> Int)
-> (RenderVSyncOptions -> [RenderVSyncOptions])
-> (RenderVSyncOptions
-> RenderVSyncOptions -> [RenderVSyncOptions])
-> (RenderVSyncOptions
-> RenderVSyncOptions -> [RenderVSyncOptions])
-> (RenderVSyncOptions
-> RenderVSyncOptions
-> RenderVSyncOptions
-> [RenderVSyncOptions])
-> Enum RenderVSyncOptions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RenderVSyncOptions -> RenderVSyncOptions
succ :: RenderVSyncOptions -> RenderVSyncOptions
$cpred :: RenderVSyncOptions -> RenderVSyncOptions
pred :: RenderVSyncOptions -> RenderVSyncOptions
$ctoEnum :: Int -> RenderVSyncOptions
toEnum :: Int -> RenderVSyncOptions
$cfromEnum :: RenderVSyncOptions -> Int
fromEnum :: RenderVSyncOptions -> Int
$cenumFrom :: RenderVSyncOptions -> [RenderVSyncOptions]
enumFrom :: RenderVSyncOptions -> [RenderVSyncOptions]
$cenumFromThen :: RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
enumFromThen :: RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
$cenumFromTo :: RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
enumFromTo :: RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
$cenumFromThenTo :: RenderVSyncOptions
-> RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
enumFromThenTo :: RenderVSyncOptions
-> RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
Enum, RenderVSyncOptions -> RenderVSyncOptions -> Bool
(RenderVSyncOptions -> RenderVSyncOptions -> Bool)
-> (RenderVSyncOptions -> RenderVSyncOptions -> Bool)
-> Eq RenderVSyncOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
== :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
$c/= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
/= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
Eq, (forall x. RenderVSyncOptions -> Rep RenderVSyncOptions x)
-> (forall x. Rep RenderVSyncOptions x -> RenderVSyncOptions)
-> Generic RenderVSyncOptions
forall x. Rep RenderVSyncOptions x -> RenderVSyncOptions
forall x. RenderVSyncOptions -> Rep RenderVSyncOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RenderVSyncOptions -> Rep RenderVSyncOptions x
from :: forall x. RenderVSyncOptions -> Rep RenderVSyncOptions x
$cto :: forall x. Rep RenderVSyncOptions x -> RenderVSyncOptions
to :: forall x. Rep RenderVSyncOptions x -> RenderVSyncOptions
Generic, Eq RenderVSyncOptions
Eq RenderVSyncOptions =>
(RenderVSyncOptions -> RenderVSyncOptions -> Ordering)
-> (RenderVSyncOptions -> RenderVSyncOptions -> Bool)
-> (RenderVSyncOptions -> RenderVSyncOptions -> Bool)
-> (RenderVSyncOptions -> RenderVSyncOptions -> Bool)
-> (RenderVSyncOptions -> RenderVSyncOptions -> Bool)
-> (RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions)
-> (RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions)
-> Ord RenderVSyncOptions
RenderVSyncOptions -> RenderVSyncOptions -> Bool
RenderVSyncOptions -> RenderVSyncOptions -> Ordering
RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
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 :: RenderVSyncOptions -> RenderVSyncOptions -> Ordering
compare :: RenderVSyncOptions -> RenderVSyncOptions -> Ordering
$c< :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
< :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
$c<= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
<= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
$c> :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
> :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
$c>= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
>= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
$cmax :: RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
max :: RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
$cmin :: RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
min :: RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
Ord, ReadPrec [RenderVSyncOptions]
ReadPrec RenderVSyncOptions
Int -> ReadS RenderVSyncOptions
ReadS [RenderVSyncOptions]
(Int -> ReadS RenderVSyncOptions)
-> ReadS [RenderVSyncOptions]
-> ReadPrec RenderVSyncOptions
-> ReadPrec [RenderVSyncOptions]
-> Read RenderVSyncOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RenderVSyncOptions
readsPrec :: Int -> ReadS RenderVSyncOptions
$creadList :: ReadS [RenderVSyncOptions]
readList :: ReadS [RenderVSyncOptions]
$creadPrec :: ReadPrec RenderVSyncOptions
readPrec :: ReadPrec RenderVSyncOptions
$creadListPrec :: ReadPrec [RenderVSyncOptions]
readListPrec :: ReadPrec [RenderVSyncOptions]
Read, Int -> RenderVSyncOptions -> ShowS
[RenderVSyncOptions] -> ShowS
RenderVSyncOptions -> String
(Int -> RenderVSyncOptions -> ShowS)
-> (RenderVSyncOptions -> String)
-> ([RenderVSyncOptions] -> ShowS)
-> Show RenderVSyncOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderVSyncOptions -> ShowS
showsPrec :: Int -> RenderVSyncOptions -> ShowS
$cshow :: RenderVSyncOptions -> String
show :: RenderVSyncOptions -> String
$cshowList :: [RenderVSyncOptions] -> ShowS
showList :: [RenderVSyncOptions] -> ShowS
Show, Typeable)
data VideoWinD3DCompilerOptions
= D3DVistaOrLater
| D3DXPSupport
| D3DNone
deriving (VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Bounded VideoWinD3DCompilerOptions
forall a. a -> a -> Bounded a
$cminBound :: VideoWinD3DCompilerOptions
minBound :: VideoWinD3DCompilerOptions
$cmaxBound :: VideoWinD3DCompilerOptions
maxBound :: VideoWinD3DCompilerOptions
Bounded, Typeable VideoWinD3DCompilerOptions
Typeable VideoWinD3DCompilerOptions =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VideoWinD3DCompilerOptions
-> c VideoWinD3DCompilerOptions)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoWinD3DCompilerOptions)
-> (VideoWinD3DCompilerOptions -> Constr)
-> (VideoWinD3DCompilerOptions -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VideoWinD3DCompilerOptions))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VideoWinD3DCompilerOptions))
-> ((forall b. Data b => b -> b)
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions)
-> (forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r)
-> (forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r)
-> (forall u.
(forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u])
-> (forall u.
Int
-> (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions)
-> Data VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions -> Constr
VideoWinD3DCompilerOptions -> DataType
(forall b. Data b => b -> b)
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
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) -> VideoWinD3DCompilerOptions -> u
forall u.
(forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoWinD3DCompilerOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VideoWinD3DCompilerOptions
-> c VideoWinD3DCompilerOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VideoWinD3DCompilerOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VideoWinD3DCompilerOptions)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VideoWinD3DCompilerOptions
-> c VideoWinD3DCompilerOptions
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VideoWinD3DCompilerOptions
-> c VideoWinD3DCompilerOptions
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoWinD3DCompilerOptions
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoWinD3DCompilerOptions
$ctoConstr :: VideoWinD3DCompilerOptions -> Constr
toConstr :: VideoWinD3DCompilerOptions -> Constr
$cdataTypeOf :: VideoWinD3DCompilerOptions -> DataType
dataTypeOf :: VideoWinD3DCompilerOptions -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VideoWinD3DCompilerOptions)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VideoWinD3DCompilerOptions)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VideoWinD3DCompilerOptions)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VideoWinD3DCompilerOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
gmapT :: (forall b. Data b => b -> b)
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u]
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> u
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
Data, Int -> VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions -> Int
VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> [VideoWinD3DCompilerOptions]
(VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions)
-> (VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions)
-> (Int -> VideoWinD3DCompilerOptions)
-> (VideoWinD3DCompilerOptions -> Int)
-> (VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions])
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions])
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions])
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> [VideoWinD3DCompilerOptions])
-> Enum VideoWinD3DCompilerOptions
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
succ :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$cpred :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
pred :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$ctoEnum :: Int -> VideoWinD3DCompilerOptions
toEnum :: Int -> VideoWinD3DCompilerOptions
$cfromEnum :: VideoWinD3DCompilerOptions -> Int
fromEnum :: VideoWinD3DCompilerOptions -> Int
$cenumFrom :: VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
enumFrom :: VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
$cenumFromThen :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
enumFromThen :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
$cenumFromTo :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
enumFromTo :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
$cenumFromThenTo :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> [VideoWinD3DCompilerOptions]
enumFromThenTo :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> [VideoWinD3DCompilerOptions]
Enum, VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
(VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool)
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Bool)
-> Eq VideoWinD3DCompilerOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
== :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
$c/= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
/= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
Eq, (forall x.
VideoWinD3DCompilerOptions -> Rep VideoWinD3DCompilerOptions x)
-> (forall x.
Rep VideoWinD3DCompilerOptions x -> VideoWinD3DCompilerOptions)
-> Generic VideoWinD3DCompilerOptions
forall x.
Rep VideoWinD3DCompilerOptions x -> VideoWinD3DCompilerOptions
forall x.
VideoWinD3DCompilerOptions -> Rep VideoWinD3DCompilerOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
VideoWinD3DCompilerOptions -> Rep VideoWinD3DCompilerOptions x
from :: forall x.
VideoWinD3DCompilerOptions -> Rep VideoWinD3DCompilerOptions x
$cto :: forall x.
Rep VideoWinD3DCompilerOptions x -> VideoWinD3DCompilerOptions
to :: forall x.
Rep VideoWinD3DCompilerOptions x -> VideoWinD3DCompilerOptions
Generic, Eq VideoWinD3DCompilerOptions
Eq VideoWinD3DCompilerOptions =>
(VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Ordering)
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Bool)
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Bool)
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Bool)
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Bool)
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions)
-> (VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions)
-> Ord VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Ordering
VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
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 :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Ordering
compare :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Ordering
$c< :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
< :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
$c<= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
<= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
$c> :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
> :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
$c>= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
>= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
$cmax :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
max :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$cmin :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
min :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
Ord, ReadPrec [VideoWinD3DCompilerOptions]
ReadPrec VideoWinD3DCompilerOptions
Int -> ReadS VideoWinD3DCompilerOptions
ReadS [VideoWinD3DCompilerOptions]
(Int -> ReadS VideoWinD3DCompilerOptions)
-> ReadS [VideoWinD3DCompilerOptions]
-> ReadPrec VideoWinD3DCompilerOptions
-> ReadPrec [VideoWinD3DCompilerOptions]
-> Read VideoWinD3DCompilerOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS VideoWinD3DCompilerOptions
readsPrec :: Int -> ReadS VideoWinD3DCompilerOptions
$creadList :: ReadS [VideoWinD3DCompilerOptions]
readList :: ReadS [VideoWinD3DCompilerOptions]
$creadPrec :: ReadPrec VideoWinD3DCompilerOptions
readPrec :: ReadPrec VideoWinD3DCompilerOptions
$creadListPrec :: ReadPrec [VideoWinD3DCompilerOptions]
readListPrec :: ReadPrec [VideoWinD3DCompilerOptions]
Read, Int -> VideoWinD3DCompilerOptions -> ShowS
[VideoWinD3DCompilerOptions] -> ShowS
VideoWinD3DCompilerOptions -> String
(Int -> VideoWinD3DCompilerOptions -> ShowS)
-> (VideoWinD3DCompilerOptions -> String)
-> ([VideoWinD3DCompilerOptions] -> ShowS)
-> Show VideoWinD3DCompilerOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VideoWinD3DCompilerOptions -> ShowS
showsPrec :: Int -> VideoWinD3DCompilerOptions -> ShowS
$cshow :: VideoWinD3DCompilerOptions -> String
show :: VideoWinD3DCompilerOptions -> String
$cshowList :: [VideoWinD3DCompilerOptions] -> ShowS
showList :: [VideoWinD3DCompilerOptions] -> ShowS
Show, Typeable)
data Hint v where
HintAccelerometerAsJoystick :: Hint AccelerometerJoystickOptions
HintFramebufferAcceleration :: Hint FramebufferAccelerationOptions
HintMacCTRLClick :: Hint MacCTRLClickOptions
HintMouseRelativeModeWarp :: Hint MouseModeWarpOptions
HintRenderDriver :: Hint RenderDrivers
HintRenderOpenGLShaders :: Hint RenderOpenGLShaderOptions
HintRenderScaleQuality :: Hint RenderScaleQuality
HintRenderVSync :: Hint RenderVSyncOptions
HintVideoWinD3DCompiler :: Hint VideoWinD3DCompilerOptions
instance HasSetter (Hint v) v where
Hint v
hint $= :: forall (m :: Type -> Type). MonadIO m => Hint v -> v -> m ()
$= v
v =
(CString -> CString -> IO ()) -> Hint v -> v -> m ()
forall (m :: Type -> Type) a v.
MonadIO m =>
(CString -> CString -> IO a) -> Hint v -> v -> m a
_setHint (\CString
name CString
value ->
IO Bool -> IO ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (CString -> CString -> IO Bool
forall (m :: Type -> Type).
MonadIO m =>
CString -> CString -> m Bool
Raw.setHint CString
name CString
value))
Hint v
hint
v
v
data HintPriority
= DefaultPriority
| NormalPriority
| OverridePriority
deriving (HintPriority
HintPriority -> HintPriority -> Bounded HintPriority
forall a. a -> a -> Bounded a
$cminBound :: HintPriority
minBound :: HintPriority
$cmaxBound :: HintPriority
maxBound :: HintPriority
Bounded, Typeable HintPriority
Typeable HintPriority =>
(forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HintPriority -> c HintPriority)
-> (forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HintPriority)
-> (HintPriority -> Constr)
-> (HintPriority -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HintPriority))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HintPriority))
-> ((forall b. Data b => b -> b) -> HintPriority -> HintPriority)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r)
-> (forall u. (forall d. Data d => d -> u) -> HintPriority -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> HintPriority -> u)
-> (forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority)
-> (forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority)
-> Data HintPriority
HintPriority -> Constr
HintPriority -> DataType
(forall b. Data b => b -> b) -> HintPriority -> HintPriority
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) -> HintPriority -> u
forall u. (forall d. Data d => d -> u) -> HintPriority -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HintPriority
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HintPriority -> c HintPriority
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HintPriority)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HintPriority)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HintPriority -> c HintPriority
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HintPriority -> c HintPriority
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HintPriority
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HintPriority
$ctoConstr :: HintPriority -> Constr
toConstr :: HintPriority -> Constr
$cdataTypeOf :: HintPriority -> DataType
dataTypeOf :: HintPriority -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HintPriority)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HintPriority)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HintPriority)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HintPriority)
$cgmapT :: (forall b. Data b => b -> b) -> HintPriority -> HintPriority
gmapT :: (forall b. Data b => b -> b) -> HintPriority -> HintPriority
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HintPriority -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> HintPriority -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HintPriority -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HintPriority -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
Data, Int -> HintPriority
HintPriority -> Int
HintPriority -> [HintPriority]
HintPriority -> HintPriority
HintPriority -> HintPriority -> [HintPriority]
HintPriority -> HintPriority -> HintPriority -> [HintPriority]
(HintPriority -> HintPriority)
-> (HintPriority -> HintPriority)
-> (Int -> HintPriority)
-> (HintPriority -> Int)
-> (HintPriority -> [HintPriority])
-> (HintPriority -> HintPriority -> [HintPriority])
-> (HintPriority -> HintPriority -> [HintPriority])
-> (HintPriority -> HintPriority -> HintPriority -> [HintPriority])
-> Enum HintPriority
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: HintPriority -> HintPriority
succ :: HintPriority -> HintPriority
$cpred :: HintPriority -> HintPriority
pred :: HintPriority -> HintPriority
$ctoEnum :: Int -> HintPriority
toEnum :: Int -> HintPriority
$cfromEnum :: HintPriority -> Int
fromEnum :: HintPriority -> Int
$cenumFrom :: HintPriority -> [HintPriority]
enumFrom :: HintPriority -> [HintPriority]
$cenumFromThen :: HintPriority -> HintPriority -> [HintPriority]
enumFromThen :: HintPriority -> HintPriority -> [HintPriority]
$cenumFromTo :: HintPriority -> HintPriority -> [HintPriority]
enumFromTo :: HintPriority -> HintPriority -> [HintPriority]
$cenumFromThenTo :: HintPriority -> HintPriority -> HintPriority -> [HintPriority]
enumFromThenTo :: HintPriority -> HintPriority -> HintPriority -> [HintPriority]
Enum, HintPriority -> HintPriority -> Bool
(HintPriority -> HintPriority -> Bool)
-> (HintPriority -> HintPriority -> Bool) -> Eq HintPriority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HintPriority -> HintPriority -> Bool
== :: HintPriority -> HintPriority -> Bool
$c/= :: HintPriority -> HintPriority -> Bool
/= :: HintPriority -> HintPriority -> Bool
Eq, (forall x. HintPriority -> Rep HintPriority x)
-> (forall x. Rep HintPriority x -> HintPriority)
-> Generic HintPriority
forall x. Rep HintPriority x -> HintPriority
forall x. HintPriority -> Rep HintPriority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HintPriority -> Rep HintPriority x
from :: forall x. HintPriority -> Rep HintPriority x
$cto :: forall x. Rep HintPriority x -> HintPriority
to :: forall x. Rep HintPriority x -> HintPriority
Generic, Eq HintPriority
Eq HintPriority =>
(HintPriority -> HintPriority -> Ordering)
-> (HintPriority -> HintPriority -> Bool)
-> (HintPriority -> HintPriority -> Bool)
-> (HintPriority -> HintPriority -> Bool)
-> (HintPriority -> HintPriority -> Bool)
-> (HintPriority -> HintPriority -> HintPriority)
-> (HintPriority -> HintPriority -> HintPriority)
-> Ord HintPriority
HintPriority -> HintPriority -> Bool
HintPriority -> HintPriority -> Ordering
HintPriority -> HintPriority -> HintPriority
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 :: HintPriority -> HintPriority -> Ordering
compare :: HintPriority -> HintPriority -> Ordering
$c< :: HintPriority -> HintPriority -> Bool
< :: HintPriority -> HintPriority -> Bool
$c<= :: HintPriority -> HintPriority -> Bool
<= :: HintPriority -> HintPriority -> Bool
$c> :: HintPriority -> HintPriority -> Bool
> :: HintPriority -> HintPriority -> Bool
$c>= :: HintPriority -> HintPriority -> Bool
>= :: HintPriority -> HintPriority -> Bool
$cmax :: HintPriority -> HintPriority -> HintPriority
max :: HintPriority -> HintPriority -> HintPriority
$cmin :: HintPriority -> HintPriority -> HintPriority
min :: HintPriority -> HintPriority -> HintPriority
Ord, ReadPrec [HintPriority]
ReadPrec HintPriority
Int -> ReadS HintPriority
ReadS [HintPriority]
(Int -> ReadS HintPriority)
-> ReadS [HintPriority]
-> ReadPrec HintPriority
-> ReadPrec [HintPriority]
-> Read HintPriority
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HintPriority
readsPrec :: Int -> ReadS HintPriority
$creadList :: ReadS [HintPriority]
readList :: ReadS [HintPriority]
$creadPrec :: ReadPrec HintPriority
readPrec :: ReadPrec HintPriority
$creadListPrec :: ReadPrec [HintPriority]
readListPrec :: ReadPrec [HintPriority]
Read, Int -> HintPriority -> ShowS
[HintPriority] -> ShowS
HintPriority -> String
(Int -> HintPriority -> ShowS)
-> (HintPriority -> String)
-> ([HintPriority] -> ShowS)
-> Show HintPriority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HintPriority -> ShowS
showsPrec :: Int -> HintPriority -> ShowS
$cshow :: HintPriority -> String
show :: HintPriority -> String
$cshowList :: [HintPriority] -> ShowS
showList :: [HintPriority] -> ShowS
Show, Typeable)
setHintWithPriority :: MonadIO m => HintPriority -> Hint v -> v -> m Bool
setHintWithPriority :: forall (m :: Type -> Type) v.
MonadIO m =>
HintPriority -> Hint v -> v -> m Bool
setHintWithPriority HintPriority
prio =
(CString -> CString -> IO Bool) -> Hint v -> v -> m Bool
forall (m :: Type -> Type) a v.
MonadIO m =>
(CString -> CString -> IO a) -> Hint v -> v -> m a
_setHint (\CString
name CString
value ->
CString -> CString -> HintPriority -> IO Bool
forall (m :: Type -> Type).
MonadIO m =>
CString -> CString -> HintPriority -> m Bool
Raw.setHintWithPriority
CString
name
CString
value
(case HintPriority
prio of
HintPriority
DefaultPriority -> HintPriority
Raw.SDL_HINT_DEFAULT
HintPriority
NormalPriority -> HintPriority
Raw.SDL_HINT_NORMAL
HintPriority
OverridePriority -> HintPriority
Raw.SDL_HINT_OVERRIDE))
_setHint :: MonadIO m => (CString -> CString -> IO a) -> Hint v -> v -> m a
_setHint :: forall (m :: Type -> Type) a v.
MonadIO m =>
(CString -> CString -> IO a) -> Hint v -> v -> m a
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintAccelerometerAsJoystick v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
AccelerometerJoystickOptions
AccelerometerNotJoystick -> String
"0"
v
AccelerometerJoystickOptions
AccelerometerIsJoystick -> String
"1")
(CString -> CString -> IO a
f CString
hint)
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintFramebufferAcceleration v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
FramebufferAccelerationOptions
Disable3D -> String
"0"
v
FramebufferAccelerationOptions
Enable3DDefault -> String
"1"
v
FramebufferAccelerationOptions
Enable3DDirect3D -> String
"direct3d"
v
FramebufferAccelerationOptions
Enable3DOpenGL -> String
"opengl"
v
FramebufferAccelerationOptions
Enable3DOpenGLES -> String
"opengles"
v
FramebufferAccelerationOptions
Enable3DOpenGLES2 -> String
"opengles2"
v
FramebufferAccelerationOptions
Enable3DSoftware -> String
"software"
)
(CString -> CString -> IO a
f CString
hint)
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintMacCTRLClick v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
MacCTRLClickOptions
NoRightClick -> String
"0"
v
MacCTRLClickOptions
EmulateRightClick -> String
"1")
(CString -> CString -> IO a
f CString
hint)
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintMouseRelativeModeWarp v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
MouseModeWarpOptions
MouseRawInput -> String
"0"
v
MouseModeWarpOptions
MouseWarping -> String
"1")
(CString -> CString -> IO a
f CString
hint)
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintRenderDriver v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
RenderDrivers
Direct3D -> String
"direct3d"
v
RenderDrivers
OpenGL -> String
"opengl"
v
RenderDrivers
OpenGLES -> String
"opengles"
v
RenderDrivers
OpenGLES2 -> String
"opengles2"
v
RenderDrivers
Software -> String
"software")
(CString -> CString -> IO a
f CString
hint)
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintRenderOpenGLShaders v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
RenderOpenGLShaderOptions
DisableShaders -> String
"0"
v
RenderOpenGLShaderOptions
EnableShaders -> String
"1")
(CString -> CString -> IO a
f CString
hint)
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintRenderScaleQuality v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
RenderScaleQuality
ScaleNearest -> String
"0"
v
RenderScaleQuality
ScaleLinear -> String
"1"
v
RenderScaleQuality
ScaleBest -> String
"2")
(CString -> CString -> IO a
f CString
hint)
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintRenderVSync v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
RenderVSyncOptions
DisableVSync -> String
"0"
v
RenderVSyncOptions
EnableVSync -> String
"1")
(CString -> CString -> IO a
f CString
hint)
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintVideoWinD3DCompiler v
v = IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
hint ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString
(case v
v of
v
VideoWinD3DCompilerOptions
D3DVistaOrLater -> String
"d3dcompiler_46.dll"
v
VideoWinD3DCompilerOptions
D3DXPSupport -> String
"d3dcompiler_43.dll"
v
VideoWinD3DCompilerOptions
D3DNone -> String
"none")
(CString -> CString -> IO a
f CString
hint)
mapHint :: MonadIO m => Hint v -> (String -> Maybe v) -> m v
mapHint :: forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h String -> Maybe v
f = IO v -> m v
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO v -> m v) -> IO v -> m v
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO v) -> IO v
forall a. String -> (CString -> IO a) -> IO a
withCString (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) ((CString -> IO v) -> IO v) -> (CString -> IO v) -> IO v
forall a b. (a -> b) -> a -> b
$ \CString
hint -> do
String
strResult <- CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< CString -> IO CString
forall (m :: Type -> Type). MonadIO m => CString -> m CString
Raw.getHint CString
hint
v -> IO v
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (v -> IO v) -> v -> IO v
forall a b. (a -> b) -> a -> b
$! v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe
(SDLException -> v
forall a e. Exception e => e -> a
throw (String -> String -> SDLException
SDLUnknownHintValue (Hint v -> String
forall v. Hint v -> String
hintToString Hint v
h) String
strResult))
(String -> Maybe v
f String
strResult)
instance HasGetter (Hint v) v where
get :: forall (m :: Type -> Type). MonadIO m => Hint v -> m v
get h :: Hint v
h@Hint v
HintAccelerometerAsJoystick =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"0" -> v -> Maybe v
forall a. a -> Maybe a
Just v
AccelerometerJoystickOptions
AccelerometerNotJoystick
String
"1" -> v -> Maybe v
forall a. a -> Maybe a
Just v
AccelerometerJoystickOptions
AccelerometerIsJoystick
String
_ -> Maybe v
forall a. Maybe a
Nothing)
get h :: Hint v
h@Hint v
HintFramebufferAcceleration =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"0" -> v -> Maybe v
forall a. a -> Maybe a
Just v
FramebufferAccelerationOptions
Disable3D
String
"1" -> v -> Maybe v
forall a. a -> Maybe a
Just v
FramebufferAccelerationOptions
Enable3DDefault
String
"direct3d" -> v -> Maybe v
forall a. a -> Maybe a
Just v
FramebufferAccelerationOptions
Enable3DDirect3D
String
"opengl" -> v -> Maybe v
forall a. a -> Maybe a
Just v
FramebufferAccelerationOptions
Enable3DOpenGL
String
"opengles" -> v -> Maybe v
forall a. a -> Maybe a
Just v
FramebufferAccelerationOptions
Enable3DOpenGLES
String
"opengles2" -> v -> Maybe v
forall a. a -> Maybe a
Just v
FramebufferAccelerationOptions
Enable3DOpenGLES2
String
"software" -> v -> Maybe v
forall a. a -> Maybe a
Just v
FramebufferAccelerationOptions
Enable3DSoftware
String
_ -> Maybe v
forall a. Maybe a
Nothing)
get h :: Hint v
h@Hint v
HintMacCTRLClick =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"0" -> v -> Maybe v
forall a. a -> Maybe a
Just v
MacCTRLClickOptions
NoRightClick
String
"1" -> v -> Maybe v
forall a. a -> Maybe a
Just v
MacCTRLClickOptions
EmulateRightClick
String
_ -> Maybe v
forall a. Maybe a
Nothing)
get h :: Hint v
h@Hint v
HintMouseRelativeModeWarp =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"0" -> v -> Maybe v
forall a. a -> Maybe a
Just v
MouseModeWarpOptions
MouseRawInput
String
"1" -> v -> Maybe v
forall a. a -> Maybe a
Just v
MouseModeWarpOptions
MouseWarping
String
_ -> Maybe v
forall a. Maybe a
Nothing)
get h :: Hint v
h@Hint v
HintRenderDriver =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"direct3d" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderDrivers
Direct3D
String
"opengl" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderDrivers
OpenGL
String
"opengles" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderDrivers
OpenGLES
String
"opengles2" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderDrivers
OpenGLES2
String
"software" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderDrivers
Software
String
_ -> Maybe v
forall a. Maybe a
Nothing)
get h :: Hint v
h@Hint v
HintRenderOpenGLShaders =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"0" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderOpenGLShaderOptions
DisableShaders
String
"1" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderOpenGLShaderOptions
EnableShaders
String
_ -> Maybe v
forall a. Maybe a
Nothing)
get h :: Hint v
h@Hint v
HintRenderScaleQuality =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"0" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderScaleQuality
ScaleNearest
String
"1" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderScaleQuality
ScaleLinear
String
"2" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderScaleQuality
ScaleBest
String
_ -> Maybe v
forall a. Maybe a
Nothing)
get h :: Hint v
h@Hint v
HintRenderVSync =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"0" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderVSyncOptions
DisableVSync
String
"1" -> v -> Maybe v
forall a. a -> Maybe a
Just v
RenderVSyncOptions
EnableVSync
String
_ -> Maybe v
forall a. Maybe a
Nothing)
get h :: Hint v
h@Hint v
HintVideoWinD3DCompiler =
Hint v -> (String -> Maybe v) -> m v
forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
String
"d3dcompiler_46.dll" -> v -> Maybe v
forall a. a -> Maybe a
Just v
VideoWinD3DCompilerOptions
D3DVistaOrLater
String
"d3dcompiler_43.dll" -> v -> Maybe v
forall a. a -> Maybe a
Just v
VideoWinD3DCompilerOptions
D3DXPSupport
String
"none" -> v -> Maybe v
forall a. a -> Maybe a
Just v
VideoWinD3DCompilerOptions
D3DNone
String
_ -> Maybe v
forall a. Maybe a
Nothing)
hintToString :: Hint v -> String
hintToString :: forall v. Hint v -> String
hintToString Hint v
HintAccelerometerAsJoystick = String
"SDL_ACCELEROMETER_AS_JOYSTICK"
hintToString Hint v
HintFramebufferAcceleration = String
"SDL_FRAMEBUFFER_ACCELERATION"
hintToString Hint v
HintMacCTRLClick = String
"SDL_MAC_CTRL_CLICK_EMULATE_RIGHT_CLICK"
hintToString Hint v
HintMouseRelativeModeWarp = String
"SDL_MOUSE_RELATIVE_MODE_WARP"
hintToString Hint v
HintRenderDriver = String
"SDL_RENDER_DRIVER"
hintToString Hint v
HintRenderOpenGLShaders = String
"SDL_RENDER_OPENGL_SHADERS"
hintToString Hint v
HintRenderScaleQuality = String
"SDL_RENDER_SCALE_QUALITY"
hintToString Hint v
HintRenderVSync = String
"SDL_RENDER_VSYNC"
hintToString Hint v
HintVideoWinD3DCompiler = String
"SDL_VIDEO_WIN_D3DCOMPILER"
clearHints :: MonadIO m => m ()
clearHints :: forall (m :: Type -> Type). MonadIO m => m ()
clearHints = m ()
forall (m :: Type -> Type). MonadIO m => m ()
Raw.clearHints