{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module SDL.Hint (
  -- * Getting and setting hints
  Hint(..),
  setHintWithPriority,
  HintPriority(..),
  clearHints,

  -- * Hint Information
  -- ** 'HintAccelerometerAsJoystick'
  AccelerometerJoystickOptions(..),

  -- ** 'HintFramebufferAcceleration'
  FramebufferAccelerationOptions(..),

  -- ** 'HintMacCTRLClick'
  MacCTRLClickOptions(..),

  -- ** 'HintMouseRelativeModeWarp'
  MouseModeWarpOptions(..),

  -- ** 'HintRenderDriver'
  RenderDrivers(..),

  -- ** 'HintRenderOpenGLShaders'
  RenderOpenGLShaderOptions(..),

  -- ** 'HintRenderScaleQuality'
  RenderScaleQuality(..),

  -- ** 'HintRenderVSync'
  RenderVSyncOptions(..),

  -- ** 'HintVideoWinD3DCompiler'
  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

-- | A hint that specifies whether the Android\/iOS built-in accelerometer should
-- be listed as a joystick device, rather than listing actual joysticks only.
-- By default SDL will list real joysticks along with the accelerometer as if it
-- were a 3 axis joystick.
data AccelerometerJoystickOptions
  = AccelerometerNotJoystick
    -- ^ List only real joysticks and accept input from them
  | AccelerometerIsJoystick
    -- ^ List real joysticks along with the accelerometer as if it were a 3 axis
    -- joystick (the default)
  deriving (AccelerometerJoystickOptions
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> Bounded AccelerometerJoystickOptions
forall a. a -> a -> Bounded a
maxBound :: AccelerometerJoystickOptions
$cmaxBound :: AccelerometerJoystickOptions
minBound :: AccelerometerJoystickOptions
$cminBound :: AccelerometerJoystickOptions
Bounded, Typeable AccelerometerJoystickOptions
DataType
Constr
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 -> DataType
AccelerometerJoystickOptions -> Constr
(forall b. Data b => b -> b)
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccelerometerJoystickOptions
-> c AccelerometerJoystickOptions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cAccelerometerIsJoystick :: Constr
$cAccelerometerNotJoystick :: Constr
$tAccelerometerJoystickOptions :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> AccelerometerJoystickOptions
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> AccelerometerJoystickOptions
-> u
gmapQ :: (forall d. Data d => d -> u) -> AccelerometerJoystickOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AccelerometerJoystickOptions -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
gmapT :: (forall b. Data b => b -> b)
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$cgmapT :: (forall b. Data b => b -> b)
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c AccelerometerJoystickOptions)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AccelerometerJoystickOptions)
dataTypeOf :: AccelerometerJoystickOptions -> DataType
$cdataTypeOf :: AccelerometerJoystickOptions -> DataType
toConstr :: AccelerometerJoystickOptions -> Constr
$ctoConstr :: AccelerometerJoystickOptions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccelerometerJoystickOptions
-> 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
$cp1Data :: Typeable 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
enumFromThenTo :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> [AccelerometerJoystickOptions]
$cenumFromThenTo :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> [AccelerometerJoystickOptions]
enumFromTo :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
$cenumFromTo :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
enumFromThen :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
$cenumFromThen :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
enumFrom :: AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
$cenumFrom :: AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
fromEnum :: AccelerometerJoystickOptions -> Int
$cfromEnum :: AccelerometerJoystickOptions -> Int
toEnum :: Int -> AccelerometerJoystickOptions
$ctoEnum :: Int -> AccelerometerJoystickOptions
pred :: AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$cpred :: AccelerometerJoystickOptions -> AccelerometerJoystickOptions
succ :: AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$csucc :: AccelerometerJoystickOptions -> AccelerometerJoystickOptions
Enum, AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
(AccelerometerJoystickOptions
 -> AccelerometerJoystickOptions -> Bool)
-> (AccelerometerJoystickOptions
    -> AccelerometerJoystickOptions -> Bool)
-> Eq AccelerometerJoystickOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
$c/= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
== :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
$c== :: 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
$cto :: forall x.
Rep AccelerometerJoystickOptions x -> AccelerometerJoystickOptions
$cfrom :: forall x.
AccelerometerJoystickOptions -> Rep AccelerometerJoystickOptions x
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
min :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$cmin :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
max :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
$cmax :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
>= :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Bool
$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
compare :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Ordering
$ccompare :: AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [AccelerometerJoystickOptions]
$creadListPrec :: ReadPrec [AccelerometerJoystickOptions]
readPrec :: ReadPrec AccelerometerJoystickOptions
$creadPrec :: ReadPrec AccelerometerJoystickOptions
readList :: ReadS [AccelerometerJoystickOptions]
$creadList :: ReadS [AccelerometerJoystickOptions]
readsPrec :: Int -> ReadS AccelerometerJoystickOptions
$creadsPrec :: Int -> ReadS 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
showList :: [AccelerometerJoystickOptions] -> ShowS
$cshowList :: [AccelerometerJoystickOptions] -> ShowS
show :: AccelerometerJoystickOptions -> String
$cshow :: AccelerometerJoystickOptions -> String
showsPrec :: Int -> AccelerometerJoystickOptions -> ShowS
$cshowsPrec :: Int -> AccelerometerJoystickOptions -> ShowS
Show, Typeable)

