--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.BufferObjects
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 2.9 (Buffer Objects) of the OpenGL 2.1
-- specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.BufferObjects (
   -- * Buffer Objects
   BufferObject,

   -- * Binding Buffer Objects
   BufferTarget(..), bindBuffer, arrayBufferBinding,
   vertexAttribArrayBufferBinding,

   -- * Handling Buffer Data
   BufferUsage(..), bufferData, TransferDirection(..), bufferSubData,

   -- * Mapping Buffer Objects
   BufferAccess(..), MappingFailure(..), withMappedBuffer,
   mapBuffer, unmapBuffer,
   bufferAccess, bufferMapped,

   MapBufferUsage(..), Offset, Length,
   mapBufferRange, flushMappedBufferRange,

   -- * Indexed Buffer manipulation
   BufferIndex,
   RangeStartIndex, RangeSize,
   BufferRange,
   IndexedBufferTarget(..),
   bindBufferBase, bindBufferRange,
   indexedBufferStart, indexedBufferSize
) where

import Control.Monad.IO.Class
import Data.Maybe ( fromMaybe )
import Data.ObjectName
import Data.StateVar
import Foreign.Marshal.Array ( allocaArray, peekArray, withArrayLen )
import Foreign.Marshal.Utils ( with )
import Foreign.Ptr ( Ptr, nullPtr )
import Graphics.Rendering.OpenGL.GL.DebugOutput
import Graphics.Rendering.OpenGL.GL.Exception
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.VertexArrays
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL

--------------------------------------------------------------------------------

newtype BufferObject = BufferObject { BufferObject -> GLuint
bufferID :: GLuint }
   deriving ( BufferObject -> BufferObject -> Bool
(BufferObject -> BufferObject -> Bool)
-> (BufferObject -> BufferObject -> Bool) -> Eq BufferObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BufferObject -> BufferObject -> Bool
== :: BufferObject -> BufferObject -> Bool
$c/= :: BufferObject -> BufferObject -> Bool
/= :: BufferObject -> BufferObject -> Bool
Eq, Eq BufferObject
Eq BufferObject =>
(BufferObject -> BufferObject -> Ordering)
-> (BufferObject -> BufferObject -> Bool)
-> (BufferObject -> BufferObject -> Bool)
-> (BufferObject -> BufferObject -> Bool)
-> (BufferObject -> BufferObject -> Bool)
-> (BufferObject -> BufferObject -> BufferObject)
-> (BufferObject -> BufferObject -> BufferObject)
-> Ord BufferObject
BufferObject -> BufferObject -> Bool
BufferObject -> BufferObject -> Ordering
BufferObject -> BufferObject -> BufferObject
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
$ccompare :: BufferObject -> BufferObject -> Ordering
compare :: BufferObject -> BufferObject -> Ordering
$c< :: BufferObject -> BufferObject -> Bool
< :: BufferObject -> BufferObject -> Bool
$c<= :: BufferObject -> BufferObject -> Bool
<= :: BufferObject -> BufferObject -> Bool
$c> :: BufferObject -> BufferObject -> Bool
> :: BufferObject -> BufferObject -> Bool
$c>= :: BufferObject -> BufferObject -> Bool
>= :: BufferObject -> BufferObject -> Bool
$cmax :: BufferObject -> BufferObject -> BufferObject
max :: BufferObject -> BufferObject -> BufferObject
$cmin :: BufferObject -> BufferObject -> BufferObject
min :: BufferObject -> BufferObject -> BufferObject
Ord, Int -> BufferObject -> ShowS
[BufferObject] -> ShowS
BufferObject -> String
(Int -> BufferObject -> ShowS)
-> (BufferObject -> String)
-> ([BufferObject] -> ShowS)
-> Show BufferObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BufferObject -> ShowS
showsPrec :: Int -> BufferObject -> ShowS
$cshow :: BufferObject -> String
show :: BufferObject -> String
$cshowList :: [BufferObject] -> ShowS
showList :: [BufferObject] -> ShowS
Show )

--------------------------------------------------------------------------------

instance ObjectName BufferObject where
   isObjectName :: forall (m :: * -> *). MonadIO m => BufferObject -> m Bool
isObjectName = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool)
-> (BufferObject -> IO Bool) -> BufferObject -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLboolean -> Bool) -> IO GLboolean -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GLboolean -> Bool
forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean (IO GLboolean -> IO Bool)
-> (BufferObject -> IO GLboolean) -> BufferObject -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLuint -> IO GLboolean
forall (m :: * -> *). MonadIO m => GLuint -> m GLboolean
glIsBuffer (GLuint -> IO GLboolean)
-> (BufferObject -> GLuint) -> BufferObject -> IO GLboolean
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferObject -> GLuint
bufferID

   deleteObjectNames :: forall (m :: * -> *). MonadIO m => [BufferObject] -> m ()
