# 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
  { glColorPrecision = V4 8 8 8 0
  , glDepthPrecision = 24
  , glStencilPrecision = 8
  , glMultisampleSamples = 1
  , glProfile = Compatibility Normal 2 1
  }

-- | Configuration used when creating an OpenGL rendering context.
data OpenGLConfig = OpenGLConfig
  ^ Defaults to ' V4 ' @8 8 8 0@.
  , glDepthPrecision     :: CInt    -- ^ Defaults to @24@.
  , glStencilPrecision   :: CInt    -- ^ Defaults to @8@.
  ^ Defaults to @1@.
  , glProfile            :: Profile -- ^ Defaults to 'Compatibility' 'Normal' @2 1@.
  } deriving (Eq, Generic, Ord, Read, 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  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 (Eq, Generic, Ord, Read, 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 (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

-- | A created OpenGL context.
newtype GLContext = GLContext Raw.GLContext
  deriving (Eq, Typeable)

-- | Create a new OpenGL context and makes it the current context for the
-- window.
--
  Throws '  ' if the window was n't configured with OpenGL
-- support, or if context creation fails.
--
  See @< / SDL_GL_CreateContext SDL_GL_CreateContext>@ for C documentation .
glCreateContext :: (Functor m, MonadIO m) => Window -> m GLContext
glCreateContext (Window w) =
  GLContext <$> throwIfNull "SDL.Video.glCreateContext" "SDL_GL_CreateContext"
    (Raw.glCreateContext w)

-- | Set up an OpenGL context for rendering into an OpenGL window.
--
  Throws '  ' on failure .
--
  See @< / SDL_GL_MakeCurrent SDL_GL_MakeCurrent>@ for C documentation .
glMakeCurrent :: (Functor m, MonadIO m) => Window -> GLContext -> m ()
glMakeCurrent (Window w) (GLContext ctx) =
  throwIfNeg_ "SDL.Video.OpenGL.glMakeCurrent" "SDL_GL_MakeCurrent" $
    Raw.glMakeCurrent w 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 @< / SDL_GL_DeleteContext SDL_GL_DeleteContext>@ for C documentation .
glDeleteContext :: MonadIO m => GLContext -> m ()
glDeleteContext (GLContext ctx) = Raw.glDeleteContext 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 @< SDL_GL_SwapWindow>@ for C documentation.
glSwapWindow :: MonadIO m => Window -> m ()
glSwapWindow (Window w) = Raw.glSwapWindow 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 (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

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

instance FromNumber SwapInterval CInt where
  fromNumber n' =
    case n' of
      0 -> ImmediateUpdates
      1 -> SynchronizedUpdates
      -1 -> LateSwapTearing
      _ ->
        error ("Unknown SwapInterval: " ++ show 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 @< / SDL_GL_SetSwapInterval SDL_GL_SetSwapInterval>@ and @< / SDL_GL_GetSwapInterval SDL_GL_GetSwapInterval>@ for C documentation .
swapInterval :: StateVar SwapInterval
swapInterval = makeStateVar glGetSwapInterval glSetSwapInterval
  where
  glGetSwapInterval = fmap fromNumber $ Raw.glGetSwapInterval

  glSetSwapInterval i =
    throwIfNeg_ "SDL.Video.glSetSwapInterval" "SDL_GL_SetSwapInterval" $
      Raw.glSetSwapInterval (toNumber 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 (Window w) =
    liftIO $
    alloca $ \wptr ->
    alloca $ \hptr -> do
        Raw.glGetDrawableSize w wptr hptr
        V2 <$> peek wptr <*> peek hptr

# LANGUAGE DeriveDataTypeable #
# LANGUAGE OverloadedStrings #
 * Creating and Configuring OpenGL Contexts
 * Querying for the drawable size without a Renderer
 * Swapping
 * Function Loading

 @
   , 'glProfile' = 'Compatibility' 'Normal' 2 1
   }
 @
 | Configuration used when creating an OpenGL rendering context.
 ^ Defaults to @24@.
 ^ Defaults to @8@.
 ^ Defaults to 'Compatibility' 'Normal' @2 1@.
 | The profile a driver should use when creating an OpenGL context.
 ^ Use the OpenGL core profile, with a given major and minor version
 ^ Use an OpenGL profile for embedded systems
 | The mode a driver should use when creating an OpenGL context.
 ^ A normal profile with no special debugging support
 ^ Use a debug context, allowing the usage of extensions such as @GL_ARB_debug_output@
 | A created OpenGL context.
 | Create a new OpenGL context and makes it the current context for the
 window.

 support, or if context creation fails.

 | Set up an OpenGL context for rendering into an OpenGL window.


 | 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.

 | 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 @< SDL_GL_SwapWindow>@ for C documentation.
 | The swap interval for the current OpenGL context.
 ^ No vertical retrace synchronization
 ^ The buffer swap is synchronized with the vertical retrace
 | Get or set the swap interval for the current OpenGL context.


 | Get the size of a window's underlying drawable area in pixels (for use

 It may differ from 'SDL.Video.windowSize' if window was created with 'SDL.Video.windowHighDPI' flag.
# LANGUAGE CPP #
# LANGUAGE DeriveGeneric #
# LANGUAGE FlexibleContexts #
# LANGUAGE MultiParamTypeClasses #

module SDL.Video.OpenGL
    defaultOpenGL
  , OpenGLConfig(..)
  , GLContext
  , glCreateContext
  , Profile(..)
  , Mode(..)
  , glMakeCurrent
  , glDeleteContext

  , glGetDrawableSize

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

  , 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
defaultOpenGL :: OpenGLConfig
defaultOpenGL = OpenGLConfig
  { glColorPrecision = V4 8 8 8 0
  , glDepthPrecision = 24
  , glStencilPrecision = 8
  , glMultisampleSamples = 1
  , glProfile = Compatibility Normal 2 1
  }

data OpenGLConfig = OpenGLConfig
  ^ Defaults to ' V4 ' @8 8 8 0@.
  ^ Defaults to @1@.
  } deriving (Eq, Generic, Ord, Read, Show, Typeable)

data Profile
  = Core Mode CInt CInt
  | Compatibility Mode CInt CInt
  ^ Use the  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
  deriving (Eq, Generic, Ord, Read, Show, Typeable)

data Mode
  = Normal
  | Debug
  deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

newtype GLContext = GLContext Raw.GLContext
  deriving (Eq, Typeable)

  Throws '  ' if the window was n't configured with OpenGL
  See @< / SDL_GL_CreateContext SDL_GL_CreateContext>@ for C documentation .
glCreateContext :: (Functor m, MonadIO m) => Window -> m GLContext
glCreateContext (Window w) =
  GLContext <$> throwIfNull "SDL.Video.glCreateContext" "SDL_GL_CreateContext"
    (Raw.glCreateContext w)

  Throws '  ' on failure .
  See @< / SDL_GL_MakeCurrent SDL_GL_MakeCurrent>@ for C documentation .
glMakeCurrent :: (Functor m, MonadIO m) => Window -> GLContext -> m ()
glMakeCurrent (Window w) (GLContext ctx) =
  throwIfNeg_ "SDL.Video.OpenGL.glMakeCurrent" "SDL_GL_MakeCurrent" $
    Raw.glMakeCurrent w ctx

  See @< / SDL_GL_DeleteContext SDL_GL_DeleteContext>@ for C documentation .
glDeleteContext :: MonadIO m => GLContext -> m ()
glDeleteContext (GLContext ctx) = Raw.glDeleteContext ctx

glSwapWindow :: MonadIO m => Window -> m ()
glSwapWindow (Window w) = Raw.glSwapWindow w

data SwapInterval
  = ImmediateUpdates
  | SynchronizedUpdates
  | LateSwapTearing
  deriving (Bounded, Data, Enum, Eq, Generic, Ord, Read, Show, Typeable)

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

instance FromNumber SwapInterval CInt where
  fromNumber n' =
    case n' of
      0 -> ImmediateUpdates
      1 -> SynchronizedUpdates
      -1 -> LateSwapTearing
      _ ->
        error ("Unknown SwapInterval: " ++ show n')

  This ' StateVar ' can be modified using ' $ = ' and the current value retrieved with ' get ' .
  See @< / SDL_GL_SetSwapInterval SDL_GL_SetSwapInterval>@ and @< / SDL_GL_GetSwapInterval SDL_GL_GetSwapInterval>@ for C documentation .
swapInterval :: StateVar SwapInterval
swapInterval = makeStateVar glGetSwapInterval glSetSwapInterval
  where
  glGetSwapInterval = fmap fromNumber $ Raw.glGetSwapInterval

  glSetSwapInterval i =
    throwIfNeg_ "SDL.Video.glSetSwapInterval" "SDL_GL_SetSwapInterval" $
      Raw.glSetSwapInterval (toNumber i)

  with glViewport ) .
glGetDrawableSize :: MonadIO m => Window -> m (V2 CInt)
glGetDrawableSize (Window w) =
    liftIO $
    alloca $ \wptr ->
    alloca $ \hptr -> do
        Raw.glGetDrawableSize w wptr hptr
        V2 <$> peek wptr <*> peek hptr