-- | A hint that specifies how 3D acceleration is used to accelerate the SDL
-- screen surface. By default SDL tries to make a best guess whether to use
-- acceleration or not on each platform.
data FramebufferAccelerationOptions
  = Disable3D -- ^ Disable 3D acceleration
  | Enable3DDefault -- ^ Enable 3D acceleration, using the default renderer
  | Enable3DDirect3D -- ^ Enable 3D acceleration using Direct3D
  | Enable3DOpenGL -- ^ Enable 3D acceleration using OpenGL
  | Enable3DOpenGLES -- ^ Enable 3D acceleration using OpenGLES
  | Enable3DOpenGLES2 -- ^ Enable 3D acceleration using OpenGLES2
  | Enable3DSoftware -- ^ Enable 3D acceleration using software rendering
  deriving (FramebufferAccelerationOptions
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> Bounded FramebufferAccelerationOptions
forall a. a -> a -> Bounded a
maxBound :: FramebufferAccelerationOptions
$cmaxBound :: FramebufferAccelerationOptions
minBound :: FramebufferAccelerationOptions
$cminBound :: FramebufferAccelerationOptions
Bounded, Typeable FramebufferAccelerationOptions
DataType
Constr
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 -> DataType
FramebufferAccelerationOptions -> Constr
(forall b. Data b => b -> b)
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FramebufferAccelerationOptions
-> c FramebufferAccelerationOptions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c 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)
$cEnable3DSoftware :: Constr
$cEnable3DOpenGLES2 :: Constr
$cEnable3DOpenGLES :: Constr
$cEnable3DOpenGL :: Constr
$cEnable3DDirect3D :: Constr
$cEnable3DDefault :: Constr
$cDisable3D :: Constr
$tFramebufferAccelerationOptions :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions
-> u
gmapQ :: (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
gmapT :: (forall b. Data b => b -> b)
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$cgmapT :: (forall b. Data b => b -> b)
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c FramebufferAccelerationOptions)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FramebufferAccelerationOptions)
dataTypeOf :: FramebufferAccelerationOptions -> DataType
$cdataTypeOf :: FramebufferAccelerationOptions -> DataType
toConstr :: FramebufferAccelerationOptions -> Constr
$ctoConstr :: FramebufferAccelerationOptions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FramebufferAccelerationOptions
-> 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
$cp1Data :: Typeable 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
enumFromThenTo :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
$cenumFromThenTo :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
enumFromTo :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
$cenumFromTo :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
enumFromThen :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
$cenumFromThen :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
enumFrom :: FramebufferAccelerationOptions -> [FramebufferAccelerationOptions]
$cenumFrom :: FramebufferAccelerationOptions -> [FramebufferAccelerationOptions]
fromEnum :: FramebufferAccelerationOptions -> Int
$cfromEnum :: FramebufferAccelerationOptions -> Int
toEnum :: Int -> FramebufferAccelerationOptions
$ctoEnum :: Int -> FramebufferAccelerationOptions
pred :: FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$cpred :: FramebufferAccelerationOptions -> FramebufferAccelerationOptions
succ :: FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$csucc :: FramebufferAccelerationOptions -> FramebufferAccelerationOptions
Enum, FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
(FramebufferAccelerationOptions
 -> FramebufferAccelerationOptions -> Bool)
-> (FramebufferAccelerationOptions
    -> FramebufferAccelerationOptions -> Bool)
-> Eq FramebufferAccelerationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
$c/= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
== :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
$c== :: 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
$cto :: forall x.
Rep FramebufferAccelerationOptions x
-> FramebufferAccelerationOptions
$cfrom :: forall x.
FramebufferAccelerationOptions
-> Rep FramebufferAccelerationOptions x
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
min :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$cmin :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
max :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
$cmax :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
>= :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Bool
$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
compare :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Ordering
$ccompare :: FramebufferAccelerationOptions
-> FramebufferAccelerationOptions -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [FramebufferAccelerationOptions]
$creadListPrec :: ReadPrec [FramebufferAccelerationOptions]
readPrec :: ReadPrec FramebufferAccelerationOptions
$creadPrec :: ReadPrec FramebufferAccelerationOptions
readList :: ReadS [FramebufferAccelerationOptions]
$creadList :: ReadS [FramebufferAccelerationOptions]
readsPrec :: Int -> ReadS FramebufferAccelerationOptions
$creadsPrec :: Int -> ReadS 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
showList :: [FramebufferAccelerationOptions] -> ShowS
$cshowList :: [FramebufferAccelerationOptions] -> ShowS
show :: FramebufferAccelerationOptions -> String
$cshow :: FramebufferAccelerationOptions -> String
showsPrec :: Int -> FramebufferAccelerationOptions -> ShowS
$cshowsPrec :: Int -> FramebufferAccelerationOptions -> ShowS
Show, Typeable)

-- | A hint that specifies whether ctrl+click should generate a right-click event
-- on Mac. By default holding ctrl while left clicking will not generate a right
-- click event when on Mac.
data MacCTRLClickOptions
  = NoRightClick -- ^ Disable emulating right click
  | EmulateRightClick -- ^ Enable emulating right click
  deriving (MacCTRLClickOptions
MacCTRLClickOptions
-> MacCTRLClickOptions -> Bounded MacCTRLClickOptions
forall a. a -> a -> Bounded a
maxBound :: MacCTRLClickOptions
$cmaxBound :: MacCTRLClickOptions
minBound :: MacCTRLClickOptions
$cminBound :: MacCTRLClickOptions
Bounded, Typeable MacCTRLClickOptions
DataType
Constr
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 -> DataType
MacCTRLClickOptions -> Constr
(forall b. Data b => b -> b)
-> MacCTRLClickOptions -> MacCTRLClickOptions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MacCTRLClickOptions
-> c MacCTRLClickOptions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cEmulateRightClick :: Constr
$cNoRightClick :: Constr
$tMacCTRLClickOptions :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
gmapQi :: Int -> (forall d. Data d => d -> u) -> MacCTRLClickOptions -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MacCTRLClickOptions -> u
gmapQ :: (forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
gmapT :: (forall b. Data b => b -> b)
-> MacCTRLClickOptions -> MacCTRLClickOptions
$cgmapT :: (forall b. Data b => b -> b)
-> MacCTRLClickOptions -> MacCTRLClickOptions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MacCTRLClickOptions)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MacCTRLClickOptions)
dataTypeOf :: MacCTRLClickOptions -> DataType
$cdataTypeOf :: MacCTRLClickOptions -> DataType
toConstr :: MacCTRLClickOptions -> Constr
$ctoConstr :: MacCTRLClickOptions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MacCTRLClickOptions
-> 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
$cp1Data :: Typeable 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
enumFromThenTo :: MacCTRLClickOptions
-> MacCTRLClickOptions
-> MacCTRLClickOptions
-> [MacCTRLClickOptions]
$cenumFromThenTo :: MacCTRLClickOptions
-> MacCTRLClickOptions
-> MacCTRLClickOptions
-> [MacCTRLClickOptions]
enumFromTo :: MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
$cenumFromTo :: MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
enumFromThen :: MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
$cenumFromThen :: MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
enumFrom :: MacCTRLClickOptions -> [MacCTRLClickOptions]
$cenumFrom :: MacCTRLClickOptions -> [MacCTRLClickOptions]
fromEnum :: MacCTRLClickOptions -> Int
$cfromEnum :: MacCTRLClickOptions -> Int
toEnum :: Int -> MacCTRLClickOptions
$ctoEnum :: Int -> MacCTRLClickOptions
pred :: MacCTRLClickOptions -> MacCTRLClickOptions
$cpred :: MacCTRLClickOptions -> MacCTRLClickOptions
succ :: MacCTRLClickOptions -> MacCTRLClickOptions
$csucc :: MacCTRLClickOptions -> MacCTRLClickOptions
Enum, MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
(MacCTRLClickOptions -> MacCTRLClickOptions -> Bool)
-> (MacCTRLClickOptions -> MacCTRLClickOptions -> Bool)
-> Eq MacCTRLClickOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
$c/= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
== :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
$c== :: 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
$cto :: forall x. Rep MacCTRLClickOptions x -> MacCTRLClickOptions
$cfrom :: forall x. MacCTRLClickOptions -> Rep MacCTRLClickOptions x
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
min :: MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
$cmin :: MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
max :: MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
$cmax :: MacCTRLClickOptions -> MacCTRLClickOptions -> MacCTRLClickOptions
>= :: MacCTRLClickOptions -> MacCTRLClickOptions -> Bool
$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
compare :: MacCTRLClickOptions -> MacCTRLClickOptions -> Ordering
$ccompare :: MacCTRLClickOptions -> MacCTRLClickOptions -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [MacCTRLClickOptions]
$creadListPrec :: ReadPrec [MacCTRLClickOptions]
readPrec :: ReadPrec MacCTRLClickOptions
$creadPrec :: ReadPrec MacCTRLClickOptions
readList :: ReadS [MacCTRLClickOptions]
$creadList :: ReadS [MacCTRLClickOptions]
readsPrec :: Int -> ReadS MacCTRLClickOptions
$creadsPrec :: Int -> ReadS 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
showList :: [MacCTRLClickOptions] -> ShowS
$cshowList :: [MacCTRLClickOptions] -> ShowS
show :: MacCTRLClickOptions -> String
$cshow :: MacCTRLClickOptions -> String
showsPrec :: Int -> MacCTRLClickOptions -> ShowS
$cshowsPrec :: Int -> MacCTRLClickOptions -> ShowS
Show, Typeable)

