{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

module SDL.Video.OpenGL
  ( -- * Creating and Configuring OpenGL Contexts
    defaultOpenGL
  , OpenGLConfig(..)
  , GLContext
  , glCreateContext
  , Profile(..)
  , Mode(..)
  , glMakeCurrent
  , glDeleteContext

  -- * Querying for the drawable size without a Renderer
  , glGetDrawableSize

  -- * Swapping
  -- | The process of \"swapping\" means to move the back-buffer into the window contents itself.
  , glSwapWindow
  , SwapInterval(..)
  , swapInterval

  -- * Function Loading
  , Raw.glGetProcAddress
  ) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Data (Data)
import Data.StateVar
import Data.Typeable
import Foreign hiding (void, throwIfNull, throwIfNeg, throwIfNeg_)
import Foreign.C.Types
import GHC.Generics (Generic)
import SDL.Vect
import SDL.Internal.Exception
import SDL.Internal.Numbered
import SDL.Internal.Types
import qualified SDL.Raw as Raw

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

-- | A set of default options for 'OpenGLConfig'
--
-- @
-- 'defaultOpenGL' = 'OpenGLConfig'
--   { 'glColorPrecision' = V4 8 8 8 0
--   , 'glDepthPrecision' = 24
--   , 'glStencilPrecision' = 8
--   , 'glMultisampleSamples' = 1
--   , 'glProfile' = 'Compatibility' 'Normal' 2 1
--   }
-- @
defaultOpenGL :: OpenGLConfig
defaultOpenGL :: OpenGLConfig
defaultOpenGL = OpenGLConfig
  { glColorPrecision :: V4 CInt
glColorPrecision = forall a. a -> a -> a -> a -> V4 a
V4 CInt
8 CInt
8 CInt
8 CInt
0
  , glDepthPrecision :: CInt
glDepthPrecision = CInt
24
  , glStencilPrecision :: CInt
glStencilPrecision = CInt
8
  , glMultisampleSamples :: CInt
glMultisampleSamples = CInt
1
  , glProfile :: Profile
glProfile = Mode -> CInt -> CInt -> Profile
Compatibility Mode
Normal CInt
2 CInt
1
  }

-- | Configuration used when creating an OpenGL rendering context.
data OpenGLConfig = OpenGLConfig
  { OpenGLConfig -> V4 CInt
glColorPrecision     :: V4 CInt -- ^ Defaults to 'V4' @8 8 8 0@.
  , OpenGLConfig -> CInt
glDepthPrecision     :: CInt    -- ^ Defaults to @24@.
  , OpenGLConfig -> CInt
glStencilPrecision   :: CInt    -- ^ Defaults to @8@.
  , OpenGLConfig -> CInt
glMultisampleSamples :: CInt    -- ^ Defaults to @1@.
  , OpenGLConfig -> Profile
glProfile            :: Profile -- ^ Defaults to 'Compatibility' 'Normal' @2 1@.
  } deriving (OpenGLConfig -> OpenGLConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenGLConfig -> OpenGLConfig -> Bool
$c/= :: OpenGLConfig -> OpenGLConfig -> Bool
== :: OpenGLConfig -> OpenGLConfig -> Bool
$c== :: OpenGLConfig -> OpenGLConfig -> Bool
Eq, forall x. Rep OpenGLConfig x -> OpenGLConfig
forall x. OpenGLConfig -> Rep OpenGLConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpenGLConfig x -> OpenGLConfig
$cfrom :: forall x. OpenGLConfig -> Rep OpenGLConfig x
Generic, Eq OpenGLConfig
OpenGLConfig -> OpenGLConfig -> Bool
OpenGLConfig -> OpenGLConfig -> Ordering
OpenGLConfig -> OpenGLConfig -> OpenGLConfig
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 :: OpenGLConfig -> OpenGLConfig -> OpenGLConfig
$cmin :: OpenGLConfig -> OpenGLConfig -> OpenGLConfig
max :: OpenGLConfig -> OpenGLConfig -> OpenGLConfig
$cmax :: OpenGLConfig -> OpenGLConfig -> OpenGLConfig
>= :: OpenGLConfig -> OpenGLConfig -> Bool
$c>= :: OpenGLConfig -> OpenGLConfig -> Bool
> :: OpenGLConfig -> OpenGLConfig -> Bool
$c> :: OpenGLConfig -> OpenGLConfig -> Bool
<= :: OpenGLConfig -> OpenGLConfig -> Bool
$c<= :: OpenGLConfig -> OpenGLConfig -> Bool
< :: OpenGLConfig -> OpenGLConfig -> Bool
$c< :: OpenGLConfig -> OpenGLConfig -> Bool
compare :: OpenGLConfig -> OpenGLConfig -> Ordering
$ccompare :: OpenGLConfig -> OpenGLConfig -> Ordering
Ord, ReadPrec [OpenGLConfig]
ReadPrec OpenGLConfig
Int -> ReadS OpenGLConfig
ReadS [OpenGLConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpenGLConfig]
$creadListPrec :: ReadPrec [OpenGLConfig]
readPrec :: ReadPrec OpenGLConfig
$creadPrec :: ReadPrec OpenGLConfig
readList :: ReadS [OpenGLConfig]
$creadList :: ReadS [OpenGLConfig]
readsPrec :: Int -> ReadS OpenGLConfig
$creadsPrec :: Int -> ReadS OpenGLConfig
Read, Int -> OpenGLConfig -> ShowS
[OpenGLConfig] -> ShowS
OpenGLConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenGLConfig] -> ShowS
$cshowList :: [OpenGLConfig] -> ShowS
show :: OpenGLConfig -> String
$cshow :: OpenGLConfig -> String
showsPrec :: Int -> OpenGLConfig -> ShowS
$cshowsPrec :: Int -> OpenGLConfig -> ShowS
Show, Typeable)

