GL3.0 support

Graphics/Rendering/OpenGL/GL.hs

@@ -3,7 +3,7 @@
 -- Module      :  Graphics.Rendering.OpenGL.GL
 -- Copyright   :  (c) Sven Panne 2002-2009
 -- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
--- 
+--
 -- Maintainer  :  sven.panne@aedion.de
 -- Stability   :  stable
 -- Portability :  portable
@@ -19,6 +19,7 @@ module Graphics.Rendering.OpenGL.GL (
    module Graphics.Rendering.OpenGL.GL.BeginEnd,
    module Graphics.Rendering.OpenGL.GL.VertexSpec,
    module Graphics.Rendering.OpenGL.GL.VertexArrays,
+   module Graphics.Rendering.OpenGL.GL.VertexArrayObjects,
    module Graphics.Rendering.OpenGL.GL.BufferObjects,
    module Graphics.Rendering.OpenGL.GL.Rectangles,
    module Graphics.Rendering.OpenGL.GL.CoordTrans,
@@ -29,6 +30,7 @@ module Graphics.Rendering.OpenGL.GL (
 
    -- * Rasterization
    module Graphics.Rendering.OpenGL.GL.Antialiasing,
+   module Graphics.Rendering.OpenGL.GL.FramebufferObjects,
    module Graphics.Rendering.OpenGL.GL.Points,
    module Graphics.Rendering.OpenGL.GL.LineSegments,
    module Graphics.Rendering.OpenGL.GL.Polygons,
@@ -50,6 +52,10 @@ module Graphics.Rendering.OpenGL.GL (
    module Graphics.Rendering.OpenGL.GL.DisplayLists,
    module Graphics.Rendering.OpenGL.GL.FlushFinish,
    module Graphics.Rendering.OpenGL.GL.Hints,
+   module Graphics.Rendering.OpenGL.GL.PixellikeObject,
+   module Graphics.Rendering.OpenGL.GL.TransformFeedback,
+-- is exported through PerFragment for backwards compatibility reasons
+--   module Graphics.Rendering.OpenGL.GL.QueryObjects,
 
    -- * State and State Requests
    module Data.StateVar,
@@ -65,6 +71,7 @@ import Graphics.Rendering.OpenGL.Raw.Core31 (
 import Graphics.Rendering.OpenGL.GL.BeginEnd
 import Graphics.Rendering.OpenGL.GL.VertexSpec
 import Graphics.Rendering.OpenGL.GL.VertexArrays
+import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
 import Graphics.Rendering.OpenGL.GL.BufferObjects
 import Graphics.Rendering.OpenGL.GL.Rectangles
 import Graphics.Rendering.OpenGL.GL.CoordTrans
@@ -74,6 +81,7 @@ import Graphics.Rendering.OpenGL.GL.Colors
 import Graphics.Rendering.OpenGL.GL.Shaders
 
 import Graphics.Rendering.OpenGL.GL.Antialiasing
+import Graphics.Rendering.OpenGL.GL.FramebufferObjects
 import Graphics.Rendering.OpenGL.GL.Points
 import Graphics.Rendering.OpenGL.GL.LineSegments
 import Graphics.Rendering.OpenGL.GL.Polygons
@@ -93,6 +101,10 @@ import Graphics.Rendering.OpenGL.GL.Feedback
 import Graphics.Rendering.OpenGL.GL.DisplayLists
 import Graphics.Rendering.OpenGL.GL.FlushFinish
 import Graphics.Rendering.OpenGL.GL.Hints
+import Graphics.Rendering.OpenGL.GL.PixellikeObject
+import Graphics.Rendering.OpenGL.GL.TransformFeedback
+-- is exported through PerFragment for backwards compatibility reasons
+--import Graphics.Rendering.OpenGL.GL.QueryObjects
 
 import Data.StateVar
 import Data.Tensor

Graphics/Rendering/OpenGL/GL/Antialiasing.hs

@@ -3,7 +3,7 @@
 -- Module      :  Graphics.Rendering.OpenGL.GL.Antialiasing
 -- Copyright   :  (c) Sven Panne 2002-2009
 -- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
--- 
+--
 -- Maintainer  :  sven.panne@aedion.de
 -- Stability   :  stable
 -- Portability :  portable
@@ -36,5 +36,5 @@ multisample = makeCapability CapMultisample
 subpixelBits :: GettableStateVar GLsizei
 subpixelBits = antialiasingInfo GetSubpixelBits
 
-antialiasingInfo :: GetPName -> GettableStateVar GLsizei
+antialiasingInfo :: GetPName1I p => p -> GettableStateVar GLsizei
 antialiasingInfo = makeGettableStateVar . getSizei1 id

Graphics/Rendering/OpenGL/GL/BufferMode.hs

@@ -4,7 +4,7 @@
 -- Module      :  Graphics.Rendering.OpenGL.GL.BufferMode
 -- Copyright   :  (c) Sven Panne 2002-2009
 -- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
--- 
+--
 -- Maintainer  :  sven.panne@aedion.de
 -- Stability   :  stable
 -- Portability :  portable
@@ -14,7 +14,8 @@
 --------------------------------------------------------------------------------
 
 module Graphics.Rendering.OpenGL.GL.BufferMode (
-   BufferMode(..), marshalBufferMode, unmarshalBufferMode
+   BufferMode(..), marshalBufferMode, unmarshalBufferMode, unmarshalBufferModeSafe,
+   maxColorAttachments,
 ) where
 
 import Graphics.Rendering.OpenGL.Raw.Core31
@@ -60,6 +61,9 @@ data BufferMode =
      -- front left color buffer is selected.
    | AuxBuffer GLsizei
      -- ^ Only the given auxiliary color buffer no. /i/ is selected.
+   | FBOColorAttachment GLsizei
+     -- ^ Only the given color attachment of the bound framebufferobject is selected for reading
+     -- or writing.
    deriving ( Eq, Ord, Show )
 
 marshalBufferMode :: BufferMode -> Maybe GLenum
@@ -77,21 +81,46 @@ marshalBufferMode x = case x of
    AuxBuffer i
       | fromIntegral i <= maxAuxBuffer -> Just (gl_AUX0 + fromIntegral i)
       | otherwise -> Nothing
+   FBOColorAttachment i
+      | fromIntegral i <= maxColorAttachments -> Just (gl_COLOR_ATTACHMENT0 + fromIntegral i)
+      | otherwise -> Nothing
 
 unmarshalBufferMode :: GLenum -> BufferMode
-unmarshalBufferMode x
-   | x == gl_NONE = NoBuffers
-   | x == gl_FRONT_LEFT = FrontLeftBuffer
-   | x == gl_FRONT_RIGHT = FrontRightBuffer
-   | x == gl_BACK_LEFT = BackLeftBuffer
-   | x == gl_BACK_RIGHT = BackRightBuffer
-   | x == gl_FRONT = FrontBuffers
-   | x == gl_BACK = BackBuffers
-   | x == gl_LEFT = LeftBuffers
-   | x == gl_RIGHT = RightBuffers
-   | x == gl_FRONT_AND_BACK = FrontAndBackBuffers
-   | gl_AUX0 <= x && x <= gl_AUX0 + maxAuxBuffer = AuxBuffer (fromIntegral (x - gl_AUX0))
-   | otherwise = error ("unmarshalBufferMode: illegal value " ++ show x)
+unmarshalBufferMode x = maybe
+   (error ("unmarshalBufferMode: illegal value " ++ show x)) id $ unmarshalBufferModeSafe x
+--unmarshalBufferMode x
+--   | x == gl_NONE = NoBuffers
+--   | x == gl_FRONT_LEFT = FrontLeftBuffer
+--   | x == gl_FRONT_RIGHT = FrontRightBuffer
+--   | x == gl_BACK_LEFT = BackLeftBuffer
+--   | x == gl_BACK_RIGHT = BackRightBuffer
+--   | x == gl_FRONT = FrontBuffers
+--   | x == gl_BACK = BackBuffers
+--   | x == gl_LEFT = LeftBuffers
+--   | x == gl_RIGHT = RightBuffers
+--   | x == gl_FRONT_AND_BACK = FrontAndBackBuffers
+--   | gl_AUX0 <= x && x <= gl_AUX0 + maxAuxBuffer = AuxBuffer (fromIntegral (x - gl_AUX0))
+--   | otherwise = error ("unmarshalBufferMode: illegal value " ++ show x)
+
+unmarshalBufferModeSafe :: GLenum -> Maybe BufferMode
+unmarshalBufferModeSafe x
+   | x == gl_NONE = Just NoBuffers
+   | x == gl_FRONT_LEFT = Just FrontLeftBuffer
+   | x == gl_FRONT_RIGHT = Just FrontRightBuffer
+   | x == gl_BACK_LEFT = Just BackLeftBuffer
+   | x == gl_BACK_RIGHT = Just BackRightBuffer
+   | x == gl_FRONT = Just FrontBuffers
+   | x == gl_BACK = Just BackBuffers
+   | x == gl_LEFT = Just LeftBuffers
+   | x == gl_RIGHT = Just RightBuffers
+   | x == gl_FRONT_AND_BACK = Just FrontAndBackBuffers
+   | gl_AUX0 <= x && x <= gl_AUX0 + maxAuxBuffer = Just . AuxBuffer . fromIntegral $ x - gl_AUX0
+   | gl_COLOR_ATTACHMENT0 <= x && x <= gl_COLOR_ATTACHMENT0 + maxColorAttachments
+      = Just . FBOColorAttachment . fromIntegral $ x - gl_COLOR_ATTACHMENT0
+   | otherwise = Nothing
 
 maxAuxBuffer :: GLenum
 maxAuxBuffer = 246
+
+maxColorAttachments :: GLenum
+maxColorAttachments = 16

Graphics/Rendering/OpenGL/GL/BufferObjects.hs

@@ -30,15 +30,31 @@ module Graphics.Rendering.OpenGL.GL.BufferObjects (
    -- * Mapping Buffer Objects
    BufferAccess(..), MappingFailure(..), withMappedBuffer,
    mapBuffer, unmapBuffer,
-   bufferAccess, bufferMapped
+   bufferAccess, bufferMapped,
+
+   BufferRangeAccessBit(..), Offset, Length,
+   mapBufferRange, flushMappedBufferRange,
+
+   -- * Indexed Buffer manipulation
+   BufferIndex,
+   RangeStartIndex, RangeSize,
+   BufferRange,
+   IndexedBufferTarget(..),
+   bindBufferBase, bindBufferRange,
+   indexedBufferStart, indexedBufferSize
 ) where
 
 import Data.ObjectName
+import Data.List(foldl1')
+import Data.Bits((.|.))
+import Data.Maybe
+
 import Data.StateVar
 import Foreign.Marshal.Alloc
 import Foreign.Marshal.Array
 import Foreign.Ptr
 import Foreign.Storable
+
 import Graphics.Rendering.OpenGL.GL.Exception
 import Graphics.Rendering.OpenGL.GL.GLboolean
 import Graphics.Rendering.OpenGL.GL.PeekPoke
@@ -75,6 +91,7 @@ data BufferTarget =
    | ElementArrayBuffer
    | PixelPackBuffer
    | PixelUnpackBuffer
+   | TransformFeedbackBuffer
    deriving ( Eq, Ord, Show )
 
 marshalBufferTarget :: BufferTarget -> GLenum
@@ -85,15 +102,17 @@ marshalBufferTarget x = case x of
    ElementArrayBuffer -> gl_ELEMENT_ARRAY_BUFFER
    PixelPackBuffer -> gl_PIXEL_PACK_BUFFER
    PixelUnpackBuffer -> gl_PIXEL_UNPACK_BUFFER
+   TransformFeedbackBuffer -> gl_TRANSFORM_FEEDBACK_BUFFER
 
-bufferTargetToGetPName :: BufferTarget -> GetPName
+bufferTargetToGetPName :: BufferTarget -> PName1I
 bufferTargetToGetPName x = case x of
    ArrayBuffer -> GetArrayBufferBinding
    ElementArrayBuffer -> GetElementArrayBufferBinding
    CopyReadBuffer -> GetCopyReadBuffer
    CopyWriteBuffer -> GetCopyWriteBuffer
    PixelPackBuffer -> GetPixelPackBufferBinding
    PixelUnpackBuffer -> GetPixelUnpackBufferBinding
+   TransformFeedbackBuffer -> GetTransformFeedbackBufferBinding
 
 --------------------------------------------------------------------------------
 
@@ -163,7 +182,7 @@ bindBuffer t = makeStateVar (getBindBuffer t) (setBindBuffer t)
 getBindBuffer :: BufferTarget -> IO (Maybe BufferObject)
 getBindBuffer = bufferQuery bufferTargetToGetPName
 
-bufferQuery :: (a -> GetPName) -> a -> IO (Maybe BufferObject)
+bufferQuery :: (a -> PName1I) -> a -> IO (Maybe BufferObject)
 bufferQuery func t = do
    buf <- getInteger1 (BufferObject . fromIntegral) (func t)
    return $ if buf == noBufferObject then Nothing else Just buf
@@ -173,9 +192,9 @@ noBufferObject = BufferObject 0
 
 setBindBuffer :: BufferTarget -> Maybe BufferObject -> IO ()
 setBindBuffer t =
-   glBindBuffer (marshalBufferTarget t) . bufferID . maybe noBufferObject id
+   glBindBuffer (marshalBufferTarget t) . bufferID . fromMaybe noBufferObject
 
-clientArrayTypeToGetPName :: ClientArrayType -> GetPName
+clientArrayTypeToGetPName :: ClientArrayType -> PName1I
 clientArrayTypeToGetPName x = case x of
    VertexArray -> GetVertexArrayBufferBinding
    NormalArray -> GetNormalArrayBufferBinding
@@ -291,3 +310,111 @@ bufferAccess t = makeGettableStateVar $
 bufferMapped :: BufferTarget -> GettableStateVar Bool
 bufferMapped t = makeGettableStateVar $
    getBufferParameter t unmarshalGLboolean GetBufferMapped
+
+--------------------------------------------------------------------------------
+
+data BufferRangeAccessBit =
+     ReadBit
+   | WriteBit
+   | InvalidateRangeBit
+   | InvalidateBufferBit
+   | FlushExplicitBit
+   | UnsychronizedBit
+
+type Offset = GLintptr
+type Length = GLsizeiptr
+
+marshalBufferRangeAccessBit :: BufferRangeAccessBit -> GLenum
+marshalBufferRangeAccessBit x = case x of
+    ReadBit -> gl_MAP_READ_BIT
+    WriteBit -> gl_MAP_WRITE_BIT
+    InvalidateRangeBit -> gl_MAP_INVALIDATE_RANGE_BIT
+    InvalidateBufferBit -> gl_MAP_INVALIDATE_BUFFER_BIT
+    FlushExplicitBit -> gl_MAP_FLUSH_EXPLICIT_BIT
+    UnsychronizedBit -> gl_MAP_FLUSH_EXPLICIT_BIT
+
+marshalToBitfield :: [BufferRangeAccessBit] -> GLenum
+marshalToBitfield b = foldl1' (.|.)  $ map marshalBufferRangeAccessBit b
+
+--------------------------------------------------------------------------------
+
+mapBufferRange_ :: BufferTarget -> Offset -> Length ->
+   [BufferRangeAccessBit] -> IO (Ptr a)
+mapBufferRange_ t o l b = glMapBufferRange (marshalBufferTarget t) o l
+    (fromIntegral $ marshalToBitfield b)
+
+mapBufferRange :: BufferTarget -> Offset -> Length ->
+   [BufferRangeAccessBit] -> IO (Maybe (Ptr a))
+mapBufferRange t o l b = fmap (maybeNullPtr Nothing Just) $ mapBufferRange_ t o l b
+
+flushMappedBufferRange :: BufferTarget -> Offset -> Length -> IO()
+flushMappedBufferRange t = glFlushMappedBufferRange (marshalBufferTarget t)
+
+
+--------------------------------------------------------------------------------
+type BufferIndex = GLuint
+
+type RangeStartIndex = GLintptr
+type RangeSize = GLsizeiptr
+type BufferRange = (BufferObject, RangeStartIndex, RangeSize)
+
+data IndexedBufferTarget =
+     IndexedTransformFeedBackbuffer
+--marshaling
+marshalIndexedBufferTarget :: IndexedBufferTarget -> IPName1I
+marshalIndexedBufferTarget x = case x of
+   IndexedTransformFeedBackbuffer -> GetTransformFeedbackBuffer
+
+marshalIndexedBufferStart :: IndexedBufferTarget -> IPName1I
+marshalIndexedBufferStart x = case x of
+   IndexedTransformFeedBackbuffer -> GetTransformFeedbackBufferStart
+
+marshalIndexedBufferSize :: IndexedBufferTarget -> IPName1I
+marshalIndexedBufferSize x = case x of
+   IndexedTransformFeedBackbuffer -> GetTransformFeedbackBufferSize
+
+getIndexed :: Num a => IPName1I -> BufferIndex -> GettableStateVar a
+getIndexed e i = makeGettableStateVar $ getInteger1i fromIntegral e i
+
+--buffer
+bindBufferBase :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferObject)
+bindBufferBase t i = makeStateVar (getIndexedBufferBinding t i) (setIndexedBufferBase t i)
+
+setIndexedBufferBase :: IndexedBufferTarget -> BufferIndex -> Maybe BufferObject -> IO ()
+setIndexedBufferBase t i buf=
+   case marshalGetPName . marshalIndexedBufferTarget $ t of
+      Nothing -> recordInvalidEnum
+      Just t' ->
+         glBindBufferBase t' i . bufferID . fromMaybe noBufferObject $ buf
+
+getIndexedBufferBinding :: IndexedBufferTarget -> BufferIndex -> IO (Maybe BufferObject)
+getIndexedBufferBinding t i = do
+   buf <- getInteger1i (BufferObject . fromIntegral) (marshalIndexedBufferTarget t) i
+   return $ if buf == noBufferObject then Nothing else Just buf
+
+bindBufferRange :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferRange)
+bindBufferRange t i = makeStateVar (getIndexedBufferRange t i) (setIndexedBufferRange t i)
+
+setIndexedBufferRange :: IndexedBufferTarget -> BufferIndex -> Maybe BufferRange -> IO ()
+setIndexedBufferRange t i (Just (buf, start, range)) =
+   case marshalGetPName . marshalIndexedBufferTarget $ t of
+      Nothing -> recordInvalidEnum
+      Just t' -> glBindBufferRange t' i (bufferID buf) start range
+setIndexedBufferRange t i Nothing = setIndexedBufferBase t i Nothing
+
+getIndexedBufferRange :: IndexedBufferTarget -> BufferIndex -> IO(Maybe BufferRange)
+getIndexedBufferRange t i = do
+  buf <- getInteger1i (BufferObject . fromIntegral) (marshalIndexedBufferTarget t) i
+  if buf == noBufferObject
+     then return Nothing
+     else do
+        start <- get $ indexedBufferStart t i
+        size <- get $ indexedBufferSize t i
+        return $ Just (buf, start, size)
+
+
+indexedBufferStart :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeStartIndex
+indexedBufferStart = getIndexed . marshalIndexedBufferStart
+
+indexedBufferSize :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeSize
+indexedBufferSize = getIndexed . marshalIndexedBufferSize