-- | A hint that specifies whether relative mouse mode is implemented using mouse
-- warping. By default SDL will use raw input for relative mouse mode
data MouseModeWarpOptions
  = MouseRawInput -- ^ Relative mouse mode uses the raw input
  | MouseWarping -- ^ Relative mouse mode uses mouse warping
  deriving (MouseModeWarpOptions
MouseModeWarpOptions
-> MouseModeWarpOptions -> Bounded MouseModeWarpOptions
forall a. a -> a -> Bounded a
maxBound :: MouseModeWarpOptions
$cmaxBound :: MouseModeWarpOptions
minBound :: MouseModeWarpOptions
$cminBound :: MouseModeWarpOptions
Bounded, Typeable MouseModeWarpOptions
DataType
Constr
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 -> DataType
MouseModeWarpOptions -> Constr
(forall b. Data b => b -> b)
-> MouseModeWarpOptions -> MouseModeWarpOptions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MouseModeWarpOptions
-> c MouseModeWarpOptions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cMouseWarping :: Constr
$cMouseRawInput :: Constr
$tMouseModeWarpOptions :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
gmapQi :: Int -> (forall d. Data d => d -> u) -> MouseModeWarpOptions -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MouseModeWarpOptions -> u
gmapQ :: (forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
gmapT :: (forall b. Data b => b -> b)
-> MouseModeWarpOptions -> MouseModeWarpOptions
$cgmapT :: (forall b. Data b => b -> b)
-> MouseModeWarpOptions -> MouseModeWarpOptions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MouseModeWarpOptions)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseModeWarpOptions)
dataTypeOf :: MouseModeWarpOptions -> DataType
$cdataTypeOf :: MouseModeWarpOptions -> DataType
toConstr :: MouseModeWarpOptions -> Constr
$ctoConstr :: MouseModeWarpOptions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MouseModeWarpOptions
-> 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
$cp1Data :: Typeable 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
enumFromThenTo :: MouseModeWarpOptions
-> MouseModeWarpOptions
-> MouseModeWarpOptions
-> [MouseModeWarpOptions]
$cenumFromThenTo :: MouseModeWarpOptions
-> MouseModeWarpOptions
-> MouseModeWarpOptions
-> [MouseModeWarpOptions]
enumFromTo :: MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
$cenumFromTo :: MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
enumFromThen :: MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
$cenumFromThen :: MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
enumFrom :: MouseModeWarpOptions -> [MouseModeWarpOptions]
$cenumFrom :: MouseModeWarpOptions -> [MouseModeWarpOptions]
fromEnum :: MouseModeWarpOptions -> Int
$cfromEnum :: MouseModeWarpOptions -> Int
toEnum :: Int -> MouseModeWarpOptions
$ctoEnum :: Int -> MouseModeWarpOptions
pred :: MouseModeWarpOptions -> MouseModeWarpOptions
$cpred :: MouseModeWarpOptions -> MouseModeWarpOptions
succ :: MouseModeWarpOptions -> MouseModeWarpOptions
$csucc :: MouseModeWarpOptions -> MouseModeWarpOptions
Enum, MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
(MouseModeWarpOptions -> MouseModeWarpOptions -> Bool)
-> (MouseModeWarpOptions -> MouseModeWarpOptions -> Bool)
-> Eq MouseModeWarpOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
$c/= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
== :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
$c== :: 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
$cto :: forall x. Rep MouseModeWarpOptions x -> MouseModeWarpOptions
$cfrom :: forall x. MouseModeWarpOptions -> Rep MouseModeWarpOptions x
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
min :: MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
$cmin :: MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
max :: MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
$cmax :: MouseModeWarpOptions
-> MouseModeWarpOptions -> MouseModeWarpOptions
>= :: MouseModeWarpOptions -> MouseModeWarpOptions -> Bool
$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
compare :: MouseModeWarpOptions -> MouseModeWarpOptions -> Ordering
$ccompare :: MouseModeWarpOptions -> MouseModeWarpOptions -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [MouseModeWarpOptions]
$creadListPrec :: ReadPrec [MouseModeWarpOptions]
readPrec :: ReadPrec MouseModeWarpOptions
$creadPrec :: ReadPrec MouseModeWarpOptions
readList :: ReadS [MouseModeWarpOptions]
$creadList :: ReadS [MouseModeWarpOptions]
readsPrec :: Int -> ReadS MouseModeWarpOptions
$creadsPrec :: Int -> ReadS 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
showList :: [MouseModeWarpOptions] -> ShowS
$cshowList :: [MouseModeWarpOptions] -> ShowS
show :: MouseModeWarpOptions -> String
$cshow :: MouseModeWarpOptions -> String
showsPrec :: Int -> MouseModeWarpOptions -> ShowS
$cshowsPrec :: Int -> MouseModeWarpOptions -> ShowS
Show, Typeable)