-- | The profile a driver should use when creating an OpenGL context.
data Profile
  = Core Mode CInt CInt
    -- ^ Use the OpenGL core profile, with a given major and minor version
  | Compatibility Mode CInt CInt
    -- ^ Use the compatibilty profile with a given major and minor version. The compatibility profile allows you to use deprecated functions such as immediate mode
  | ES Mode CInt CInt
    -- ^ Use an OpenGL profile for embedded systems
  deriving (Profile -> Profile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Profile -> Profile -> Bool
$c/= :: Profile -> Profile -> Bool
== :: Profile -> Profile -> Bool
$c== :: Profile -> Profile -> Bool
Eq, forall x. Rep Profile x -> Profile
forall x. Profile -> Rep Profile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Profile x -> Profile
$cfrom :: forall x. Profile -> Rep Profile x
Generic, Eq Profile
Profile -> Profile -> Bool
Profile -> Profile -> Ordering
Profile -> Profile -> Profile
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 :: Profile -> Profile -> Profile
$cmin :: Profile -> Profile -> Profile
max :: Profile -> Profile -> Profile
$cmax :: Profile -> Profile -> Profile
>= :: Profile -> Profile -> Bool
$c>= :: Profile -> Profile -> Bool
> :: Profile -> Profile -> Bool
$c> :: Profile -> Profile -> Bool
<= :: Profile -> Profile -> Bool
$c<= :: Profile -> Profile -> Bool
< :: Profile -> Profile -> Bool
$c< :: Profile -> Profile -> Bool
compare :: Profile -> Profile -> Ordering
$ccompare :: Profile -> Profile -> Ordering
Ord, ReadPrec [Profile]
ReadPrec Profile
Int -> ReadS Profile
ReadS [Profile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Profile]
$creadListPrec :: ReadPrec [Profile]
readPrec :: ReadPrec Profile
$creadPrec :: ReadPrec Profile
readList :: ReadS [Profile]
$creadList :: ReadS [Profile]
readsPrec :: Int -> ReadS Profile
$creadsPrec :: Int -> ReadS Profile
Read, Int -> Profile -> ShowS
[Profile] -> ShowS
Profile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Profile] -> ShowS
$cshowList :: [Profile] -> ShowS
show :: Profile -> String
$cshow :: Profile -> String
showsPrec :: Int -> Profile -> ShowS
$cshowsPrec :: Int -> Profile -> ShowS
Show, Typeable)