deleteObjectNames [BufferObject]
bufferObjects =
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> ((Int -> Ptr GLuint -> IO ()) -> IO ())
-> (Int -> Ptr GLuint -> IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GLuint] -> (Int -> Ptr GLuint -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((BufferObject -> GLuint) -> [BufferObject] -> [GLuint]
forall a b. (a -> b) -> [a] -> [b]
map BufferObject -> GLuint
bufferID [BufferObject]
bufferObjects) ((Int -> Ptr GLuint -> IO ()) -> m ())
-> (Int -> Ptr GLuint -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$
         GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glDeleteBuffers (GLint -> Ptr GLuint -> IO ())
-> (Int -> GLint) -> Int -> Ptr GLuint -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance GeneratableObjectName BufferObject where
   genObjectNames :: forall (m :: * -> *). MonadIO m => Int -> m [BufferObject]
genObjectNames Int
n =
      IO [BufferObject] -> m [BufferObject]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [BufferObject] -> m [BufferObject])
-> ((Ptr GLuint -> IO [BufferObject]) -> IO [BufferObject])
-> (Ptr GLuint -> IO [BufferObject])
-> m [BufferObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Ptr GLuint -> IO [BufferObject]) -> IO [BufferObject]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n ((Ptr GLuint -> IO [BufferObject]) -> m [BufferObject])
-> (Ptr GLuint -> IO [BufferObject]) -> m [BufferObject]
forall a b. (a -> b) -> a -> b
$ \Ptr GLuint
buf -> do
        GLint -> Ptr GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLint -> Ptr GLuint -> m ()
glGenBuffers (Int -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Ptr GLuint
buf
        ([GLuint] -> [BufferObject]) -> IO [GLuint] -> IO [BufferObject]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GLuint -> BufferObject) -> [GLuint] -> [BufferObject]
forall a b. (a -> b) -> [a] -> [b]
map GLuint -> BufferObject
BufferObject) (IO [GLuint] -> IO [BufferObject])
-> IO [GLuint] -> IO [BufferObject]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr GLuint -> IO [GLuint]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr GLuint
buf

instance CanBeLabeled BufferObject where
   objectLabel :: BufferObject -> StateVar (Maybe String)