-- | A hint that specifies which render driver to use. By default the first one
-- in the list that is available on the current platform is chosen.
data RenderDrivers
  = Direct3D
  | OpenGL
  | OpenGLES
  | OpenGLES2
  | Software
  deriving (RenderDrivers
RenderDrivers -> RenderDrivers -> Bounded RenderDrivers
forall a. a -> a -> Bounded a
maxBound :: RenderDrivers
$cmaxBound :: RenderDrivers
minBound :: RenderDrivers
$cminBound :: RenderDrivers
Bounded, Typeable RenderDrivers
DataType
Constr
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 -> DataType
RenderDrivers -> Constr
(forall b. Data b => b -> b) -> RenderDrivers -> RenderDrivers
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RenderDrivers -> c RenderDrivers
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSoftware :: Constr
$cOpenGLES2 :: Constr
$cOpenGLES :: Constr
$cOpenGL :: Constr
$cDirect3D :: Constr
$tRenderDrivers :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
gmapQi :: Int -> (forall d. Data d => d -> u) -> RenderDrivers -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RenderDrivers -> u
gmapQ :: (forall d. Data d => d -> u) -> RenderDrivers -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderDrivers -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
gmapT :: (forall b. Data b => b -> b) -> RenderDrivers -> RenderDrivers
$cgmapT :: (forall b. Data b => b -> b) -> RenderDrivers -> RenderDrivers
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RenderDrivers)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderDrivers)
dataTypeOf :: RenderDrivers -> DataType
$cdataTypeOf :: RenderDrivers -> DataType
toConstr :: RenderDrivers -> Constr
$ctoConstr :: RenderDrivers -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RenderDrivers -> 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
$cp1Data :: Typeable 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
enumFromThenTo :: RenderDrivers -> RenderDrivers -> RenderDrivers -> [RenderDrivers]
$cenumFromThenTo :: RenderDrivers -> RenderDrivers -> RenderDrivers -> [RenderDrivers]
enumFromTo :: RenderDrivers -> RenderDrivers -> [RenderDrivers]
$cenumFromTo :: RenderDrivers -> RenderDrivers -> [RenderDrivers]
enumFromThen :: RenderDrivers -> RenderDrivers -> [RenderDrivers]
$cenumFromThen :: RenderDrivers -> RenderDrivers -> [RenderDrivers]
enumFrom :: RenderDrivers -> [RenderDrivers]
$cenumFrom :: RenderDrivers -> [RenderDrivers]
fromEnum :: RenderDrivers -> Int
$cfromEnum :: RenderDrivers -> Int
toEnum :: Int -> RenderDrivers
$ctoEnum :: Int -> RenderDrivers
pred :: RenderDrivers -> RenderDrivers
$cpred :: RenderDrivers -> RenderDrivers
succ :: RenderDrivers -> RenderDrivers
$csucc :: RenderDrivers -> RenderDrivers
Enum, RenderDrivers -> RenderDrivers -> Bool
(RenderDrivers -> RenderDrivers -> Bool)
-> (RenderDrivers -> RenderDrivers -> Bool) -> Eq RenderDrivers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderDrivers -> RenderDrivers -> Bool
$c/= :: RenderDrivers -> RenderDrivers -> Bool
== :: RenderDrivers -> RenderDrivers -> Bool
$c== :: 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
$cto :: forall x. Rep RenderDrivers x -> RenderDrivers
$cfrom :: forall x. RenderDrivers -> Rep RenderDrivers x
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
min :: RenderDrivers -> RenderDrivers -> RenderDrivers
$cmin :: RenderDrivers -> RenderDrivers -> RenderDrivers
max :: RenderDrivers -> RenderDrivers -> RenderDrivers
$cmax :: RenderDrivers -> RenderDrivers -> RenderDrivers
>= :: RenderDrivers -> RenderDrivers -> Bool
$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
compare :: RenderDrivers -> RenderDrivers -> Ordering
$ccompare :: RenderDrivers -> RenderDrivers -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [RenderDrivers]
$creadListPrec :: ReadPrec [RenderDrivers]
readPrec :: ReadPrec RenderDrivers
$creadPrec :: ReadPrec RenderDrivers
readList :: ReadS [RenderDrivers]
$creadList :: ReadS [RenderDrivers]
readsPrec :: Int -> ReadS RenderDrivers
$creadsPrec :: Int -> ReadS 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
showList :: [RenderDrivers] -> ShowS
$cshowList :: [RenderDrivers] -> ShowS
show :: RenderDrivers -> String
$cshow :: RenderDrivers -> String
showsPrec :: Int -> RenderDrivers -> ShowS
$cshowsPrec :: Int -> RenderDrivers -> ShowS
Show, Typeable)