-- | The mode a driver should use when creating an OpenGL context.
data Mode
  = Normal
    -- ^ A normal profile with no special debugging support
  | Debug
    -- ^ Use a debug context, allowing the usage of extensions such as @GL_ARB_debug_output@
  deriving (Mode
forall a. a -> a -> Bounded a
maxBound :: Mode
$cmaxBound :: Mode
minBound :: Mode
$cminBound :: Mode
Bounded, Typeable Mode
Mode -> DataType
Mode -> Constr
(forall b. Data b => b -> b) -> Mode -> Mode
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) -> Mode -> u
forall u. (forall d. Data d => d -> u) -> Mode -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
$cgmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
dataTypeOf :: Mode -> DataType
$cdataTypeOf :: Mode -> DataType
toConstr :: Mode -> Constr
$ctoConstr :: Mode -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
Data, Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
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 :: Mode -> Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFrom :: Mode -> [Mode]
fromEnum :: Mode -> Int
$cfromEnum :: Mode -> Int
toEnum :: Int -> Mode
$ctoEnum :: Int -> Mode
pred :: Mode -> Mode
$cpred :: Mode -> Mode
succ :: Mode -> Mode
$csucc :: Mode -> Mode
Enum, Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mode x -> Mode
$cfrom :: forall x. Mode -> Rep Mode x
Generic, Eq Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
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 :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
Ord, ReadPrec [Mode]
ReadPrec Mode
Int -> ReadS Mode
ReadS [Mode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mode]
$creadListPrec :: ReadPrec [Mode]
readPrec :: ReadPrec Mode
$creadPrec :: ReadPrec Mode
readList :: ReadS [Mode]
$creadList :: ReadS [Mode]
readsPrec :: Int -> ReadS Mode
$creadsPrec :: Int -> ReadS Mode
Read, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, Typeable)

-- | A created OpenGL context.
newtype GLContext = GLContext Raw.GLContext
  deriving (GLContext -> GLContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GLContext -> GLContext -> Bool
$c/= :: GLContext -> GLContext -> Bool
== :: GLContext -> GLContext -> Bool
$c== :: GLContext -> GLContext -> Bool
Eq, Typeable)

-- | Create a new OpenGL context and makes it the current context for the
-- window.
--
-- Throws 'SDLException' if the window wasn't configured with OpenGL
-- support, or if context creation fails.
--
-- See @<https://wiki.libsdl.org/SDL_GL_CreateContext SDL_GL_CreateContext>@ for C documentation.
glCreateContext :: (Functor m, MonadIO m) => Window -> m GLContext
glCreateContext :: forall (m :: Type -> Type).
(Functor m, MonadIO m) =>
Window -> m GLContext
glCreateContext (Window GLContext
w) =
  GLContext -> GLContext
GLContext forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Type -> Type) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Video.glCreateContext" Text
"SDL_GL_CreateContext"
    (forall (m :: Type -> Type). MonadIO m => GLContext -> m GLContext
Raw.glCreateContext GLContext
w)

-- | Set up an OpenGL context for rendering into an OpenGL window.
--
-- Throws 'SDLException' on failure.
--
-- See @<https://wiki.libsdl.org/SDL_GL_MakeCurrent SDL_GL_MakeCurrent>@ for C documentation.
glMakeCurrent :: (Functor m, MonadIO m) => Window -> GLContext -> m ()
glMakeCurrent :: forall (m :: Type -> Type).
(Functor m, MonadIO m) =>
Window -> GLContext -> m ()
glMakeCurrent (Window GLContext
w) (GLContext GLContext
ctx) =
  forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Video.OpenGL.glMakeCurrent" Text
"SDL_GL_MakeCurrent" forall a b. (a -> b) -> a -> b
$
    forall (m :: Type -> Type).
MonadIO m =>
GLContext -> GLContext -> m CInt
Raw.glMakeCurrent GLContext
w GLContext
ctx

-- | Delete the given OpenGL context.
--
-- You /must/ make sure that there are no pending commands in the OpenGL
-- command queue, the driver may still be processing commands even if you have
-- stopped issuing them!
--
-- The @glFinish@ command will block until the command queue has been fully
-- processed. You should call that function before deleting a context.
--
-- See @<https://wiki.libsdl.org/SDL_GL_DeleteContext SDL_GL_DeleteContext>@ for C documentation.
glDeleteContext :: MonadIO m => GLContext -> m ()
glDeleteContext :: forall (m :: Type -> Type). MonadIO m => GLContext -> m ()
glDeleteContext (GLContext GLContext
ctx) = forall (m :: Type -> Type). MonadIO m => GLContext -> m ()
Raw.glDeleteContext GLContext
ctx

-- | Replace the contents of the front buffer with the back buffer's. The
-- contents of the back buffer are undefined, clear them with @glClear@ or
-- equivalent before drawing to them again.
--
-- See @<https://wiki.libsdl.org/SDL_GL_SwapWindow SDL_GL_SwapWindow>@ for C documentation.
glSwapWindow :: MonadIO m => Window -> m ()
glSwapWindow :: forall (m :: Type -> Type). MonadIO m => Window -> m ()
glSwapWindow (Window GLContext
w) = forall (m :: Type -> Type). MonadIO m => GLContext -> m ()
Raw.glSwapWindow GLContext
w