objectLabel = GLuint -> GLuint -> StateVar (Maybe String)
objectNameLabel GLuint
GL_BUFFER (GLuint -> StateVar (Maybe String))
-> (BufferObject -> GLuint)
-> BufferObject
-> StateVar (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferObject -> GLuint
bufferID

--------------------------------------------------------------------------------

data BufferTarget =
     ArrayBuffer
   | AtomicCounterBuffer
   | CopyReadBuffer
   | CopyWriteBuffer
   | DispatchIndirectBuffer
   | DrawIndirectBuffer
   | ElementArrayBuffer
   | PixelPackBuffer
   | PixelUnpackBuffer
   | QueryBuffer
   | ShaderStorageBuffer
   | TextureBuffer
   | TransformFeedbackBuffer
   | UniformBuffer
   deriving ( BufferTarget -> BufferTarget -> Bool
(BufferTarget -> BufferTarget -> Bool)
-> (BufferTarget -> BufferTarget -> Bool) -> Eq BufferTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BufferTarget -> BufferTarget -> Bool
== :: BufferTarget -> BufferTarget -> Bool
$c/= :: BufferTarget -> BufferTarget -> Bool
/= :: BufferTarget -> BufferTarget -> Bool
Eq, Eq BufferTarget
Eq BufferTarget =>
(BufferTarget -> BufferTarget -> Ordering)
-> (BufferTarget -> BufferTarget -> Bool)
-> (BufferTarget -> BufferTarget -> Bool)
-> (BufferTarget -> BufferTarget -> Bool)
-> (BufferTarget -> BufferTarget -> Bool)
-> (BufferTarget -> BufferTarget -> BufferTarget)
-> (BufferTarget -> BufferTarget -> BufferTarget)
-> Ord BufferTarget
BufferTarget -> BufferTarget -> Bool
BufferTarget -> BufferTarget -> Ordering
BufferTarget -> BufferTarget -> BufferTarget
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
$ccompare :: BufferTarget -> BufferTarget -> Ordering
compare :: BufferTarget -> BufferTarget -> Ordering
$c< :: BufferTarget -> BufferTarget -> Bool
< :: BufferTarget -> BufferTarget -> Bool
$c<= :: BufferTarget -> BufferTarget -> Bool
<= :: BufferTarget -> BufferTarget -> Bool
$c> :: BufferTarget -> BufferTarget -> Bool
> :: BufferTarget -> BufferTarget -> Bool
$c>= :: BufferTarget -> BufferTarget -> Bool
>= :: BufferTarget -> BufferTarget -> Bool
$cmax :: BufferTarget -> BufferTarget -> BufferTarget
max :: BufferTarget -> BufferTarget -> BufferTarget
$cmin :: BufferTarget -> BufferTarget -> BufferTarget
min :: BufferTarget -> BufferTarget -> BufferTarget
Ord, Int -> BufferTarget -> ShowS
[BufferTarget] -> ShowS
BufferTarget -> String
(Int -> BufferTarget -> ShowS)
-> (BufferTarget -> String)
-> ([BufferTarget] -> ShowS)
-> Show BufferTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BufferTarget -> ShowS
showsPrec :: Int -> BufferTarget -> ShowS
$cshow :: BufferTarget -> String
show :: BufferTarget -> String
$cshowList :: [BufferTarget] -> ShowS
showList :: [BufferTarget] -> ShowS
Show )

marshalBufferTarget :: BufferTarget -> GLenum
marshalBufferTarget :: BufferTarget -> GLuint
marshalBufferTarget BufferTarget
x = case BufferTarget
x of
   BufferTarget
ArrayBuffer -> GLuint
GL_ARRAY_BUFFER
   BufferTarget
AtomicCounterBuffer -> GLuint
GL_ATOMIC_COUNTER_BUFFER
   BufferTarget
CopyReadBuffer -> GLuint
GL_COPY_READ_BUFFER
   BufferTarget
CopyWriteBuffer -> GLuint
GL_COPY_WRITE_BUFFER
   BufferTarget
DispatchIndirectBuffer -> GLuint
GL_DISPATCH_INDIRECT_BUFFER
   BufferTarget
DrawIndirectBuffer -> GLuint
GL_DRAW_INDIRECT_BUFFER
   BufferTarget
ElementArrayBuffer -> GLuint
GL_ELEMENT_ARRAY_BUFFER
   BufferTarget
PixelPackBuffer -> GLuint
GL_PIXEL_PACK_BUFFER
   BufferTarget
PixelUnpackBuffer -> GLuint
GL_PIXEL_UNPACK_BUFFER
   BufferTarget
QueryBuffer -> GLuint
GL_QUERY_BUFFER
   BufferTarget
ShaderStorageBuffer -> GLuint
GL_SHADER_STORAGE_BUFFER
   BufferTarget
TextureBuffer -> GLuint
GL_TEXTURE_BUFFER
   BufferTarget
TransformFeedbackBuffer -> GLuint
GL_TRANSFORM_FEEDBACK_BUFFER
   BufferTarget
UniformBuffer -> GLuint
GL_UNIFORM_BUFFER

bufferTargetToGetPName :: BufferTarget -> PName1I
bufferTargetToGetPName :: BufferTarget -> PName1I
bufferTargetToGetPName BufferTarget
x = case BufferTarget
x of
   BufferTarget
ArrayBuffer -> PName1I
GetArrayBufferBinding
   BufferTarget
AtomicCounterBuffer -> PName1I
GetAtomicCounterBufferBinding
   BufferTarget
CopyReadBuffer -> PName1I
GetCopyReadBufferBinding
   BufferTarget
CopyWriteBuffer -> PName1I
GetCopyWriteBufferBinding
   BufferTarget
DispatchIndirectBuffer -> PName1I
GetDispatchIndirectBufferBinding
   BufferTarget
DrawIndirectBuffer -> PName1I
GetDrawIndirectBufferBinding
   BufferTarget
ElementArrayBuffer -> PName1I
GetElementArrayBufferBinding
   BufferTarget
PixelPackBuffer -> PName1I
GetPixelPackBufferBinding
   BufferTarget
PixelUnpackBuffer -> PName1I
GetPixelUnpackBufferBinding
   BufferTarget
QueryBuffer -> PName1I
GetQueryBufferBinding
   BufferTarget
ShaderStorageBuffer -> PName1I
GetShaderStorageBufferBinding
   BufferTarget
TextureBuffer -> PName1I
GetTextureBindingBuffer
   BufferTarget
TransformFeedbackBuffer -> PName1I
GetTransformFeedbackBufferBinding
   BufferTarget
UniformBuffer -> PName1I
GetUniformBufferBinding

--------------------------------------------------------------------------------

data BufferUsage =
     StreamDraw
   | StreamRead
   | StreamCopy
   | StaticDraw
   | StaticRead
   | StaticCopy
   | DynamicDraw
   | DynamicRead
   | DynamicCopy
   deriving ( BufferUsage -> BufferUsage -> Bool
(BufferUsage -> BufferUsage -> Bool)
-> (BufferUsage -> BufferUsage -> Bool) -> Eq BufferUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BufferUsage -> BufferUsage -> Bool
== :: BufferUsage -> BufferUsage -> Bool
$c/= :: BufferUsage -> BufferUsage -> Bool
/= :: BufferUsage -> BufferUsage -> Bool
Eq, Eq BufferUsage
Eq BufferUsage =>
(BufferUsage -> BufferUsage -> Ordering)
-> (BufferUsage -> BufferUsage -> Bool)
-> (BufferUsage -> BufferUsage -> Bool)
-> (BufferUsage -> BufferUsage -> Bool)
-> (BufferUsage -> BufferUsage -> Bool)
-> (BufferUsage -> BufferUsage -> BufferUsage)
-> (BufferUsage -> BufferUsage -> BufferUsage)
-> Ord BufferUsage
BufferUsage -> BufferUsage -> Bool
BufferUsage -> BufferUsage -> Ordering
BufferUsage -> BufferUsage -> BufferUsage
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
$ccompare :: BufferUsage -> BufferUsage -> Ordering
compare :: BufferUsage -> BufferUsage -> Ordering
$c< :: BufferUsage -> BufferUsage -> Bool
< :: BufferUsage -> BufferUsage -> Bool
$c<= :: BufferUsage -> BufferUsage -> Bool
<= :: BufferUsage -> BufferUsage -> Bool
$c> :: BufferUsage -> BufferUsage -> Bool
> :: BufferUsage -> BufferUsage -> Bool
$c>= :: BufferUsage -> BufferUsage -> Bool
>= :: BufferUsage -> BufferUsage -> Bool
$cmax :: BufferUsage -> BufferUsage -> BufferUsage
max :: BufferUsage -> BufferUsage -> BufferUsage
$cmin :: BufferUsage -> BufferUsage -> BufferUsage
min :: BufferUsage -> BufferUsage -> BufferUsage
Ord, Int -> BufferUsage -> ShowS
[BufferUsage] -> ShowS
BufferUsage -> String
(Int -> BufferUsage -> ShowS)
-> (BufferUsage -> String)
-> ([BufferUsage] -> ShowS)
-> Show BufferUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BufferUsage -> ShowS
showsPrec :: Int -> BufferUsage -> ShowS
$cshow :: BufferUsage -> String
show :: BufferUsage -> String
$cshowList :: [BufferUsage] -> ShowS
showList :: [BufferUsage] -> ShowS
Show )

marshalBufferUsage :: BufferUsage -> GLenum
marshalBufferUsage :: BufferUsage -> GLuint
marshalBufferUsage BufferUsage
x = case BufferUsage
x of
   BufferUsage
StreamDraw -> GLuint
GL_STREAM_DRAW
   BufferUsage
StreamRead -> GLuint
GL_STREAM_READ
   BufferUsage
StreamCopy -> GLuint
GL_STREAM_COPY
   BufferUsage
StaticDraw -> GLuint
GL_STATIC_DRAW
   BufferUsage
StaticRead -> GLuint
GL_STATIC_READ
   BufferUsage
StaticCopy -> GLuint
GL_STATIC_COPY
   BufferUsage
DynamicDraw -> GLuint
GL_DYNAMIC_DRAW
   BufferUsage
DynamicRead -> GLuint
GL_DYNAMIC_READ
   BufferUsage
DynamicCopy -> GLuint
GL_DYNAMIC_COPY

unmarshalBufferUsage :: GLenum -> BufferUsage
unmarshalBufferUsage :: GLuint -> BufferUsage
unmarshalBufferUsage GLuint
x
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_STREAM_DRAW = BufferUsage
StreamDraw
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_STREAM_READ = BufferUsage
StreamRead
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_STREAM_COPY = BufferUsage
StreamCopy
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_STATIC_DRAW = BufferUsage
StaticDraw
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_STATIC_READ = BufferUsage
StaticRead
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_STATIC_COPY = BufferUsage
StaticCopy
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_DYNAMIC_DRAW = BufferUsage
DynamicDraw
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_DYNAMIC_READ = BufferUsage
DynamicRead
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_DYNAMIC_COPY = BufferUsage
DynamicCopy
   | Bool
otherwise = String -> BufferUsage
forall a. HasCallStack => String -> a
error (String
"unmarshalBufferUsage: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLuint -> String
forall a. Show a => a -> String
show GLuint
x)

--------------------------------------------------------------------------------

data BufferAccess =
     ReadOnly
   | WriteOnly
   | ReadWrite
   deriving ( BufferAccess -> BufferAccess -> Bool
(BufferAccess -> BufferAccess -> Bool)
-> (BufferAccess -> BufferAccess -> Bool) -> Eq BufferAccess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BufferAccess -> BufferAccess -> Bool
== :: BufferAccess -> BufferAccess -> Bool
$c/= :: BufferAccess -> BufferAccess -> Bool
/= :: BufferAccess -> BufferAccess -> Bool
Eq, Eq BufferAccess
Eq BufferAccess =>
(BufferAccess -> BufferAccess -> Ordering)
-> (BufferAccess -> BufferAccess -> Bool)
-> (BufferAccess -> BufferAccess -> Bool)
-> (BufferAccess -> BufferAccess -> Bool)
-> (BufferAccess -> BufferAccess -> Bool)
-> (BufferAccess -> BufferAccess -> BufferAccess)
-> (BufferAccess -> BufferAccess -> BufferAccess)
-> Ord BufferAccess
BufferAccess -> BufferAccess -> Bool
BufferAccess -> BufferAccess -> Ordering
BufferAccess -> BufferAccess -> BufferAccess
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
$ccompare :: BufferAccess -> BufferAccess -> Ordering
compare :: BufferAccess -> BufferAccess -> Ordering
$c< :: BufferAccess -> BufferAccess -> Bool
< :: BufferAccess -> BufferAccess -> Bool
$c<= :: BufferAccess -> BufferAccess -> Bool
<= :: BufferAccess -> BufferAccess -> Bool
$c> :: BufferAccess -> BufferAccess -> Bool
> :: BufferAccess -> BufferAccess -> Bool
$c>= :: BufferAccess -> BufferAccess -> Bool
>= :: BufferAccess -> BufferAccess -> Bool
$cmax :: BufferAccess -> BufferAccess -> BufferAccess
max :: BufferAccess -> BufferAccess -> BufferAccess
$cmin :: BufferAccess -> BufferAccess -> BufferAccess
min :: BufferAccess -> BufferAccess -> BufferAccess
Ord, Int -> BufferAccess -> ShowS
[BufferAccess] -> ShowS
BufferAccess -> String
(Int -> BufferAccess -> ShowS)
-> (BufferAccess -> String)
-> ([BufferAccess] -> ShowS)
-> Show BufferAccess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BufferAccess -> ShowS
showsPrec :: Int -> BufferAccess -> ShowS
$cshow :: BufferAccess -> String
show :: BufferAccess -> String
$cshowList :: [BufferAccess] -> ShowS
showList :: [BufferAccess] -> ShowS
Show )

marshalBufferAccess :: BufferAccess -> GLenum
marshalBufferAccess :: BufferAccess -> GLuint
marshalBufferAccess BufferAccess
x = case BufferAccess
x of
   BufferAccess
ReadOnly -> GLuint
GL_READ_ONLY
   BufferAccess
WriteOnly -> GLuint
GL_WRITE_ONLY
   BufferAccess
ReadWrite -> GLuint
GL_READ_WRITE

unmarshalBufferAccess :: GLenum -> BufferAccess
unmarshalBufferAccess :: GLuint -> BufferAccess
unmarshalBufferAccess GLuint
x
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_READ_ONLY = BufferAccess
ReadOnly
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_WRITE_ONLY = BufferAccess
WriteOnly
   | GLuint
x GLuint -> GLuint -> Bool
forall a. Eq a => a -> a -> Bool
== GLuint
GL_READ_WRITE = BufferAccess
ReadWrite
   | Bool
otherwise = String -> BufferAccess
forall a. HasCallStack => String -> a
error (String
"unmarshalBufferAccess: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLuint -> String
forall a. Show a => a -> String
show GLuint
x)

--------------------------------------------------------------------------------

bindBuffer :: BufferTarget -> StateVar (Maybe BufferObject)
bindBuffer :: BufferTarget -> StateVar (Maybe BufferObject)
bindBuffer BufferTarget
t = IO (Maybe BufferObject)
-> (Maybe BufferObject -> IO ()) -> StateVar (Maybe BufferObject)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (BufferTarget -> IO (Maybe BufferObject)
getBindBuffer BufferTarget
t) (BufferTarget -> Maybe BufferObject -> IO ()
setBindBuffer BufferTarget
t)

getBindBuffer :: BufferTarget -> IO (Maybe BufferObject)
getBindBuffer :: BufferTarget -> IO (Maybe BufferObject)
getBindBuffer = (BufferTarget -> PName1I)
-> BufferTarget -> IO (Maybe BufferObject)
forall a. (a -> PName1I) -> a -> IO (Maybe BufferObject)
bufferQuery BufferTarget -> PName1I
bufferTargetToGetPName

bufferQuery :: (a -> PName1I) -> a -> IO (Maybe BufferObject)
bufferQuery :: forall a. (a -> PName1I) -> a -> IO (Maybe BufferObject)
bufferQuery a -> PName1I
func a
t = do
   buf <- (GLint -> BufferObject) -> PName1I -> IO BufferObject
forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
forall a. (GLint -> a) -> PName1I -> IO a
getInteger1 (GLuint -> BufferObject
BufferObject (GLuint -> BufferObject)
-> (GLint -> GLuint) -> GLint -> BufferObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (a -> PName1I
func a
t)
   return $ if buf == noBufferObject then Nothing else Just buf

noBufferObject :: BufferObject
noBufferObject :: BufferObject
noBufferObject = GLuint -> BufferObject
BufferObject GLuint
0

setBindBuffer :: BufferTarget -> Maybe BufferObject -> IO ()
setBindBuffer :: BufferTarget -> Maybe BufferObject -> IO ()
setBindBuffer BufferTarget
t =
   GLuint -> GLuint -> IO ()
forall (m :: * -> *). MonadIO m => GLuint -> GLuint -> m ()
glBindBuffer (BufferTarget -> GLuint
marshalBufferTarget BufferTarget
t) (GLuint -> IO ())
-> (Maybe BufferObject -> GLuint) -> Maybe BufferObject -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferObject -> GLuint
bufferID (BufferObject -> GLuint)
-> (Maybe BufferObject -> BufferObject)
-> Maybe BufferObject
-> GLuint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferObject -> Maybe BufferObject -> BufferObject
forall a. a -> Maybe a -> a
fromMaybe BufferObject
noBufferObject

clientArrayTypeToGetPName :: ClientArrayType -> PName1I
clientArrayTypeToGetPName :: ClientArrayType -> PName1I
clientArrayTypeToGetPName ClientArrayType
x = case ClientArrayType
x of
   ClientArrayType
VertexArray -> PName1I
GetVertexArrayBufferBinding
   ClientArrayType
NormalArray -> PName1I
GetNormalArrayBufferBinding
   ClientArrayType
ColorArray -> PName1I
GetColorArrayBufferBinding
   ClientArrayType
IndexArray -> PName1I
GetIndexArrayBufferBinding
   ClientArrayType
TextureCoordArray -> PName1I
GetTextureCoordArrayBufferBinding
   ClientArrayType
EdgeFlagArray -> PName1I
GetEdgeFlagArrayBufferBinding
   ClientArrayType
FogCoordArray -> PName1I
GetFogCoordArrayBufferBinding
   ClientArrayType
SecondaryColorArray -> PName1I
GetSecondaryColorArrayBufferBinding
   ClientArrayType
MatrixIndexArray -> String -> PName1I
forall a. HasCallStack => String -> a
error String
"clientArrayTypeToGetPName: impossible"

arrayBufferBinding :: ClientArrayType -> GettableStateVar (Maybe BufferObject)
arrayBufferBinding :: ClientArrayType -> IO (Maybe BufferObject)
arrayBufferBinding ClientArrayType
t =
   IO (Maybe BufferObject) -> IO (Maybe BufferObject)
forall a. IO a -> IO a
makeGettableStateVar (IO (Maybe BufferObject) -> IO (Maybe BufferObject))
-> IO (Maybe BufferObject) -> IO (Maybe BufferObject)
forall a b. (a -> b) -> a -> b
$ case ClientArrayType
t of
      ClientArrayType
MatrixIndexArray -> do IO ()
recordInvalidEnum ; Maybe BufferObject -> IO (Maybe BufferObject)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BufferObject
forall a. Maybe a
Nothing
      ClientArrayType
_ -> (ClientArrayType -> PName1I)
-> ClientArrayType -> IO (Maybe BufferObject)
forall a. (a -> PName1I) -> a -> IO (Maybe BufferObject)
bufferQuery ClientArrayType -> PName1I
clientArrayTypeToGetPName ClientArrayType
t


vertexAttribArrayBufferBinding :: AttribLocation -> GettableStateVar (Maybe BufferObject)
vertexAttribArrayBufferBinding :: AttribLocation -> IO (Maybe BufferObject)
vertexAttribArrayBufferBinding AttribLocation
location =
   IO (Maybe BufferObject) -> IO (Maybe BufferObject)
forall a. IO a -> IO a
makeGettableStateVar (IO (Maybe BufferObject) -> IO (Maybe BufferObject))
-> IO (Maybe BufferObject) -> IO (Maybe BufferObject)
forall a b. (a -> b) -> a -> b
$ do
      buf <- (GLint -> BufferObject)
-> AttribLocation -> GetVertexAttribPName -> IO BufferObject
forall b.
(GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b
getVertexAttribInteger1 (GLuint -> BufferObject
BufferObject (GLuint -> BufferObject)
-> (GLint -> GLuint) -> GLint -> BufferObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral) AttribLocation
location GetVertexAttribPName
GetVertexAttribArrayBufferBinding
      return $ if buf == noBufferObject then Nothing else Just buf

--------------------------------------------------------------------------------

bufferData :: BufferTarget -> StateVar (GLsizeiptr, Ptr a, BufferUsage)
bufferData :: forall a.
BufferTarget -> StateVar (RangeStartIndex, Ptr a, BufferUsage)
bufferData BufferTarget
t = IO (RangeStartIndex, Ptr a, BufferUsage)
-> ((RangeStartIndex, Ptr a, BufferUsage) -> IO ())
-> StateVar (RangeStartIndex, Ptr a, BufferUsage)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (BufferTarget -> IO (RangeStartIndex, Ptr a, BufferUsage)
forall a. BufferTarget -> IO (RangeStartIndex, Ptr a, BufferUsage)
getBufferData BufferTarget
t) (BufferTarget -> (RangeStartIndex, Ptr a, BufferUsage) -> IO ()
forall a.
BufferTarget -> (RangeStartIndex, Ptr a, BufferUsage) -> IO ()
setBufferData BufferTarget
t)

getBufferData :: BufferTarget -> IO (GLsizeiptr, Ptr a, BufferUsage)
getBufferData :: forall a. BufferTarget -> IO (RangeStartIndex, Ptr a, BufferUsage)
getBufferData BufferTarget
t = do
   s <- BufferTarget
-> (GLuint -> RangeStartIndex)
-> GetBufferPName
-> GettableStateVar RangeStartIndex
forall a. BufferTarget -> (GLuint -> a) -> GetBufferPName -> IO a
getBufferParameter BufferTarget
t GLuint -> RangeStartIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral GetBufferPName
GetBufferSize
   p <- getBufferPointer t
   u <- getBufferParameter t unmarshalBufferUsage GetBufferUsage
   return (s, p, u)

setBufferData :: BufferTarget -> (GLsizeiptr, Ptr a, BufferUsage) -> IO ()
setBufferData :: forall a.
BufferTarget -> (RangeStartIndex, Ptr a, BufferUsage) -> IO ()
setBufferData BufferTarget
t (RangeStartIndex
s, Ptr a
p, BufferUsage
u) =
   GLuint -> RangeStartIndex -> Ptr a -> GLuint -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
GLuint -> RangeStartIndex -> Ptr a -> GLuint -> m ()
glBufferData (BufferTarget -> GLuint
marshalBufferTarget BufferTarget
t) RangeStartIndex
s Ptr a
p (BufferUsage -> GLuint
marshalBufferUsage BufferUsage
u)

--------------------------------------------------------------------------------

data TransferDirection =
     ReadFromBuffer
   | WriteToBuffer
   deriving ( TransferDirection -> TransferDirection -> Bool
(TransferDirection -> TransferDirection -> Bool)
-> (TransferDirection -> TransferDirection -> Bool)
-> Eq TransferDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransferDirection -> TransferDirection -> Bool
== :: TransferDirection -> TransferDirection -> Bool
$c/= :: TransferDirection -> TransferDirection -> Bool
/= :: TransferDirection -> TransferDirection -> Bool
Eq, Eq TransferDirection
Eq TransferDirection =>
(TransferDirection -> TransferDirection -> Ordering)
-> (TransferDirection -> TransferDirection -> Bool)
-> (TransferDirection -> TransferDirection -> Bool)
-> (TransferDirection -> TransferDirection -> Bool)
-> (TransferDirection -> TransferDirection -> Bool)
-> (TransferDirection -> TransferDirection -> TransferDirection)
-> (TransferDirection -> TransferDirection -> TransferDirection)
-> Ord TransferDirection
TransferDirection -> TransferDirection -> Bool
TransferDirection -> TransferDirection -> Ordering
TransferDirection -> TransferDirection -> TransferDirection
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
$ccompare :: TransferDirection -> TransferDirection -> Ordering
compare :: TransferDirection -> TransferDirection -> Ordering
$c< :: TransferDirection -> TransferDirection -> Bool
< :: TransferDirection -> TransferDirection -> Bool
$c<= :: TransferDirection -> TransferDirection -> Bool
<= :: TransferDirection -> TransferDirection -> Bool
$c> :: TransferDirection -> TransferDirection -> Bool
> :: TransferDirection -> TransferDirection -> Bool
$c>= :: TransferDirection -> TransferDirection -> Bool
>= :: TransferDirection -> TransferDirection -> Bool
$cmax :: TransferDirection -> TransferDirection -> TransferDirection
max :: TransferDirection -> TransferDirection -> TransferDirection
$cmin :: TransferDirection -> TransferDirection -> TransferDirection
min :: TransferDirection -> TransferDirection -> TransferDirection
Ord, Int -> TransferDirection -> ShowS
[TransferDirection] -> ShowS
TransferDirection -> String
(Int -> TransferDirection -> ShowS)
-> (TransferDirection -> String)
-> ([TransferDirection] -> ShowS)
-> Show TransferDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransferDirection -> ShowS
showsPrec :: Int -> TransferDirection -> ShowS
$cshow :: TransferDirection -> String
show :: TransferDirection -> String
$cshowList :: [TransferDirection] -> ShowS
showList :: [TransferDirection] -> ShowS
Show )

bufferSubData ::
   BufferTarget -> TransferDirection -> GLintptr -> GLsizeiptr -> Ptr a -> IO ()
bufferSubData :: forall a.
BufferTarget
-> TransferDirection
-> RangeStartIndex
-> RangeStartIndex
-> Ptr a
-> IO ()
bufferSubData BufferTarget
t TransferDirection
WriteToBuffer = GLuint -> RangeStartIndex -> RangeStartIndex -> Ptr a -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
GLuint -> RangeStartIndex -> RangeStartIndex -> Ptr a -> m ()
glBufferSubData (BufferTarget -> GLuint
marshalBufferTarget BufferTarget
t)
bufferSubData BufferTarget
t TransferDirection
ReadFromBuffer = GLuint -> RangeStartIndex -> RangeStartIndex -> Ptr a -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
GLuint -> RangeStartIndex -> RangeStartIndex -> Ptr a -> m ()
glGetBufferSubData (BufferTarget -> GLuint
marshalBufferTarget BufferTarget
t)

--------------------------------------------------------------------------------

data GetBufferPName =
     GetBufferSize
   | GetBufferUsage
   | GetBufferAccess
   | GetBufferMapped

marshalGetBufferPName :: GetBufferPName -> GLenum
marshalGetBufferPName :: GetBufferPName -> GLuint
marshalGetBufferPName GetBufferPName
x = case GetBufferPName
x of
   GetBufferPName
GetBufferSize -> GLuint
GL_BUFFER_SIZE
   GetBufferPName
GetBufferUsage -> GLuint
GL_BUFFER_USAGE
   GetBufferPName
GetBufferAccess -> GLuint
GL_BUFFER_ACCESS
   GetBufferPName
GetBufferMapped -> GLuint
GL_BUFFER_MAPPED

getBufferParameter :: BufferTarget -> (GLenum -> a) -> GetBufferPName -> IO a
getBufferParameter :: forall a. BufferTarget -> (GLuint -> a) -> GetBufferPName -> IO a
getBufferParameter BufferTarget
t GLuint -> a
f GetBufferPName
p = GLint -> (Ptr GLint -> IO a) -> IO a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLint
0 ((Ptr GLint -> IO a) -> IO a) -> (Ptr GLint -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr GLint
buf -> do
   GLuint -> GLuint -> Ptr GLint -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLuint -> GLuint -> Ptr GLint -> m ()
glGetBufferParameteriv (BufferTarget -> GLuint
marshalBufferTarget BufferTarget
t)
                          (GetBufferPName -> GLuint
marshalGetBufferPName GetBufferPName
p) Ptr GLint
buf
   (GLint -> a) -> Ptr GLint -> IO a
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 (GLuint -> a
f (GLuint -> a) -> (GLint -> GLuint) -> GLint -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLuint
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Ptr GLint
buf

--------------------------------------------------------------------------------

getBufferPointer :: BufferTarget -> IO (Ptr a)
getBufferPointer :: forall a. BufferTarget -> IO (Ptr a)
getBufferPointer BufferTarget
t = Ptr a -> (Ptr (Ptr a) -> IO (Ptr a)) -> IO (Ptr a)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Ptr a
forall a. Ptr a
nullPtr ((Ptr (Ptr a) -> IO (Ptr a)) -> IO (Ptr a))
-> (Ptr (Ptr a) -> IO (Ptr a)) -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr a)
buf -> do
   GLuint -> GLuint -> Ptr (Ptr a) -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
GLuint -> GLuint -> Ptr (Ptr a) -> m ()
glGetBufferPointerv (BufferTarget -> GLuint
marshalBufferTarget BufferTarget
t) GLuint
GL_BUFFER_MAP_POINTER Ptr (Ptr a)
buf
   (Ptr a -> Ptr a) -> Ptr (Ptr a) -> IO (Ptr a)
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 Ptr a -> Ptr a
forall a. a -> a
id Ptr (Ptr a)
buf

--------------------------------------------------------------------------------

data MappingFailure =
     MappingFailed
   | UnmappingFailed
   deriving ( MappingFailure -> MappingFailure -> Bool
(MappingFailure -> MappingFailure -> Bool)
-> (MappingFailure -> MappingFailure -> Bool) -> Eq MappingFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MappingFailure -> MappingFailure -> Bool
== :: MappingFailure -> MappingFailure -> Bool
$c/= :: MappingFailure -> MappingFailure -> Bool
/= :: MappingFailure -> MappingFailure -> Bool
Eq, Eq MappingFailure
Eq MappingFailure =>
(MappingFailure -> MappingFailure -> Ordering)
-> (MappingFailure -> MappingFailure -> Bool)
-> (MappingFailure -> MappingFailure -> Bool)
-> (MappingFailure -> MappingFailure -> Bool)
-> (MappingFailure -> MappingFailure -> Bool)
-> (MappingFailure -> MappingFailure -> MappingFailure)
-> (MappingFailure -> MappingFailure -> MappingFailure)
-> Ord MappingFailure
MappingFailure -> MappingFailure -> Bool
MappingFailure -> MappingFailure -> Ordering
MappingFailure -> MappingFailure -> MappingFailure
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
$ccompare :: MappingFailure -> MappingFailure -> Ordering
compare :: MappingFailure -> MappingFailure -> Ordering
$c< :: MappingFailure -> MappingFailure -> Bool
< :: MappingFailure -> MappingFailure ->
OBool
< :: MappingFailure ailure)
-> OrdngFailure -> MappingFailure -> MappingFailure)
-> Ord MappingFappingFailue -> MappingFailure)
->  Mappie -> MappingFailure)
-> e)
t; :: MappingFailure ailure)
-> OrdngFailure -> MappingFai   0sp
   bufferSubData EqMappingFailure)