-- | A hint that specifies whether the OpenGL render driver uses shaders.
-- By default shaders are used if OpenGL supports them.
data RenderOpenGLShaderOptions
  = DisableShaders -- ^ Disable shaders
  | EnableShaders -- ^ Enable shaders, if they are available
  deriving (RenderOpenGLShaderOptions
RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> Bounded RenderOpenGLShaderOptions
forall a. a -> a -> Bounded a
maxBound :: RenderOpenGLShaderOptions
$cmaxBound :: RenderOpenGLShaderOptions
minBound :: RenderOpenGLShaderOptions
$cminBound :: RenderOpenGLShaderOptions
Bounded, Typeable RenderOpenGLShaderOptions
DataType
Constr
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 -> DataType
RenderOpenGLShaderOptions -> Constr
(forall b. Data b => b -> b)
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderOpenGLShaderOptions
-> c RenderOpenGLShaderOptions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cEnableShaders :: Constr
$cDisableShaders :: Constr
$tRenderOpenGLShaderOptions :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
gmapQi :: Int
-> (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> u
gmapQ :: (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
gmapT :: (forall b. Data b => b -> b)
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$cgmapT :: (forall b. Data b => b -> b)
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c RenderOpenGLShaderOptions)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RenderOpenGLShaderOptions)
dataTypeOf :: RenderOpenGLShaderOptions -> DataType
$cdataTypeOf :: RenderOpenGLShaderOptions -> DataType
toConstr :: RenderOpenGLShaderOptions -> Constr
$ctoConstr :: RenderOpenGLShaderOptions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderOpenGLShaderOptions
-> 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
$cp1Data :: Typeable 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
enumFromThenTo :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> [RenderOpenGLShaderOptions]
$cenumFromThenTo :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> [RenderOpenGLShaderOptions]
enumFromTo :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
$cenumFromTo :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
enumFromThen :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
$cenumFromThen :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
enumFrom :: RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
$cenumFrom :: RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
fromEnum :: RenderOpenGLShaderOptions -> Int
$cfromEnum :: RenderOpenGLShaderOptions -> Int
toEnum :: Int -> RenderOpenGLShaderOptions
$ctoEnum :: Int -> RenderOpenGLShaderOptions
pred :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$cpred :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
succ :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$csucc :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
Enum, RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
(RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool)
-> (RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool)
-> Eq RenderOpenGLShaderOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
$c/= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
== :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
$c== :: 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
$cto :: forall x.
Rep RenderOpenGLShaderOptions x -> RenderOpenGLShaderOptions
$cfrom :: forall x.
RenderOpenGLShaderOptions -> Rep RenderOpenGLShaderOptions x
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
min :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$cmin :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
max :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
$cmax :: RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
>= :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Bool
$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
compare :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Ordering
$ccompare :: RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [RenderOpenGLShaderOptions]
$creadListPrec :: ReadPrec [RenderOpenGLShaderOptions]
readPrec :: ReadPrec RenderOpenGLShaderOptions
$creadPrec :: ReadPrec RenderOpenGLShaderOptions
readList :: ReadS [RenderOpenGLShaderOptions]
$creadList :: ReadS [RenderOpenGLShaderOptions]
readsPrec :: Int -> ReadS RenderOpenGLShaderOptions
$creadsPrec :: Int -> ReadS 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
showList :: [RenderOpenGLShaderOptions] -> ShowS
$cshowList :: [RenderOpenGLShaderOptions] -> ShowS
show :: RenderOpenGLShaderOptions -> String
$cshow :: RenderOpenGLShaderOptions -> String
showsPrec :: Int -> RenderOpenGLShaderOptions -> ShowS
$cshowsPrec :: Int -> RenderOpenGLShaderOptions -> ShowS
Show, Typeable)

-- | A hint that specifies scaling quality. By default nearest pixel sampling is
-- used.
data RenderScaleQuality
  = ScaleNearest -- ^ Nearest pixel sampling
  | ScaleLinear -- ^ linear filtering (supported by OpenGL and Direct3D)
  | ScaleBest -- ^ Anisotropic filtering (supported by Direct3D)
  deriving (RenderScaleQuality
RenderScaleQuality
-> RenderScaleQuality -> Bounded RenderScaleQuality
forall a. a -> a -> Bounded a
maxBound :: RenderScaleQuality
$cmaxBound :: RenderScaleQuality
minBound :: RenderScaleQuality
$cminBound :: RenderScaleQuality
Bounded, Typeable RenderScaleQuality
DataType
Constr
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 -> DataType
RenderScaleQuality -> Constr
(forall b. Data b => b -> b)
-> RenderScaleQuality -> RenderScaleQuality
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderScaleQuality
-> c RenderScaleQuality
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cScaleBest :: Constr
$cScaleLinear :: Constr
$cScaleNearest :: Constr
$tRenderScaleQuality :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
gmapQi :: Int -> (forall d. Data d => d -> u) -> RenderScaleQuality -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderScaleQuality -> u
gmapQ :: (forall d. Data d => d -> u) -> RenderScaleQuality -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderScaleQuality -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
gmapT :: (forall b. Data b => b -> b)
-> RenderScaleQuality -> RenderScaleQuality
$cgmapT :: (forall b. Data b => b -> b)
-> RenderScaleQuality -> RenderScaleQuality
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RenderScaleQuality)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderScaleQuality)
dataTypeOf :: RenderScaleQuality -> DataType
$cdataTypeOf :: RenderScaleQuality -> DataType
toConstr :: RenderScaleQuality -> Constr
$ctoConstr :: RenderScaleQuality -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderScaleQuality
-> 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
$cp1Data :: Typeable 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
enumFromThenTo :: RenderScaleQuality
-> RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
$cenumFromThenTo :: RenderScaleQuality
-> RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
enumFromTo :: RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
$cenumFromTo :: RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
enumFromThen :: RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
$cenumFromThen :: RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
enumFrom :: RenderScaleQuality -> [RenderScaleQuality]
$cenumFrom :: RenderScaleQuality -> [RenderScaleQuality]
fromEnum :: RenderScaleQuality -> Int
$cfromEnum :: RenderScaleQuality -> Int
toEnum :: Int -> RenderScaleQuality
$ctoEnum :: Int -> RenderScaleQuality
pred :: RenderScaleQuality -> RenderScaleQuality
$cpred :: RenderScaleQuality -> RenderScaleQuality
succ :: RenderScaleQuality -> RenderScaleQuality
$csucc :: RenderScaleQuality -> RenderScaleQuality
Enum, RenderScaleQuality -> RenderScaleQuality -> Bool
(RenderScaleQuality -> RenderScaleQuality -> Bool)
-> (RenderScaleQuality -> RenderScaleQuality -> Bool)
-> Eq RenderScaleQuality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderScaleQuality -> RenderScaleQuality -> Bool
$c/= :: RenderScaleQuality -> RenderScaleQuality -> Bool
== :: RenderScaleQuality -> RenderScaleQuality -> Bool
$c== :: 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
$cto :: forall x. Rep RenderScaleQuality x -> RenderScaleQuality
$cfrom :: forall x. RenderScaleQuality -> Rep RenderScaleQuality x
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
min :: RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
$cmin :: RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
max :: RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
$cmax :: RenderScaleQuality -> RenderScaleQuality -> RenderScaleQuality
>= :: RenderScaleQuality -> RenderScaleQuality -> Bool
$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
compare :: RenderScaleQuality -> RenderScaleQuality -> Ordering
$ccompare :: RenderScaleQuality -> RenderScaleQuality -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [RenderScaleQuality]
$creadListPrec :: ReadPrec [RenderScaleQuality]
readPrec :: ReadPrec RenderScaleQuality
$creadPrec :: ReadPrec RenderScaleQuality
readList :: ReadS [RenderScaleQuality]
$creadList :: ReadS [RenderScaleQuality]
readsPrec :: Int -> ReadS RenderScaleQuality
$creadsPrec :: Int -> ReadS 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
showList :: [RenderScaleQuality] -> ShowS
$cshowList :: [RenderScaleQuality] -> ShowS
show :: RenderScaleQuality -> String
$cshow :: RenderScaleQuality -> String
showsPrec :: Int -> RenderScaleQuality -> ShowS
$cshowsPrec :: Int -> RenderScaleQuality -> ShowS
Show, Typeable)