-- | The swap interval for the current OpenGL context.
data SwapInterval
  = ImmediateUpdates
    -- ^ No vertical retrace synchronization
  | SynchronizedUpdates
    -- ^ The buffer swap is synchronized with the vertical retrace
  | LateSwapTearing
  deriving (SwapInterval
forall a. a -> a -> Bounded a
maxBound :: SwapInterval
$cmaxBound :: SwapInterval
minBound :: SwapInterval
$cminBound :: SwapInterval
Bounded, Typeable SwapInterval
SwapInterval -> DataType
SwapInterval -> Constr
(forall b. Data b => b -> b) -> SwapInterval -> SwapInterval
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) -> SwapInterval -> u
forall u. (forall d. Data d => d -> u) -> SwapInterval -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SwapInterval -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SwapInterval -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> SwapInterval -> m SwapInterval
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwapInterval -> m SwapInterval
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SwapInterval
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SwapInterval -> c SwapInterval
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SwapInterval)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SwapInterval)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwapInterval -> m SwapInterval
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwapInterval -> m SwapInterval
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwapInterval -> m SwapInterval
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SwapInterval -> m SwapInterval
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> SwapInterval -> m SwapInterval
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> SwapInterval -> m SwapInterval
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SwapInterval -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SwapInterval -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SwapInterval -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SwapInterval -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SwapInterval -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SwapInterval -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SwapInterval -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SwapInterval -> r
gmapT :: (forall b. Data b => b -> b) -> SwapInterval -> SwapInterval
$cgmapT :: (forall b. Data b => b -> b) -> SwapInterval -> SwapInterval
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SwapInterval)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SwapInterval)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SwapInterval)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SwapInterval)
dataTypeOf :: SwapInterval -> DataType
$cdataTypeOf :: SwapInterval -> DataType
toConstr :: SwapInterval -> Constr
$ctoConstr :: SwapInterval -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SwapInterval
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SwapInterval
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SwapInterval -> c SwapInterval
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SwapInterval -> c SwapInterval
Data, Int -> SwapInterval
SwapInterval -> Int
SwapInterval -> [SwapInterval]
SwapInterval -> SwapInterval
SwapInterval -> SwapInterval -> [SwapInterval]
SwapInterval -> SwapInterval -> SwapInterval -> [SwapInterval]
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 :: SwapInterval -> SwapInterval -> SwapInterval -> [SwapInterval]
$cenumFromThenTo :: SwapInterval -> SwapInterval -> SwapInterval -> [SwapInterval]
enumFromTo :: SwapInterval -> SwapInterval -> [SwapInterval]
$cenumFromTo :: SwapInterval -> SwapInterval -> [SwapInterval]
enumFromThen :: SwapInterval -> SwapInterval -> [SwapInterval]
$cenumFromThen :: SwapInterval -> SwapInterval -> [SwapInterval]
enumFrom :: SwapInterval -> [SwapInterval]
$cenumFrom :: SwapInterval -> [SwapInterval]
fromEnum :: SwapInterval -> Int
$cfromEnum :: SwapInterval -> Int
toEnum :: Int -> SwapInterval
$ctoEnum :: Int -> SwapInterval
pred :: SwapInterval -> SwapInterval
$cpred :: SwapInterval -> SwapInterval
succ :: SwapInterval -> SwapInterval
$csucc :: SwapInterval -> SwapInterval
Enum, SwapInterval -> SwapInterval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwapInterval -> SwapInterval -> Bool
$c/= :: SwapInterval -> SwapInterval -> Bool
== :: SwapInterval -> SwapInterval -> Bool
$c== :: SwapInterval -> SwapInterval -> Bool
Eq, forall x. Rep SwapInterval x -> SwapInterval
forall x. SwapInterval -> Rep SwapInterval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SwapInterval x -> SwapInterval
$cfrom :: forall x. SwapInterval -> Rep SwapInterval x
Generic, Eq SwapInterval
SwapInterval -> SwapInterval -> Bool
SwapInterval -> SwapInterval -> Ordering
SwapInterval -> SwapInterval -> SwapInterval
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 :: SwapInterval -> SwapInterval -> SwapInterval
$cmin :: SwapInterval -> SwapInterval -> SwapInterval
max :: SwapInterval -> SwapInterval -> SwapInterval
$cmax :: SwapInterval -> SwapInterval -> SwapInterval
>= :: SwapInterval -> SwapInterval -> Bool
$c>= :: SwapInterval -> SwapInterval -> Bool
> :: SwapInterval -> SwapInterval -> Bool
$c> :: SwapInterval -> SwapInterval -> Bool
<= :: SwapInterval -> SwapInterval -> Bool
$c<= :: SwapInterval -> SwapInterval -> Bool
< :: SwapInterval -> SwapInterval -> Bool
$c< :: SwapInterval -> SwapInterval -> Bool
compare :: SwapInterval -> SwapInterval -> Ordering
$ccompare :: SwapInterval -> SwapInterval -> Ordering
Ord, ReadPrec [SwapInterval]
ReadPrec SwapInterval
Int -> ReadS SwapInterval
ReadS [SwapInterval]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwapInterval]
$creadListPrec :: ReadPrec [SwapInterval]
readPrec :: ReadPrec SwapInterval
$creadPrec :: ReadPrec SwapInterval
readList :: ReadS [SwapInterval]
$creadList :: ReadS [SwapInterval]
readsPrec :: Int -> ReadS SwapInterval
$creadsPrec :: Int -> ReadS SwapInterval
Read, Int -> SwapInterval -> ShowS
[SwapInterval] -> ShowS
SwapInterval -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwapInterval] -> ShowS
$cshowList :: [SwapInterval] -> ShowS
show :: SwapInterval -> String
$cshow :: SwapInterval -> String
showsPrec :: Int -> SwapInterval -> ShowS
$cshowsPrec :: Int -> SwapInterval -> ShowS
Show, Typeable)