-> e)
t; :: MappingFailure ailure)
-> OrdngFa e)
t; :: MappingFailure ailure)
-> OrdngFagFa e)
t; :: MappingFailure ailure)
-> OrdngFagFa e)
t; :: MappingFailure ailure)
-> OrdngFagFa e)
t; :: MappingyBufferBinding AttribLocation
locationAttribLocation
> OrdngFagFa e)
t; :: MappingFailure ailure)
-> OrdngFagFa e); :: MappingFaiappingFaiappiing    BufferTarget
UniformBuffer  pan>  pan>  pan>  pan>  pan>  pan>  pan>  pan>  pan> an> >5pan>an> >5pan>an> >5pan>an> >5pan>an> >5pan>an> >5pan>an> an>an> >5pan>an> >5panpan>>5pan>an> >5panpan>>5pan>an> >n>>5panpan>>5pan>an> liftIO >>>5pan>an> >5 Eq a => a -> a -> Bool
   ClientArrayTyid="line-222">   ClientArrayTyid="line-222">   ClientArrayTyid="line-222">   ClieentArrayTyid="linpan>
ClieentArr-> <6731>-- License     :etifier hs-var">glGetBufferPointerv (-> GLuint
ailure ailu9an ailure ailu9an ailure ailu9an ClientArrayTyid="lineclass="anno>>>>> >> >5pan>an> >5pan>an> (>5pan>an> a
>5pan>an1679305564">f (GLuint -> a) ->not">(GLuinture /spapin×æailure /spapin×æailure /spapin×æailure /spapin×æailuilure /span classure ailæailure ailu9an