-- | A hint that specifies whether sync to vertical refresh is enabled or
-- disabled to avoid tearing. By default SDL uses the flag passed into calls
-- to create renderers.
data RenderVSyncOptions
  = DisableVSync
  | EnableVSync
  deriving (RenderVSyncOptions
RenderVSyncOptions
-> RenderVSyncOptions -> Bounded RenderVSyncOptions
forall a. a -> a -> Bounded a
maxBound :: RenderVSyncOptions
$cmaxBound :: RenderVSyncOptions
minBound :: RenderVSyncOptions
$cminBound :: RenderVSyncOptions
Bounded, Typeable RenderVSyncOptions
DataType
Constr
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 -> DataType
RenderVSyncOptions -> Constr
(forall b. Data b => b -> b)
-> RenderVSyncOptions -> RenderVSyncOptions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderVSyncOptions
-> c RenderVSyncOptions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cEnableVSync :: Constr
$cDisableVSync :: Constr
$tRenderVSyncOptions :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
gmapQi :: Int -> (forall d. Data d => d -> u) -> RenderVSyncOptions -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderVSyncOptions -> u
gmapQ :: (forall d. Data d => d -> u) -> RenderVSyncOptions -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderVSyncOptions -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
gmapT :: (forall b. Data b => b -> b)
-> RenderVSyncOptions -> RenderVSyncOptions
$cgmapT :: (forall b. Data b => b -> b)
-> RenderVSyncOptions -> RenderVSyncOptions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RenderVSyncOptions)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderVSyncOptions)
dataTypeOf :: RenderVSyncOptions -> DataType
$cdataTypeOf :: RenderVSyncOptions -> DataType
toConstr :: RenderVSyncOptions -> Constr
$ctoConstr :: RenderVSyncOptions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderVSyncOptions
-> 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
$cp1Data :: Typeable 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
enumFromThenTo :: RenderVSyncOptions
-> RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
$cenumFromThenTo :: RenderVSyncOptions
-> RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
enumFromTo :: RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
$cenumFromTo :: RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
enumFromThen :: RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
$cenumFromThen :: RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
enumFrom :: RenderVSyncOptions -> [RenderVSyncOptions]
$cenumFrom :: RenderVSyncOptions -> [RenderVSyncOptions]
fromEnum :: RenderVSyncOptions -> Int
$cfromEnum :: RenderVSyncOptions -> Int
toEnum :: Int -> RenderVSyncOptions
$ctoEnum :: Int -> RenderVSyncOptions
pred :: RenderVSyncOptions -> RenderVSyncOptions
$cpred :: RenderVSyncOptions -> RenderVSyncOptions
succ :: RenderVSyncOptions -> RenderVSyncOptions
$csucc :: RenderVSyncOptions -> RenderVSyncOptions
Enum, RenderVSyncOptions -> RenderVSyncOptions -> Bool
(RenderVSyncOptions -> RenderVSyncOptions -> Bool)
-> (RenderVSyncOptions -> RenderVSyncOptions -> Bool)
-> Eq RenderVSyncOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
$c/= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
== :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
$c== :: 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
$cto :: forall x. Rep RenderVSyncOptions x -> RenderVSyncOptions
$cfrom :: forall x. RenderVSyncOptions -> Rep RenderVSyncOptions x
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
min :: RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
$cmin :: RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
max :: RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
$cmax :: RenderVSyncOptions -> RenderVSyncOptions -> RenderVSyncOptions
>= :: RenderVSyncOptions -> RenderVSyncOptions -> Bool
$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
compare :: RenderVSyncOptions -> RenderVSyncOptions -> Ordering
$ccompare :: RenderVSyncOptions -> RenderVSyncOptions -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [RenderVSyncOptions]
$creadListPrec :: ReadPrec [RenderVSyncOptions]
readPrec :: ReadPrec RenderVSyncOptions
$creadPrec :: ReadPrec RenderVSyncOptions
readList :: ReadS [RenderVSyncOptions]
$creadList :: ReadS [RenderVSyncOptions]
readsPrec :: Int -> ReadS RenderVSyncOptions
$creadsPrec :: Int -> ReadS 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
showList :: [RenderVSyncOptions] -> ShowS
$cshowList :: [RenderVSyncOptions] -> ShowS
show :: RenderVSyncOptions -> String
$cshow :: RenderVSyncOptions -> String
showsPrec :: Int -> RenderVSyncOptions -> ShowS
$cshowsPrec :: Int -> RenderVSyncOptions -> ShowS
Show, Typeable)

