module Graphics.Caramia.Internal.OpenGLCApi
( module GLCore
, module GLTypes
, openGLVersion
, OpenGLVersion(..)
, gi
, gf
, withBoundVAO
, withBoundBuffer
, withBoundElementBuffer
, withBoundPixelUnpackBuffer
, withBoundProgram
, withBoundDrawFramebuffer
, setBoundProgram
, setBoundElementBuffer
, mglDeleteBuffer
, mglGenBuffer
, mglDeleteVertexArray
, mglGenVertexArray
, mglDeleteFramebuffer
, mglGenFramebuffer
, mglDeleteQuery
, mglGenQuery
, mglNamedBufferData
, mglNamedBufferStorage
, mglVertexArrayVertexAttribOffsetAndEnable
, mglVertexArrayVertexAttribIOffsetAndEnable
, mglVertexArrayVertexAttribDivisor
, mglProgramUniform1ui
, mglProgramUniform2ui
, mglProgramUniform3ui
, mglProgramUniform4ui
, mglProgramUniform1i
, mglProgramUniform2i
, mglProgramUniform3i
, mglProgramUniform4i
, mglProgramUniform1f
, mglProgramUniform2f
, mglProgramUniform3f
, mglProgramUniform4f
, mglProgramUniformMatrix4fv
, mglProgramUniformMatrix3fv
, mglMapNamedBufferRange
, mglUnmapNamedBuffer
, mglNamedCopyBufferSubData
, mglFlushMappedNamedBufferRange
)
where
import Control.Monad.IO.Class
import Control.Monad.Catch
import Data.Bits
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import Graphics.Caramia.Internal.Exception
import Graphics.Caramia.Internal.OpenGLVersion
import Graphics.Caramia.Prelude
import Graphics.GL.Standard21 as GLCore
import qualified Graphics.GL.Core33 as GL33
import Graphics.GL.Core33 as GLCore
import qualified Graphics.GL.Ext.EXT.GpuShader4 as EXT
import qualified Graphics.GL.Ext.ARB.InstancedArrays as ARB
import Graphics.GL.Ext.ARB.FramebufferObject ( gl_ARB_framebuffer_object )
import Graphics.GL.Ext.ARB.VertexArrayObject ( gl_ARB_vertex_array_object )
import Graphics.GL.Ext.ARB.BufferStorage
import Graphics.GL.Ext.ARB.CopyBuffer ( gl_ARB_copy_buffer )
import Graphics.GL.Ext.ARB.SeparateShaderObjects
import Graphics.GL.Ext.ARB.DirectStateAccess
import Graphics.GL.Ext.ARB.MapBufferRange
import Graphics.GL.Types as GLTypes
mglDeleteBuffer :: GLuint -> IO ()
mglDeleteBuffer x = with x $ \x_ptr -> glDeleteBuffers 1 x_ptr
mglDeleteVertexArray :: GLuint -> IO ()
mglDeleteVertexArray x = with x $ \x_ptr -> GL33.glDeleteVertexArrays 1 x_ptr
mglGenBuffer :: IO GLuint
mglGenBuffer = alloca $ \x_ptr -> do
if gl_ARB_direct_state_access
then glCreateBuffers 1 x_ptr
else glGenBuffers 1 x_ptr
peek x_ptr
mglGenVertexArray :: IO GLuint
mglGenVertexArray =
checkOpenGLOrExtensionM (OpenGLVersion 3 0)
"GL_ARB_vertex_array_object"
gl_ARB_vertex_array_object
do_it
where
do_it = alloca $ \x_ptr -> GL33.glGenVertexArrays 1 x_ptr *> peek x_ptr
mglGenFramebuffer :: IO GLuint
mglGenFramebuffer =
checkOpenGLOrExtensionM (OpenGLVersion 3 0)
"GL_ARB_framebuffer_object"
gl_ARB_framebuffer_object
do_it
where
do_it = alloca $ \x_ptr -> GL33.glGenFramebuffers 1 x_ptr *> peek x_ptr
mglDeleteFramebuffer :: GLuint -> IO ()
mglDeleteFramebuffer x = with x $ \x_ptr -> GL33.glDeleteFramebuffers 1 x_ptr
mglGenQuery :: IO GLuint
mglGenQuery = alloca $ \x_ptr -> glGenQueries 1 x_ptr *> peek x_ptr
mglDeleteQuery :: GLuint -> IO ()
mglDeleteQuery x = with x $ \x_ptr -> glDeleteQueries 1 x_ptr
withBoundDrawFramebuffer :: (MonadIO m, MonadMask m) => GLuint -> m a -> m a
withBoundDrawFramebuffer x action = do
checkOpenGLOrExtensionM (OpenGLVersion 3 0)
"GL_ARB_framebuffer_object"
gl_ARB_framebuffer_object
do_it
where
do_it = do
old <- gi GL33.GL_DRAW_FRAMEBUFFER_BINDING
finally (GL33.glBindFramebuffer GL33.GL_DRAW_FRAMEBUFFER x >> action)
(GL33.glBindFramebuffer GL33.GL_DRAW_FRAMEBUFFER old)
withBoundProgram :: (MonadIO m, MonadMask m) => GLuint -> m a -> m a
withBoundProgram program action = do
old <-
liftIO $ alloca $ \x_ptr -> glGetIntegerv GL_CURRENT_PROGRAM x_ptr >> peek x_ptr
finally (glUseProgram program >> action)
(glUseProgram $ fromIntegral old)
setBoundProgram :: MonadIO m => GLuint -> m ()
setBoundProgram = glUseProgram
withBoundBuffer :: (MonadIO m, MonadMask m) => GLuint -> m a -> m a
withBoundBuffer buf action = do
old <-
liftIO $ alloca $ \x_ptr -> glGetIntegerv GL_ARRAY_BUFFER_BINDING x_ptr >>
peek x_ptr
finally (glBindBuffer GL_ARRAY_BUFFER buf >> action)
(glBindBuffer GL_ARRAY_BUFFER $ fromIntegral old)
setBoundElementBuffer :: GLuint -> IO ()
setBoundElementBuffer =
glBindBuffer GL_ELEMENT_ARRAY_BUFFER
withBoundElementBuffer :: (MonadIO m, MonadMask m) => GLuint -> m a -> m a
withBoundElementBuffer buf action = do
old <-
liftIO $ alloca $ \x_ptr -> glGetIntegerv GL_ELEMENT_ARRAY_BUFFER_BINDING x_ptr >>
peek x_ptr
finally (glBindBuffer GL_ELEMENT_ARRAY_BUFFER buf >> action)
(glBindBuffer GL_ELEMENT_ARRAY_BUFFER $ fromIntegral old)
withBoundPixelUnpackBuffer :: (MonadIO m, MonadMask m) => GLuint -> m a -> m a
withBoundPixelUnpackBuffer buf action = do
old <-
liftIO $ alloca $ \x_ptr -> glGetIntegerv GL_PIXEL_UNPACK_BUFFER_BINDING x_ptr >>
peek x_ptr
finally (glBindBuffer GL_PIXEL_UNPACK_BUFFER buf >> action)
(glBindBuffer GL_PIXEL_UNPACK_BUFFER $ fromIntegral old)
withBoundVAO :: (MonadIO m, MonadMask m) => GLuint -> m a -> m a
withBoundVAO vao action = do
checkOpenGLOrExtensionM (OpenGLVersion 3 0)
"GL_ARB_vertex_array_object"
gl_ARB_vertex_array_object
do_it
where
do_it = do
old <- gi GL33.GL_VERTEX_ARRAY_BINDING
finally (GL33.glBindVertexArray vao >> action)
(GL33.glBindVertexArray $ fromIntegral old)
mglVertexArrayVertexAttribDivisor ::
GLuint -> GLuint -> GLuint -> IO ()
mglVertexArrayVertexAttribDivisor vaobj index divisor = mask_ $
withBoundVAO vaobj $
if ver >= OpenGLVersion 3 3
then GL33.glVertexAttribDivisor index divisor
else do checkExtension "GL_ARB_instanced_arrays" ARB.gl_ARB_instanced_arrays
ARB.glVertexAttribDivisorARB index divisor
where
ver = openGLVersion
mglVertexArrayVertexAttribOffsetAndEnable ::
GLuint -> GLuint -> GLuint -> GLint -> GLenum
-> GLboolean -> GLsizei -> CPtrdiff -> IO ()
mglVertexArrayVertexAttribOffsetAndEnable
vaobj buffer index size dtype normalized stride (CPtrdiff offset) = mask_ $
withBoundVAO vaobj $
withBoundBuffer buffer $ do
glEnableVertexAttribArray index
glVertexAttribPointer index size dtype normalized stride
(intPtrToPtr $ fromIntegral offset)
mglVertexArrayVertexAttribIOffsetAndEnable ::
GLuint -> GLuint -> GLuint -> GLint -> GLenum
-> GLsizei -> GLintptr -> IO ()
mglVertexArrayVertexAttribIOffsetAndEnable
vaobj buffer index size dtype stride offset = mask_ $
withBoundVAO vaobj $
withBoundBuffer buffer $ do
glEnableVertexAttribArray index
unless (ver >= OpenGLVersion 3 0) $
throwM $ NoSupport $
"OpenGL 3.0 required for integer attribute mapping."
GL33.glVertexAttribIPointer index size dtype stride
(intPtrToPtr $ fromIntegral offset)
where
ver = openGLVersion
mglNamedBufferStorage :: GLuint
-> GLsizeiptr
-> Ptr a
-> GLbitfield
-> IO ()
mglNamedBufferStorage buf size ptr flags =
if gl_ARB_direct_state_access
then glNamedBufferStorage buf (fromIntegral size) (castPtr ptr) flags
else withBoundBuffer buf $ glBufferStorage GL_ARRAY_BUFFER size (castPtr ptr) flags
mglNamedBufferData :: GLuint
-> GLsizeiptr
-> Ptr a
-> GLenum
-> IO ()
mglNamedBufferData buf size ptr usage =
if gl_ARB_direct_state_access
then glNamedBufferData buf (fromIntegral size) (castPtr ptr) usage
else withBoundBuffer buf $ glBufferData GL_ARRAY_BUFFER size (castPtr ptr) usage
mglProgramUniform1ui :: GLuint -> GLint -> GLuint -> IO ()
mglProgramUniform1ui program loc v1 =
if gl_ARB_separate_shader_objects
then glProgramUniform1ui program loc v1
else withBoundProgram program $
if ver >= OpenGLVersion 3 0
then GL33.glUniform1ui loc v1
else do checkExtension "GL_EXT_gpu_shader4" EXT.gl_EXT_gpu_shader4
EXT.glUniform1uiEXT loc v1
where
ver = openGLVersion
mglProgramUniform2ui :: GLuint -> GLint -> GLuint -> GLuint -> IO ()
mglProgramUniform2ui program loc v1 v2 =
if gl_ARB_separate_shader_objects
then glProgramUniform2ui program loc v1 v2
else withBoundProgram program $
if ver >= OpenGLVersion 3 0
then GL33.glUniform2ui loc v1 v2
else do checkExtension "GL_EXT_gpu_shader4" EXT.gl_EXT_gpu_shader4
EXT.glUniform2uiEXT loc v1 v2
where
ver = openGLVersion
mglProgramUniform3ui :: GLuint -> GLint -> GLuint -> GLuint -> GLuint -> IO ()
mglProgramUniform3ui program loc v1 v2 v3 =
if gl_ARB_separate_shader_objects
then glProgramUniform3ui program loc v1 v2 v3
else withBoundProgram program $
if ver >= OpenGLVersion 3 0
then GL33.glUniform3ui loc v1 v2 v3
else do checkExtension "GL_EXT_gpu_shader4" EXT.gl_EXT_gpu_shader4
EXT.glUniform3uiEXT loc v1 v2 v3
where
ver = openGLVersion
mglProgramUniform4ui :: GLuint -> GLint -> GLuint -> GLuint -> GLuint
-> GLuint -> IO ()
mglProgramUniform4ui program loc v1 v2 v3 v4 =
if gl_ARB_separate_shader_objects
then glProgramUniform4ui program loc v1 v2 v3 v4
else withBoundProgram program $
if ver >= OpenGLVersion 3 0
then GL33.glUniform4ui loc v1 v2 v3 v4
else do checkExtension "GL_EXT_gpu_shader4" EXT.gl_EXT_gpu_shader4
EXT.glUniform4uiEXT loc v1 v2 v3 v4
where
ver = openGLVersion
mglProgramUniform1i :: GLuint -> GLint -> GLint -> IO ()
mglProgramUniform1i program loc v1 =
if gl_ARB_separate_shader_objects
then glProgramUniform1i program loc v1
else withBoundProgram program $ glUniform1i loc v1
mglProgramUniform2i :: GLuint -> GLint -> GLint -> GLint -> IO ()
mglProgramUniform2i program loc v1 v2 =
if gl_ARB_separate_shader_objects
then glProgramUniform2i program loc v1 v2
else withBoundProgram program $ glUniform2i loc v1 v2
mglProgramUniform3i :: GLuint -> GLint -> GLint -> GLint -> GLint -> IO ()
mglProgramUniform3i program loc v1 v2 v3 =
if gl_ARB_separate_shader_objects
then glProgramUniform3i program loc v1 v2 v3
else withBoundProgram program $ glUniform3i loc v1 v2 v3
mglProgramUniform4i :: GLuint -> GLint -> GLint -> GLint -> GLint
-> GLint -> IO ()
mglProgramUniform4i program loc v1 v2 v3 v4 =
if gl_ARB_separate_shader_objects
then glProgramUniform4i program loc v1 v2 v3 v4
else withBoundProgram program $ glUniform4i loc v1 v2 v3 v4
mglProgramUniform1f :: GLuint -> GLint -> GLfloat -> IO ()
mglProgramUniform1f program loc v1 =
if gl_ARB_separate_shader_objects
then glProgramUniform1f program loc v1
else withBoundProgram program $ glUniform1f loc v1
mglProgramUniform2f :: GLuint -> GLint -> GLfloat -> GLfloat -> IO ()
mglProgramUniform2f program loc v1 v2 =
if gl_ARB_separate_shader_objects
then glProgramUniform2f program loc v1 v2
else withBoundProgram program $ glUniform2f loc v1 v2
mglProgramUniform3f :: GLuint -> GLint -> GLfloat -> GLfloat -> GLfloat -> IO ()
mglProgramUniform3f program loc v1 v2 v3 =
if gl_ARB_separate_shader_objects
then glProgramUniform3f program loc v1 v2 v3
else withBoundProgram program $ glUniform3f loc v1 v2 v3
mglProgramUniform4f :: GLuint -> GLint
-> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
mglProgramUniform4f program loc v1 v2 v3 v4 =
if gl_ARB_separate_shader_objects
then glProgramUniform4f program loc v1 v2 v3 v4
else withBoundProgram program $ glUniform4f loc v1 v2 v3 v4
mglProgramUniformMatrix4fv :: GLuint -> GLint
-> GLsizei -> GLboolean -> Ptr GLfloat -> IO ()
mglProgramUniformMatrix4fv program loc count transpose m44 =
if gl_ARB_separate_shader_objects
then glProgramUniformMatrix4fv program loc count transpose m44
else withBoundProgram program $ glUniformMatrix4fv loc count transpose m44
mglProgramUniformMatrix3fv :: GLuint -> GLint
-> GLsizei -> GLboolean -> Ptr GLfloat -> IO ()
mglProgramUniformMatrix3fv program loc count transpose m33 =
if gl_ARB_separate_shader_objects
then glProgramUniformMatrix3fv program loc count transpose m33
else withBoundProgram program $ glUniformMatrix3fv loc count transpose m33
mglMapNamedBufferRange :: GLuint -> GLintptr
-> GLsizeiptr -> GLbitfield -> IO (Ptr a)
mglMapNamedBufferRange buffer offset length access = fmap castPtr $
if gl_ARB_direct_state_access && we_have_map_buffer_range
then dsaWay
else nonDsaWay
where
dsaWay = glMapNamedBufferRange buffer
offset
(safeFromIntegral length)
access
nonDsaWay = withBoundBuffer buffer $
if | we_have_map_buffer_range
-> glMapBufferRange GL_ARRAY_BUFFER offset length access
| otherwise
-> case oldwayflags of
Just flags -> do
ptr <- glMapBuffer GL_ARRAY_BUFFER flags
return $ ptr `plusPtr` (fromIntegral offset)
Nothing -> return $ nullPtr `plusPtr` 1
we_have_map_buffer_range = openGLVersion >= OpenGLVersion 3 0 ||
gl_ARB_map_buffer_range
oldwayflags =
let can_read = access .&. GL_MAP_READ_BIT /= 0
can_write = access .&. GL_MAP_WRITE_BIT /= 0
in if | can_read && can_write -> Just GL_READ_WRITE
| can_read -> Just GL_READ_ONLY
| can_write -> Just GL_WRITE_ONLY
| otherwise -> Nothing
mglFlushMappedNamedBufferRange :: GLuint -> GLintptr -> GLsizeiptr -> IO ()
mglFlushMappedNamedBufferRange buffer offset length =
if gl_ARB_direct_state_access && we_have_map_buffer_range
then dsaWay
else when we_have_map_buffer_range $ nonDsaWay
where
dsaWay = glFlushMappedNamedBufferRange buffer offset length
nonDsaWay = withBoundBuffer buffer $
glFlushMappedBufferRange GL_ARRAY_BUFFER offset (fromIntegral length)
we_have_map_buffer_range = openGLVersion >= OpenGLVersion 3 0 ||
gl_ARB_map_buffer_range
mglUnmapNamedBuffer :: GLuint -> IO GLboolean
mglUnmapNamedBuffer buffer =
if gl_ARB_direct_state_access
then glUnmapNamedBuffer buffer
else withBoundBuffer buffer $ glUnmapBuffer GL_ARRAY_BUFFER
mglNamedCopyBufferSubData :: GLuint -> GLuint
-> GLintptr -> GLintptr -> GLsizeiptr -> IO ()
mglNamedCopyBufferSubData src dst src_offset dst_offset num_bytes =
if gl_ARB_direct_state_access && gl_ARB_copy_buffer
then dsaWay
else nonDsaWay
where
dsaWay =
glCopyNamedBufferSubData src dst src_offset dst_offset
(safeFromIntegral num_bytes)
nonDsaWay = withBoundElementBuffer src $ withBoundBuffer dst $
checkOpenGLOrExtensionM (OpenGLVersion 3 1)
"GL_ARB_copy_buffer"
gl_ARB_copy_buffer $
GL33.glCopyBufferSubData GL_ELEMENT_ARRAY_BUFFER
GL_ARRAY_BUFFER
src_offset
dst_offset
num_bytes
gi :: MonadIO m => GLenum -> m GLuint
gi x = liftIO $ alloca $ \get_ptr -> glGetIntegerv x (castPtr get_ptr) *>
peek get_ptr
gf :: MonadIO m => GLenum -> m GLfloat
gf x = liftIO $ alloca $ \get_ptr -> glGetFloatv x (castPtr get_ptr) *> peek get_ptr