instance ToNumber SwapInterval CInt where
  toNumber :: SwapInterval -> CInt
toNumber SwapInterval
ImmediateUpdates = CInt
0
  toNumber SwapInterval
SynchronizedUpdates = CInt
1
  toNumber SwapInterval
LateSwapTearing = -CInt
1

instance FromNumber SwapInterval CInt where
  fromNumber :: CInt -> SwapInterval
fromNumber CInt
n' =
    case CInt
n' of
      CInt
0 -> SwapInterval
ImmediateUpdates
      CInt
1 -> SwapInterval
SynchronizedUpdates
      -1 -> SwapInterval
LateSwapTearing
      CInt
_ ->
        forall a. HasCallStack => String -> a
error (String
"Unknown SwapInterval: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CInt
n')

-- | Get or set the swap interval for the current OpenGL context.
--
-- This 'StateVar' can be modified using '$=' and the current value retrieved with 'get'.
--
-- See @<https://wiki.libsdl.org/SDL_GL_SetSwapInterval SDL_GL_SetSwapInterval>@ and @<https://wiki.libsdl.org/SDL_GL_GetSwapInterval SDL_GL_GetSwapInterval>@ for C documentation.
swapInterval :: StateVar SwapInterval
swapInterval :: StateVar SwapInterval
swapInterval = forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO SwapInterval
glGetSwapInterval forall {m :: Type -> Type} {a}.
(MonadIO m, ToNumber a CInt) =>
a -> m ()
glSetSwapInterval
  where
  glGetSwapInterval :: IO SwapInterval
glGetSwapInterval = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. FromNumber a b => b -> a
fromNumber forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type). MonadIO m => m CInt
Raw.glGetSwapInterval

  glSetSwapInterval :: a -> m ()
glSetSwapInterval a
i =
    forall (m :: Type -> Type) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ Text
"SDL.Video.glSetSwapInterval" Text
"SDL_GL_SetSwapInterval" forall a b. (a -> b) -> a -> b
$
      forall (m :: Type -> Type). MonadIO m => CInt -> m CInt
Raw.glSetSwapInterval (forall a b. ToNumber a b => a -> b
toNumber a
i)

-- | Get the size of a window's underlying drawable area in pixels (for use
-- with glViewport).
--
-- It may differ from 'SDL.Video.windowSize' if window was created with 'SDL.Video.windowHighDPI' flag.
glGetDrawableSize :: MonadIO m => Window -> m (V2 CInt)
glGetDrawableSize :: forall (m :: Type -> Type). MonadIO m => Window -> m (V2 CInt)
glGetDrawableSize (Window GLContext
w) =
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wptr ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
hptr -> do
        forall (m :: Type -> Type).
MonadIO m =>
GLContext -> Ptr CInt -> Ptr CInt -> m ()
Raw.glGetDrawableSize GLContext
w Ptr CInt
wptr Ptr CInt
hptr
        forall a. a -> a -> V2 a
V2 forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wptr forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
hptr