-- | A hint that specifies which shader compiler to preload when using the Chrome
-- ANGLE binaries. By default @d3dcompiler_46.dll@ will be used.
data VideoWinD3DCompilerOptions
  = D3DVistaOrLater -- ^ Use @d3dcompiler_46.dll@, best for Vista or later
  | D3DXPSupport -- ^ Use @d3dcompiler_43.dll@ for XP support
  | D3DNone -- ^ Do not load any library, useful if you compiled ANGLE from source and included the compiler in your binaries
  deriving (VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Bounded VideoWinD3DCompilerOptions
forall a. a -> a -> Bounded a
maxBound :: VideoWinD3DCompilerOptions
$cmaxBound :: VideoWinD3DCompilerOptions
minBound :: VideoWinD3DCompilerOptions
$cminBound :: VideoWinD3DCompilerOptions
Bounded, Typeable VideoWinD3DCompilerOptions
DataType
Constr
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 -> DataType
VideoWinD3DCompilerOptions -> Constr
(forall b. Data b => b -> b)
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VideoWinD3DCompilerOptions
-> c VideoWinD3DCompilerOptions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cD3DNone :: Constr
$cD3DXPSupport :: Constr
$cD3DVistaOrLater :: Constr
$tVideoWinD3DCompilerOptions :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
gmapQi :: Int
-> (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> u
gmapQ :: (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
gmapT :: (forall b. Data b => b -> b)
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$cgmapT :: (forall b. Data b => b -> b)
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c VideoWinD3DCompilerOptions)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VideoWinD3DCompilerOptions)
dataTypeOf :: VideoWinD3DCompilerOptions -> DataType
$cdataTypeOf :: VideoWinD3DCompilerOptions -> DataType
toConstr :: VideoWinD3DCompilerOptions -> Constr
$ctoConstr :: VideoWinD3DCompilerOptions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VideoWinD3DCompilerOptions
-> 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
$cp1Data :: Typeable 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
enumFromThenTo :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> [VideoWinD3DCompilerOptions]
$cenumFromThenTo :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> [VideoWinD3DCompilerOptions]
enumFromTo :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
$cenumFromTo :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
enumFromThen :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
$cenumFromThen :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
enumFrom :: VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
$cenumFrom :: VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
fromEnum :: VideoWinD3DCompilerOptions -> Int
$cfromEnum :: VideoWinD3DCompilerOptions -> Int
toEnum :: Int -> VideoWinD3DCompilerOptions
$ctoEnum :: Int -> VideoWinD3DCompilerOptions
pred :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$cpred :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
succ :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$csucc :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
Enum, VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
(VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool)
-> (VideoWinD3DCompilerOptions
    -> VideoWinD3DCompilerOptions -> Bool)
-> Eq VideoWinD3DCompilerOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
$c/= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
== :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
$c== :: 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
$cto :: forall x.
Rep VideoWinD3DCompilerOptions x -> VideoWinD3DCompilerOptions
$cfrom :: forall x.
VideoWinD3DCompilerOptions -> Rep VideoWinD3DCompilerOptions x
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
min :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$cmin :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
max :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
$cmax :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
>= :: VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions -> Bool
$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
compare :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Ordering
$ccompare :: VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [VideoWinD3DCompilerOptions]
$creadListPrec :: ReadPrec [VideoWinD3DCompilerOptions]
readPrec :: ReadPrec VideoWinD3DCompilerOptions
$creadPrec :: ReadPrec VideoWinD3DCompilerOptions
readList :: ReadS [VideoWinD3DCompilerOptions]
$creadList :: ReadS [VideoWinD3DCompilerOptions]
readsPrec :: Int -> ReadS VideoWinD3DCompilerOptions
$creadsPrec :: Int -> ReadS 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
showList :: [VideoWinD3DCompilerOptions] -> ShowS
$cshowList :: [VideoWinD3DCompilerOptions] -> ShowS
show :: VideoWinD3DCompilerOptions -> String
$cshow :: VideoWinD3DCompilerOptions -> String
showsPrec :: Int -> VideoWinD3DCompilerOptions -> ShowS
$cshowsPrec :: Int -> VideoWinD3DCompilerOptions -> ShowS
Show, Typeable)

-- | The 'Hint' type exports a well-typed interface to SDL's concept of
-- <https://wiki.libsdl.org/CategoryHints hints>. This type has instances for
-- both 'HasGetter' and 'HasSetter', allowing you to get and set hints. Note that
-- the 'HasSetter' interface is fairly relaxed - if a hint cannot be set, the
-- failure will be silently discarded. For more feedback and control when setting
-- hints, see 'setHintWithPriority'.
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 $= :: 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

-- | How to deal with setting hints when an existing override or environment
-- variable is present.
data HintPriority
  = DefaultPriority -- ^ Low priority, used for default values
  | NormalPriority -- ^ Medium priority
  | OverridePriority -- ^ High priority
  deriving (HintPriority
HintPriority -> HintPriority -> Bounded HintPriority
forall a. a -> a -> Bounded a
maxBound :: HintPriority
$cmaxBound :: HintPriority
minBound :: HintPriority
$cminBound :: HintPriority
Bounded, Typeable HintPriority
DataType
Constr
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 -> DataType
HintPriority -> Constr
(forall b. Data b => b -> b) -> HintPriority -> HintPriority
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HintPriority -> c HintPriority
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cOverridePriority :: Constr
$cNormalPriority :: Constr
$cDefaultPriority :: Constr
$tHintPriority :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
gmapQi :: Int -> (forall d. Data d => d -> u) -> HintPriority -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HintPriority -> u
gmapQ :: (forall d. Data d => d -> u) -> HintPriority -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HintPriority -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
gmapT :: (forall b. Data b => b -> b) -> HintPriority -> HintPriority
$cgmapT :: (forall b. Data b => b -> b) -> HintPriority -> HintPriority
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c HintPriority)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HintPriority)
dataTypeOf :: HintPriority -> DataType
$cdataTypeOf :: HintPriority -> DataType
toConstr :: HintPriority -> Constr
$ctoConstr :: HintPriority -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HintPriority -> 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
$cp1Data :: Typeable 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
enumFromThenTo :: HintPriority -> HintPriority -> HintPriority -> [HintPriority]
$cenumFromThenTo :: HintPriority -> HintPriority -> HintPriority -> [HintPriority]
enumFromTo :: HintPriority -> HintPriority -> [HintPriority]
$cenumFromTo :: HintPriority -> HintPriority -> [HintPriority]
enumFromThen :: HintPriority -> HintPriority -> [HintPriority]
$cenumFromThen :: HintPriority -> HintPriority -> [HintPriority]
enumFrom :: HintPriority -> [HintPriority]
$cenumFrom :: HintPriority -> [HintPriority]
fromEnum :: HintPriority -> Int
$cfromEnum :: HintPriority -> Int
toEnum :: Int -> HintPriority
$ctoEnum :: Int -> HintPriority
pred :: HintPriority -> HintPriority
$cpred :: HintPriority -> HintPriority
succ :: HintPriority -> HintPriority
$csucc :: HintPriority -> HintPriority
Enum, HintPriority -> HintPriority -> Bool
(HintPriority -> HintPriority -> Bool)
-> (HintPriority -> HintPriority -> Bool) -> Eq HintPriority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HintPriority -> HintPriority -> Bool
$c/= :: HintPriority -> HintPriority -> Bool
== :: HintPriority -> HintPriority -> Bool
$c== :: 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
$cto :: forall x. Rep HintPriority x -> HintPriority
$cfrom :: forall x. HintPriority -> Rep HintPriority x
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
min :: HintPriority -> HintPriority -> HintPriority
$cmin :: HintPriority -> HintPriority -> HintPriority
max :: HintPriority -> HintPriority -> HintPriority
$cmax :: HintPriority -> HintPriority -> HintPriority
>= :: HintPriority -> HintPriority -> Bool
$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
compare :: HintPriority -> HintPriority -> Ordering
$ccompare :: HintPriority -> HintPriority -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [HintPriority]
$creadListPrec :: ReadPrec [HintPriority]
readPrec :: ReadPrec HintPriority
$creadPrec :: ReadPrec HintPriority
readList :: ReadS [HintPriority]
$creadList :: ReadS [HintPriority]
readsPrec :: Int -> ReadS HintPriority
$creadsPrec :: Int -> ReadS 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
showList :: [HintPriority] -> ShowS
$cshowList :: [HintPriority] -> ShowS
show :: HintPriority -> String
$cshow :: HintPriority -> String
showsPrec :: Int -> HintPriority -> ShowS
$cshowsPrec :: Int -> HintPriority -> ShowS
Show, Typeable)

