{-# 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
forall a. a -> a -> Bounded a
maxBound :: AccelerometerJoystickOptions
$cmaxBound :: AccelerometerJoystickOptions
minBound :: AccelerometerJoystickOptions
$cminBound :: AccelerometerJoystickOptions
Bounded, Typeable AccelerometerJoystickOptions
AccelerometerJoystickOptions -> DataType
AccelerometerJoystickOptions -> Constr
(forall b. Data b => b -> b)
-> AccelerometerJoystickOptions -> AccelerometerJoystickOptions
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> AccelerometerJoystickOptions
-> u
forall u.
(forall d. Data d => d -> u) -> AccelerometerJoystickOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccelerometerJoystickOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccelerometerJoystickOptions
-> c AccelerometerJoystickOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AccelerometerJoystickOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccelerometerJoystickOptions)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccelerometerJoystickOptions -> m AccelerometerJoystickOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u.
Int
-> (forall d. Data d => d -> u)
-> AccelerometerJoystickOptions
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> AccelerometerJoystickOptions
-> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> AccelerometerJoystickOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AccelerometerJoystickOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccelerometerJoystickOptions
-> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> AccelerometerJoystickOptions
AccelerometerJoystickOptions -> Int
AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
AccelerometerJoystickOptions -> AccelerometerJoystickOptions
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions -> [AccelerometerJoystickOptions]
AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> AccelerometerJoystickOptions
-> [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
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.
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
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
Ord, ReadPrec [AccelerometerJoystickOptions]
ReadPrec AccelerometerJoystickOptions
Int -> ReadS AccelerometerJoystickOptions
ReadS [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
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
forall a. a -> a -> Bounded a
maxBound :: FramebufferAccelerationOptions
$cmaxBound :: FramebufferAccelerationOptions
minBound :: FramebufferAccelerationOptions
$cminBound :: FramebufferAccelerationOptions
Bounded, Typeable FramebufferAccelerationOptions
FramebufferAccelerationOptions -> DataType
FramebufferAccelerationOptions -> Constr
(forall b. Data b => b -> b)
-> FramebufferAccelerationOptions -> FramebufferAccelerationOptions
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions
-> u
forall u.
(forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c FramebufferAccelerationOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FramebufferAccelerationOptions
-> c FramebufferAccelerationOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c FramebufferAccelerationOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FramebufferAccelerationOptions)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FramebufferAccelerationOptions
-> m FramebufferAccelerationOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> FramebufferAccelerationOptions
-> u
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> FramebufferAccelerationOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FramebufferAccelerationOptions
-> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> FramebufferAccelerationOptions
FramebufferAccelerationOptions -> Int
FramebufferAccelerationOptions -> [FramebufferAccelerationOptions]
FramebufferAccelerationOptions -> FramebufferAccelerationOptions
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [FramebufferAccelerationOptions]
FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> FramebufferAccelerationOptions
-> [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
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.
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
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
Ord, ReadPrec [FramebufferAccelerationOptions]
ReadPrec FramebufferAccelerationOptions
Int -> ReadS FramebufferAccelerationOptions
ReadS [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
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
forall a. a -> a -> Bounded a
maxBound :: MacCTRLClickOptions
$cmaxBound :: MacCTRLClickOptions
minBound :: MacCTRLClickOptions
$cminBound :: MacCTRLClickOptions
Bounded, Typeable MacCTRLClickOptions
MacCTRLClickOptions -> DataType
MacCTRLClickOptions -> Constr
(forall b. Data b => b -> b)
-> MacCTRLClickOptions -> MacCTRLClickOptions
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> MacCTRLClickOptions -> u
forall u.
(forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MacCTRLClickOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MacCTRLClickOptions
-> c MacCTRLClickOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MacCTRLClickOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MacCTRLClickOptions)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MacCTRLClickOptions -> m MacCTRLClickOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> MacCTRLClickOptions -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MacCTRLClickOptions -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MacCTRLClickOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MacCTRLClickOptions -> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> MacCTRLClickOptions
MacCTRLClickOptions -> Int
MacCTRLClickOptions -> [MacCTRLClickOptions]
MacCTRLClickOptions -> MacCTRLClickOptions
MacCTRLClickOptions -> MacCTRLClickOptions -> [MacCTRLClickOptions]
MacCTRLClickOptions
-> MacCTRLClickOptions
-> MacCTRLClickOptions
-> [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
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. 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
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
Ord, ReadPrec [MacCTRLClickOptions]
ReadPrec MacCTRLClickOptions
Int -> ReadS MacCTRLClickOptions
ReadS [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
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
forall a. a -> a -> Bounded a
maxBound :: MouseModeWarpOptions
$cmaxBound :: MouseModeWarpOptions
minBound :: MouseModeWarpOptions
$cminBound :: MouseModeWarpOptions
Bounded, Typeable MouseModeWarpOptions
MouseModeWarpOptions -> DataType
MouseModeWarpOptions -> Constr
(forall b. Data b => b -> b)
-> MouseModeWarpOptions -> MouseModeWarpOptions
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> MouseModeWarpOptions -> u
forall u.
(forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MouseModeWarpOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> MouseModeWarpOptions
-> c MouseModeWarpOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MouseModeWarpOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MouseModeWarpOptions)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MouseModeWarpOptions -> m MouseModeWarpOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> MouseModeWarpOptions -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MouseModeWarpOptions -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> MouseModeWarpOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MouseModeWarpOptions -> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> MouseModeWarpOptions
MouseModeWarpOptions -> Int
MouseModeWarpOptions -> [MouseModeWarpOptions]
MouseModeWarpOptions -> MouseModeWarpOptions
MouseModeWarpOptions
-> MouseModeWarpOptions -> [MouseModeWarpOptions]
MouseModeWarpOptions
-> MouseModeWarpOptions
-> MouseModeWarpOptions
-> [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
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. 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
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
Ord, ReadPrec [MouseModeWarpOptions]
ReadPrec MouseModeWarpOptions
Int -> ReadS MouseModeWarpOptions
ReadS [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
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
forall a. a -> a -> Bounded a
maxBound :: RenderDrivers
$cmaxBound :: RenderDrivers
minBound :: RenderDrivers
$cminBound :: RenderDrivers
Bounded, Typeable RenderDrivers
RenderDrivers -> DataType
RenderDrivers -> Constr
(forall b. Data b => b -> b) -> RenderDrivers -> RenderDrivers
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RenderDrivers -> u
forall u. (forall d. Data d => d -> u) -> RenderDrivers -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderDrivers
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RenderDrivers -> c RenderDrivers
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderDrivers)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderDrivers)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RenderDrivers -> m RenderDrivers
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> RenderDrivers -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RenderDrivers -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RenderDrivers -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderDrivers -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderDrivers -> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> RenderDrivers
RenderDrivers -> Int
RenderDrivers -> [RenderDrivers]
RenderDrivers -> RenderDrivers
RenderDrivers -> RenderDrivers -> [RenderDrivers]
RenderDrivers -> RenderDrivers -> RenderDrivers -> [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
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. 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
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
Ord, ReadPrec [RenderDrivers]
ReadPrec RenderDrivers
Int -> ReadS RenderDrivers
ReadS [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
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
forall a. a -> a -> Bounded a
maxBound :: RenderOpenGLShaderOptions
$cmaxBound :: RenderOpenGLShaderOptions
minBound :: RenderOpenGLShaderOptions
$cminBound :: RenderOpenGLShaderOptions
Bounded, Typeable RenderOpenGLShaderOptions
RenderOpenGLShaderOptions -> DataType
RenderOpenGLShaderOptions -> Constr
(forall b. Data b => b -> b)
-> RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> u
forall u.
(forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderOpenGLShaderOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderOpenGLShaderOptions
-> c RenderOpenGLShaderOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RenderOpenGLShaderOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderOpenGLShaderOptions)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderOpenGLShaderOptions -> m RenderOpenGLShaderOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u.
Int
-> (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RenderOpenGLShaderOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RenderOpenGLShaderOptions
-> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> RenderOpenGLShaderOptions
RenderOpenGLShaderOptions -> Int
RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
RenderOpenGLShaderOptions -> RenderOpenGLShaderOptions
RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions -> [RenderOpenGLShaderOptions]
RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> RenderOpenGLShaderOptions
-> [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
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.
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
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
Ord, ReadPrec [RenderOpenGLShaderOptions]
ReadPrec RenderOpenGLShaderOptions
Int -> ReadS RenderOpenGLShaderOptions
ReadS [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
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
forall a. a -> a -> Bounded a
maxBound :: RenderScaleQuality
$cmaxBound :: RenderScaleQuality
minBound :: RenderScaleQuality
$cminBound :: RenderScaleQuality
Bounded, Typeable RenderScaleQuality
RenderScaleQuality -> DataType
RenderScaleQuality -> Constr
(forall b. Data b => b -> b)
-> RenderScaleQuality -> RenderScaleQuality
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RenderScaleQuality -> u
forall u. (forall d. Data d => d -> u) -> RenderScaleQuality -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderScaleQuality
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderScaleQuality
-> c RenderScaleQuality
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderScaleQuality)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderScaleQuality)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderScaleQuality -> m RenderScaleQuality
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderScaleQuality -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderScaleQuality -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RenderScaleQuality -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderScaleQuality -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderScaleQuality -> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> RenderScaleQuality
RenderScaleQuality -> Int
RenderScaleQuality -> [RenderScaleQuality]
RenderScaleQuality -> RenderScaleQuality
RenderScaleQuality -> RenderScaleQuality -> [RenderScaleQuality]
RenderScaleQuality
-> RenderScaleQuality -> RenderScaleQuality -> [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
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. 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
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
Ord, ReadPrec [RenderScaleQuality]
ReadPrec RenderScaleQuality
Int -> ReadS RenderScaleQuality
ReadS [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
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
forall a. a -> a -> Bounded a
maxBound :: RenderVSyncOptions
$cmaxBound :: RenderVSyncOptions
minBound :: RenderVSyncOptions
$cminBound :: RenderVSyncOptions
Bounded, Typeable RenderVSyncOptions
RenderVSyncOptions -> DataType
RenderVSyncOptions -> Constr
(forall b. Data b => b -> b)
-> RenderVSyncOptions -> RenderVSyncOptions
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RenderVSyncOptions -> u
forall u. (forall d. Data d => d -> u) -> RenderVSyncOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RenderVSyncOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RenderVSyncOptions
-> c RenderVSyncOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RenderVSyncOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RenderVSyncOptions)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RenderVSyncOptions -> m RenderVSyncOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderVSyncOptions -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RenderVSyncOptions -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RenderVSyncOptions -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RenderVSyncOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RenderVSyncOptions -> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> RenderVSyncOptions
RenderVSyncOptions -> Int
RenderVSyncOptions -> [RenderVSyncOptions]
RenderVSyncOptions -> RenderVSyncOptions
RenderVSyncOptions -> RenderVSyncOptions -> [RenderVSyncOptions]
RenderVSyncOptions
-> RenderVSyncOptions -> RenderVSyncOptions -> [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
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. 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
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
Ord, ReadPrec [RenderVSyncOptions]
ReadPrec RenderVSyncOptions
Int -> ReadS RenderVSyncOptions
ReadS [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
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
forall a. a -> a -> Bounded a
maxBound :: VideoWinD3DCompilerOptions
$cmaxBound :: VideoWinD3DCompilerOptions
minBound :: VideoWinD3DCompilerOptions
$cminBound :: VideoWinD3DCompilerOptions
Bounded, Typeable VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions -> DataType
VideoWinD3DCompilerOptions -> Constr
(forall b. Data b => b -> b)
-> VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> u
forall u.
(forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VideoWinD3DCompilerOptions
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VideoWinD3DCompilerOptions
-> c VideoWinD3DCompilerOptions
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VideoWinD3DCompilerOptions)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VideoWinD3DCompilerOptions)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VideoWinD3DCompilerOptions -> m VideoWinD3DCompilerOptions
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u.
Int
-> (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> VideoWinD3DCompilerOptions -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VideoWinD3DCompilerOptions
-> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions -> Int
VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
VideoWinD3DCompilerOptions -> VideoWinD3DCompilerOptions
VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions -> [VideoWinD3DCompilerOptions]
VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> VideoWinD3DCompilerOptions
-> [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
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.
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
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
Ord, ReadPrec [VideoWinD3DCompilerOptions]
ReadPrec VideoWinD3DCompilerOptions
Int -> ReadS VideoWinD3DCompilerOptions
ReadS [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
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 $= :: forall (m :: Type -> Type). MonadIO m => Hint v -> v -> m ()
$= v
v =
    forall (m :: Type -> Type) a v.
MonadIO m =>
(CString -> CString -> IO a) -> Hint v -> v -> m a
_setHint (\CString
name CString
value ->
                forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (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
forall a. a -> a -> Bounded a
maxBound :: HintPriority
$cmaxBound :: HintPriority
minBound :: HintPriority
$cminBound :: HintPriority
Bounded, Typeable HintPriority
HintPriority -> DataType
HintPriority -> Constr
(forall b. Data b => b -> b) -> HintPriority -> HintPriority
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HintPriority -> u
forall u. (forall d. Data d => d -> u) -> HintPriority -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HintPriority
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HintPriority -> c HintPriority
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HintPriority)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HintPriority)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HintPriority -> m HintPriority
gmapM :: forall (m :: Type -> Type).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> HintPriority -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HintPriority -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HintPriority -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HintPriority -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HintPriority -> r
gmapQl :: forall r r'.
(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 (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(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 (c :: Type -> Type).
(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 (c :: Type -> Type).
(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
Data, Int -> HintPriority
HintPriority -> Int
HintPriority -> [HintPriority]
HintPriority -> HintPriority
HintPriority -> HintPriority -> [HintPriority]
HintPriority -> HintPriority -> HintPriority -> [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
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. 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
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
Ord, ReadPrec [HintPriority]
ReadPrec HintPriority
Int -> ReadS HintPriority
ReadS [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
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 :: forall (m :: Type -> Type) v.
MonadIO m =>
HintPriority -> Hint v -> v -> m Bool
setHintWithPriority HintPriority
prio =
  forall (m :: Type -> Type) a v.
MonadIO m =>
(CString -> CString -> IO a) -> Hint v -> v -> m a
_setHint (\CString
name CString
value ->
              forall (m :: Type -> Type).
MonadIO m =>
CString -> CString -> HintPriority -> m Bool
Raw.setHintWithPriority
                CString
name
                CString
value
                (case HintPriority
prio of
                   HintPriority
DefaultPriority -> HintPriority
Raw.SDL_HINT_DEFAULT
                   HintPriority
NormalPriority -> HintPriority
Raw.SDL_HINT_NORMAL
                   HintPriority
OverridePriority -> HintPriority
Raw.SDL_HINT_OVERRIDE))

_setHint :: MonadIO m => (CString -> CString -> IO a) -> Hint v -> v -> m a
_setHint :: forall (m :: Type -> Type) a v.
MonadIO m =>
(CString -> CString -> IO a) -> Hint v -> v -> m a
_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintAccelerometerAsJoystick v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
AccelerometerJoystickOptions
AccelerometerNotJoystick -> String
"0"
         v
AccelerometerJoystickOptions
AccelerometerIsJoystick -> String
"1")
      (CString -> CString -> IO a
f CString
hint)

_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintFramebufferAcceleration v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
FramebufferAccelerationOptions
Disable3D -> String
"0"
         v
FramebufferAccelerationOptions
Enable3DDefault -> String
"1"
         v
FramebufferAccelerationOptions
Enable3DDirect3D -> String
"direct3d"
         v
FramebufferAccelerationOptions
Enable3DOpenGL -> String
"opengl"
         v
FramebufferAccelerationOptions
Enable3DOpenGLES -> String
"opengles"
         v
FramebufferAccelerationOptions
Enable3DOpenGLES2 -> String
"opengles2"
         v
FramebufferAccelerationOptions
Enable3DSoftware -> String
"software"
         )
      (CString -> CString -> IO a
f CString
hint)

_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintMacCTRLClick v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
MacCTRLClickOptions
NoRightClick -> String
"0"
         v
MacCTRLClickOptions
EmulateRightClick -> String
"1")
      (CString -> CString -> IO a
f CString
hint)

_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintMouseRelativeModeWarp v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
MouseModeWarpOptions
MouseRawInput -> String
"0"
         v
MouseModeWarpOptions
MouseWarping -> String
"1")
      (CString -> CString -> IO a
f CString
hint)

_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintRenderDriver v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
RenderDrivers
Direct3D -> String
"direct3d"
         v
RenderDrivers
OpenGL -> String
"opengl"
         v
RenderDrivers
OpenGLES -> String
"opengles"
         v
RenderDrivers
OpenGLES2 -> String
"opengles2"
         v
RenderDrivers
Software -> String
"software")
      (CString -> CString -> IO a
f CString
hint)

_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintRenderOpenGLShaders v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
RenderOpenGLShaderOptions
DisableShaders -> String
"0"
         v
RenderOpenGLShaderOptions
EnableShaders -> String
"1")
      (CString -> CString -> IO a
f CString
hint)

_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintRenderScaleQuality v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
RenderScaleQuality
ScaleNearest -> String
"0"
         v
RenderScaleQuality
ScaleLinear -> String
"1"
         v
RenderScaleQuality
ScaleBest -> String
"2")
      (CString -> CString -> IO a
f CString
hint)

_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintRenderVSync v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
RenderVSyncOptions
DisableVSync -> String
"0"
         v
RenderVSyncOptions
EnableVSync -> String
"1")
      (CString -> CString -> IO a
f CString
hint)

_setHint CString -> CString -> IO a
f h :: Hint v
h@Hint v
HintVideoWinD3DCompiler v
v = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint ->
    forall a. String -> (CString -> IO a) -> IO a
withCString
      (case v
v of
         v
VideoWinD3DCompilerOptions
D3DVistaOrLater -> String
"d3dcompiler_46.dll"
         v
VideoWinD3DCompilerOptions
D3DXPSupport -> String
"d3dcompiler_43.dll"
         v
VideoWinD3DCompilerOptions
D3DNone ->  String
"none")
      (CString -> CString -> IO a
f CString
hint)

-- | Retrieve and map the current value associated with the given hint.
mapHint :: MonadIO m => Hint v -> (String -> Maybe v) -> m v
mapHint :: forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h String -> Maybe v
f = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall a. String -> (CString -> IO a) -> IO a
withCString (forall v. Hint v -> String
hintToString Hint v
h) forall a b. (a -> b) -> a -> b
$ \CString
hint -> do
    String
strResult <- CString -> IO String
peekCString forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type). MonadIO m => CString -> m CString
Raw.getHint CString
hint
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a -> a
fromMaybe
        (forall a e. Exception e => e -> a
throw (String -> String -> SDLException
SDLUnknownHintValue (forall v. Hint v -> String
hintToString Hint v
h) String
strResult))
        (String -> Maybe v
f String
strResult)

instance HasGetter (Hint v) v where
  get :: forall (m :: Type -> Type). MonadIO m => Hint v -> m v
get h :: Hint v
h@Hint v
HintAccelerometerAsJoystick =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
        String
"0" -> forall a. a -> Maybe a
Just AccelerometerJoystickOptions
AccelerometerNotJoystick
        String
"1" -> forall a. a -> Maybe a
Just AccelerometerJoystickOptions
AccelerometerIsJoystick
        String
_ -> forall a. Maybe a
Nothing)

  get h :: Hint v
h@Hint v
HintFramebufferAcceleration =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
         String
"0" -> forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Disable3D
         String
"1" -> forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DDefault
         String
"direct3d" -> forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DDirect3D
         String
"opengl" -> forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DOpenGL
         String
"opengles" -> forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DOpenGLES
         String
"opengles2" -> forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DOpenGLES2
         String
"software" -> forall a. a -> Maybe a
Just FramebufferAccelerationOptions
Enable3DSoftware
         String
_ -> forall a. Maybe a
Nothing)

  get h :: Hint v
h@Hint v
HintMacCTRLClick =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
         String
"0" -> forall a. a -> Maybe a
Just MacCTRLClickOptions
NoRightClick
         String
"1" -> forall a. a -> Maybe a
Just MacCTRLClickOptions
EmulateRightClick
         String
_ -> forall a. Maybe a
Nothing)

  get h :: Hint v
h@Hint v
HintMouseRelativeModeWarp =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
         String
"0" -> forall a. a -> Maybe a
Just MouseModeWarpOptions
MouseRawInput
         String
"1" -> forall a. a -> Maybe a
Just MouseModeWarpOptions
MouseWarping
         String
_ -> forall a. Maybe a
Nothing)

  get h :: Hint v
h@Hint v
HintRenderDriver =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
         String
"direct3d" -> forall a. a -> Maybe a
Just RenderDrivers
Direct3D
         String
"opengl" -> forall a. a -> Maybe a
Just RenderDrivers
OpenGL
         String
"opengles" -> forall a. a -> Maybe a
Just RenderDrivers
OpenGLES
         String
"opengles2" -> forall a. a -> Maybe a
Just RenderDrivers
OpenGLES2
         String
"software" -> forall a. a -> Maybe a
Just RenderDrivers
Software
         String
_ -> forall a. Maybe a
Nothing)

  get h :: Hint v
h@Hint v
HintRenderOpenGLShaders =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
         String
"0" -> forall a. a -> Maybe a
Just RenderOpenGLShaderOptions
DisableShaders
         String
"1" -> forall a. a -> Maybe a
Just RenderOpenGLShaderOptions
EnableShaders
         String
_ -> forall a. Maybe a
Nothing)

  get h :: Hint v
h@Hint v
HintRenderScaleQuality =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
         String
"0" -> forall a. a -> Maybe a
Just RenderScaleQuality
ScaleNearest
         String
"1" -> forall a. a -> Maybe a
Just RenderScaleQuality
ScaleLinear
         String
"2" -> forall a. a -> Maybe a
Just RenderScaleQuality
ScaleBest
         String
_ -> forall a. Maybe a
Nothing)

  get h :: Hint v
h@Hint v
HintRenderVSync =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
         String
"0" -> forall a. a -> Maybe a
Just RenderVSyncOptions
DisableVSync
         String
"1" -> forall a. a -> Maybe a
Just RenderVSyncOptions
EnableVSync
         String
_ -> forall a. Maybe a
Nothing)

  get h :: Hint v
h@Hint v
HintVideoWinD3DCompiler =
    forall (m :: Type -> Type) v.
MonadIO m =>
Hint v -> (String -> Maybe v) -> m v
mapHint Hint v
h (\case
         String
"d3dcompiler_46.dll" -> forall a. a -> Maybe a
Just VideoWinD3DCompilerOptions
D3DVistaOrLater
         String
"d3dcompiler_43.dll" -> forall a. a -> Maybe a
Just VideoWinD3DCompilerOptions
D3DXPSupport
         String
"none" -> forall a. a -> Maybe a
Just VideoWinD3DCompilerOptions
D3DNone
         String
_ -> forall a. Maybe a
Nothing)

hintToString :: Hint v -> String
hintToString :: forall v. Hint v -> String
hintToString Hint v
HintAccelerometerAsJoystick = String
"SDL_ACCELEROMETER_AS_JOYSTICK"
hintToString Hint v
HintFramebufferAcceleration = String
"SDL_FRAMEBUFFER_ACCELERATION"
hintToString Hint v
HintMacCTRLClick            = String
"SDL_MAC_CTRL_CLICK_EMULATE_RIGHT_CLICK"
hintToString Hint v
HintMouseRelativeModeWarp   = String
"SDL_MOUSE_RELATIVE_MODE_WARP"
hintToString Hint v
HintRenderDriver            = String
"SDL_RENDER_DRIVER"
hintToString Hint v
HintRenderOpenGLShaders     = String
"SDL_RENDER_OPENGL_SHADERS"
hintToString Hint v
HintRenderScaleQuality      = String
"SDL_RENDER_SCALE_QUALITY"
hintToString Hint v
HintRenderVSync             = String
"SDL_RENDER_VSYNC"
hintToString Hint v
HintVideoWinD3DCompiler     = String
"SDL_VIDEO_WIN_D3DCOMPILER"

clearHints :: MonadIO m => m ()
clearHints :: forall (m :: Type -> Type). MonadIO m => m ()
clearHints = forall (m :: Type -> Type). MonadIO m => m ()
Raw.clearHints