-- | Set the value of a hint, applying priority rules for when there is a
-- conflict. Ordinarily, a hint will not be set if there is an existing override
-- hint or environment variable that takes precedence.
setHintWithPriority :: MonadIO m => HintPriority -> Hint v -> v -> m Bool
setHintWithPriority :: 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 :: (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 (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
AccelerometerNotJoystick -> String
"0"
         v
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 (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
Disable3D -> String
"0"
         v
Enable3DDefault -> String
"1"
         v
Enable3DDirect3D -> String
"direct3d"
         v
Enable3DOpenGL -> String
"opengl"
         v
Enable3DOpenGLES -> String
"opengles"
         v
Enable3DOpenGLES2 -> String
"opengles2"
         v
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 (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
NoRightClick -> String
"0"
         v
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 (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
MouseRawInput -> String
"0"
         v
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 (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
Direct3D -> String
"direct3d"
         v
OpenGL -> String
"opengl"
         v
OpenGLES -> String
"opengles"
         v
OpenGLES2 -> String
"opengles2"
         v
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 (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
DisableShaders -> String
"0"
         v
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 (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
ScaleNearest -> String
"0"
         v
ScaleLinear -> String
"1"
         v
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 (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
DisableVSync -> String
"0"
         v
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 (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
D3DVistaOrLater -> String
"d3dcompiler_46.dll"
         v
D3DXPSupport -> String
"d3dcompiler_43.dll"
         v
D3DNone ->  String
"none")
      (CString -> CString -> IO a
f CString
hint)

-- | Retrieve and map the current value associated with the given hint.
mapHint :: MonadIO m => Hint v -> (String -> Maybe v) -> m v
mapHint :: Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h String -> Maybe v
f = IO v -> m v
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 (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 :: 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" -> AccelerometerJoystickOptions -> Maybe AccelerometerJoystickOptions
forall a. a -> Maybe a
Just AccelerometerJoystickOptions
AccelerometerNotJoystick
        String
"1" -> AccelerometerJoystickOptions -> Maybe AccelerometerJoystickOptions
forall a. a -> Maybe a
Just 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" -> FramebufferAccelerationOptions
-> Maybe FramebufferAccelerationOptions
forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Disable3D
         String
"1" -> FramebufferAccelerationOptions
-> Maybe FramebufferAccelerationOptions
forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DDefault
         String
"direct3d" -> FramebufferAccelerationOptions
-> Maybe FramebufferAccelerationOptions
forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DDirect3D
         String
"opengl" -> FramebufferAccelerationOptions
-> Maybe FramebufferAccelerationOptions
forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DOpenGL
         String
"opengles" -> FramebufferAccelerationOptions
-> Maybe FramebufferAccelerationOptions
forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DOpenGLES
         String
"opengles2" -> FramebufferAccelerationOptions
-> Maybe FramebufferAccelerationOptions
forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DOpenGLES2
         String
"software" -> FramebufferAccelerationOptions
-> Maybe FramebufferAccelerationOptions
forall a. a -> Maybe a
Just 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" -> MacCTRLClickOptions -> Maybe MacCTRLClickOptions
forall a. a -> Maybe a
Just MacCTRLClickOptions
NoRightClick
         String
"1" -> MacCTRLClickOptions -> Maybe MacCTRLClickOptions
forall a. a -> Maybe a
Just 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" -> MouseModeWarpOptions -> Maybe MouseModeWarpOptions
forall a. a -> Maybe a
Just MouseModeWarpOptions
MouseRawInput
         String
"1" -> MouseModeWarpOptions -> Maybe MouseModeWarpOptions
forall a. a -> Maybe a
Just 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" -> RenderDrivers -> Maybe RenderDrivers
forall a. a -> Maybe a
Just RenderDrivers
Direct3D
         String
"opengl" -> RenderDrivers -> Maybe RenderDrivers
forall a. a -> Maybe a
Just RenderDrivers
OpenGL
         String
"opengles" -> RenderDrivers -> Maybe RenderDrivers
forall a. a -> Maybe a
Just RenderDrivers
OpenGLES
         String
"opengles2" -> RenderDrivers -> Maybe RenderDrivers
forall a. a -> Maybe a
Just RenderDrivers
OpenGLES2
         String
"software" -> RenderDrivers -> Maybe RenderDrivers
forall a. a -> Maybe a
Just 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" -> RenderOpenGLShaderOptions -> Maybe RenderOpenGLShaderOptions
forall a. a -> Maybe a
Just RenderOpenGLShaderOptions
DisableShaders
         String
"1" -> RenderOpenGLShaderOptions -> Maybe RenderOpenGLShaderOptions
forall a. a -> Maybe a
Just 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" -> RenderScaleQuality -> Maybe RenderScaleQuality
forall a. a -> Maybe a
Just RenderScaleQuality
ScaleNearest
         String
"1" -> RenderScaleQuality -> Maybe RenderScaleQuality
forall a. a -> Maybe a
Just RenderScaleQuality
ScaleLinear
         String
"2" -> RenderScaleQuality -> Maybe RenderScaleQuality
forall a. a -> Maybe a
Just 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" -> RenderVSyncOptions -> Maybe RenderVSyncOptions
forall a. a -> Maybe a
Just RenderVSyncOptions
DisableVSync
         String
"1" -> RenderVSyncOptions -> Maybe RenderVSyncOptions
forall a. a -> Maybe a
Just 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" -> VideoWinD3DCompilerOptions -> Maybe VideoWinD3DCompilerOptions
forall a. a -> Maybe a
Just VideoWinD3DCompilerOptions
D3DVistaOrLater
         String
"d3dcompiler_43.dll" -> VideoWinD3DCompilerOptions -> Maybe VideoWinD3DCompilerOptions
forall a. a -> Maybe a
Just VideoWinD3DCompilerOptions
D3DXPSupport
         String
"none" -> VideoWinD3DCompilerOptions -> Maybe VideoWinD3DCompilerOptions
forall a. a -> Maybe a
Just VideoWinD3DCompilerOptions
D3DNone
         String
_ -> Maybe v
forall a. Maybe a
Nothing)

hintToString :: Hint v -> String
hintToString :: 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 :: m ()
clearHints = m ()
forall (m :: Type -> Type). MonadIO m => m ()
Raw.clearHints