diff --git a/OpenGL.cabal b/OpenGL.cabal --- a/OpenGL.cabal +++ b/OpenGL.cabal @@ -1,5 +1,5 @@ name: OpenGL -version: 2.12.0.1 +version: 2.13.0.0 synopsis: A binding for the OpenGL graphics system description: A Haskell binding for the OpenGL graphics system (GL, version 4.5) and its diff --git a/src/Graphics/Rendering/OpenGL/GL/BufferMode.hs b/src/Graphics/Rendering/OpenGL/GL/BufferMode.hs --- a/src/Graphics/Rendering/OpenGL/GL/BufferMode.hs +++ b/src/Graphics/Rendering/OpenGL/GL/BufferMode.hs @@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.BufferMode --- Copyright : (c) Sven Panne 2002-2013 +-- Copyright : (c) Sven Panne 2002-2015 -- License : BSD3 -- -- Maintainer : Sven Panne @@ -23,7 +23,10 @@ -------------------------------------------------------------------------------- --- | The set of color buffers which are selected for reading and writing. +-- | The set of color buffers which are selected for reading and writing. Note +-- that 'FBOColorAttachment' can only be used with framebuffer objects, while +-- the rest can only be used with the default framebuffer. Furthermore, OpenGL +-- 3.0 deprecated auxiliary buffers, so avoid 'AuxBuffer' in modern code. data BufferMode = NoBuffers diff --git a/src/Graphics/Rendering/OpenGL/GL/DataType.hs b/src/Graphics/Rendering/OpenGL/GL/DataType.hs --- a/src/Graphics/Rendering/OpenGL/GL/DataType.hs +++ b/src/Graphics/Rendering/OpenGL/GL/DataType.hs @@ -22,7 +22,7 @@ -------------------------------------------------------------------------------- --- basically table 3.2 (pixel data type parameter) plus a few additions +-- basically table 8.7 (pixel data type parameter) plus a few additions data DataType = UnsignedByte | Byte diff --git a/src/Graphics/Rendering/OpenGL/GL/Framebuffer.hs b/src/Graphics/Rendering/OpenGL/GL/Framebuffer.hs --- a/src/Graphics/Rendering/OpenGL/GL/Framebuffer.hs +++ b/src/Graphics/Rendering/OpenGL/GL/Framebuffer.hs @@ -1,45 +1,61 @@ -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.Framebuffer --- Copyright : (c) Sven Panne 2002-2013 +-- Copyright : (c) Sven Panne 2002-2015 -- License : BSD3 -- -- Maintainer : Sven Panne -- Stability : stable -- Portability : portable -- --- This module corresponds to section 4.2 (Whole Framebuffer Operations) of the --- OpenGL 2.1 specs. +-- This module corresponds to section 17.4 (Whole Framebuffer Operations) of the +-- OpenGL 4.5 specs. -- -------------------------------------------------------------------------------- module Graphics.Rendering.OpenGL.GL.Framebuffer ( - -- * Querying the Buffer Configuration - auxBuffers, doubleBuffer, stereoBuffer, - rgbaBits, stencilBits, depthBits, accumBits, rgbaSignedComponents, - -- * Selecting a Buffer for Writing - DrawBufferIndex, BufferMode(..), drawBuffer, drawBuffers, drawBufferi, maxDrawBuffers, + BufferMode(..), + drawBuffer, namedFramebufferDrawBuffer, + drawBuffers, namedFramebufferDrawBuffers, + DrawBufferIndex, drawBufferi, + maxDrawBuffers, -- * Fine Control of Buffer Updates - indexMask, colorMask, colorMaski, stencilMask, stencilMaskSeparate, depthMask, + indexMask, colorMask, colorMaski, depthMask, + stencilMask, stencilMaskSeparate, -- * Clearing the Buffers ClearBuffer(..), clear, - clearColor, clearIndex, clearStencil, clearDepth, clearAccum, + clearColor, clearIndex, clearDepth, clearDepthf, clearStencil, clearAccum, + ClearBufferCommand(..), clearBuffer, clearNamedFramebuffer, + + -- * Invalidating Framebuffer Contents + invalidateSubFramebuffer, invalidateNamedFramebufferSubData, + invalidateFramebuffer, invalidateNamedFramebufferData, + -- * The Accumulation Buffer - AccumOp(..), accum + AccumOp(..), accum, + + -- * Querying the Buffer Configuration + auxBuffers, doubleBuffer, stereoBuffer, + rgbaBits, stencilBits, depthBits, accumBits, rgbaSignedComponents, ) where import Control.Monad -import Data.List import Data.Maybe import Data.StateVar import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr import Graphics.Rendering.OpenGL.GL.BufferMode import Graphics.Rendering.OpenGL.GL.Capability +import Graphics.Rendering.OpenGL.GL.CoordTrans import Graphics.Rendering.OpenGL.GL.Face +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget import Graphics.Rendering.OpenGL.GL.GLboolean import Graphics.Rendering.OpenGL.GL.QueryUtils import Graphics.Rendering.OpenGL.GL.VertexSpec @@ -48,56 +64,6 @@ -------------------------------------------------------------------------------- --- | The implementation and context dependent number of auxiliary buffers. - -auxBuffers :: GettableStateVar GLsizei -auxBuffers = makeGettableStateVar $ getSizei1 id GetAuxBuffers - --- | 'True' if front and back buffers exist. - -doubleBuffer :: GettableStateVar Bool -doubleBuffer = - makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetDoublebuffer - --- | 'True' if left and right buffers exist. - -stereoBuffer :: GettableStateVar Bool -stereoBuffer = - makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetStereo - -rgbaBits :: GettableStateVar (Color4 GLsizei) -rgbaBits = - makeGettableStateVar $ - liftM4 Color4 (getSizei1 id GetRedBits) - (getSizei1 id GetGreenBits) - (getSizei1 id GetBlueBits) - (getSizei1 id GetAlphaBits) - -stencilBits :: GettableStateVar GLsizei -stencilBits = makeGettableStateVar $ getSizei1 id GetStencilBits - -depthBits :: GettableStateVar GLsizei -depthBits = makeGettableStateVar $ getSizei1 id GetDepthBits - -accumBits :: GettableStateVar (Color4 GLsizei) -accumBits = - makeGettableStateVar $ - liftM4 Color4 (getSizei1 id GetAccumRedBits) - (getSizei1 id GetAccumGreenBits) - (getSizei1 id GetAccumBlueBits) - (getSizei1 id GetAccumAlphaBits) - -rgbaSignedComponents :: GettableStateVar (Color4 Bool) -rgbaSignedComponents = - makeGettableStateVar $ - getInteger4 (\r g b a -> Color4 (unmarshalGLboolean r) - (unmarshalGLboolean g) - (unmarshalGLboolean b) - (unmarshalGLboolean a)) - GetRGBASignedComponents - --------------------------------------------------------------------------------- - -- | When colors are written to the framebuffer, they are written into the color -- buffers specified by 'drawBuffer'. -- @@ -114,15 +80,24 @@ -- 'BackBuffers' for double-buffered contexts. drawBuffer :: StateVar BufferMode -drawBuffer = - makeStateVar - (getEnum1 unmarshalBufferMode GetDrawBuffer) - (maybe recordInvalidValue glDrawBuffer . marshalBufferMode) +drawBuffer = makeStateVar getDrawBuffer setDrawBuffer --------------------------------------------------------------------------------- +getDrawBuffer :: IO BufferMode +getDrawBuffer = getDrawBufferi 0 -type DrawBufferIndex = GLuint +setDrawBuffer :: BufferMode -> IO () +setDrawBuffer mode = + withBufferModes [mode] $ \[m] -> + glDrawBuffer m +-- | The direct-state-access version of 'drawBuffer'. + +namedFramebufferDrawBuffer :: FramebufferObject -> SettableStateVar BufferMode +namedFramebufferDrawBuffer fbo = + makeSettableStateVar $ \mode -> + withBufferModes [mode] $ \[m] -> + glNamedFramebufferDrawBuffer (framebufferID fbo) m + -- | 'drawBuffers' defines the draw buffers to which all fragment colors are -- written. The draw buffers being defined correspond in order to the respective -- fragment colors. The draw buffer for fragment colors beyond those specified @@ -150,26 +125,44 @@ getDrawBuffers :: IO [BufferMode] getDrawBuffers = do n <- get maxDrawBuffers - mapM (getEnum1 unmarshalBufferMode . GetDrawBufferN) [ 0 .. n ] + mapM getDrawBufferi [ 0 .. n-1 ] setDrawBuffers :: [BufferMode] -> IO () -setDrawBuffers modes = do - let ms = map marshalBufferMode modes - if all isJust ms - then withArray (map fromJust ms) $ - glDrawBuffers (genericLength ms) - else recordInvalidValue +setDrawBuffers modes = + withBufferModes modes $ \ms -> + withArrayLen ms $ \len -> + glDrawBuffers (fromIntegral len) --- | 'drawBufferi' is a fast query function. For indices in the range 0..maxDrawBuffers it's results --- are the same as selection the index from the list returned by drawBuffers. Though this function --- only uses one gl-function call instead of maxDrawBuffers + 1. -drawBufferi :: DrawBufferIndex -> GettableStateVar BufferMode -drawBufferi ind = makeGettableStateVar - (getEnum1 unmarshalBufferMode . GetDrawBufferN $ fromIntegral ind) +-- | The direct-state-access version of 'drawBuffers'. +namedFramebufferDrawBuffers :: FramebufferObject -> SettableStateVar [BufferMode] +namedFramebufferDrawBuffers fbo = + makeSettableStateVar $ \modes -> + withBufferModes modes $ \ms -> + withArrayLen ms $ \len -> + glNamedFramebufferDrawBuffers (framebufferID fbo) (fromIntegral len) --------------------------------------------------------------------------------- +withBufferModes :: [BufferMode] -> ([GLenum] -> IO ()) -> IO () +withBufferModes modes success + | all isJust ms = success (catMaybes ms) + | otherwise = recordInvalidValue + where ms = map marshalBufferMode modes +-- | The index of the draw buffer. + +type DrawBufferIndex = GLuint + +-- | 'drawBufferi' is a fast query function. For indices in the range +-- 0..'maxDrawBuffers'-1 its results is the same as selecting the corresponding +-- element from the list returned by 'drawBuffers', but this function uses only +-- one GL function call instead of 'maxDrawBuffers' ones. + +drawBufferi :: DrawBufferIndex -> GettableStateVar BufferMode +drawBufferi = makeGettableStateVar . getDrawBufferi . fromIntegral + +getDrawBufferi :: GLsizei -> IO BufferMode +getDrawBufferi = getEnum1 unmarshalBufferMode . GetDrawBufferN + -- | Contains the maximum number of buffers that can activated via 'drawBuffers' -- or which can be simultaneously written into from within a fragment shader -- using the special output variable array @gl_FragData@. This constant @@ -183,7 +176,7 @@ -- | Controls the writing of individual bits in the color index buffers. The -- least significant /n/ bits of its value, where /n/ is the number of bits in a --- color index buffer, specify a mask. Where a 1 appears in the mask, it is +-- color index buffer, specify a mask. Where a 1 appears in the mask, it is -- possible to write to the corresponding bit in the color index buffer (or -- buffers). Where a 0 appears, the corresponding bit is write-protected. -- @@ -195,8 +188,6 @@ indexMask = makeStateVar (getInteger1 fromIntegral GetIndexWritemask) glIndexMask --------------------------------------------------------------------------------- - -- | Controls whether the individual color components in the framebuffer can or -- cannot be written. If the red flag is 'Disabled', for example, no change is -- made to the red component of any pixel in any of the color buffers, @@ -214,25 +205,28 @@ (unmarshalCapability g) (unmarshalCapability b) (unmarshalCapability a)) - GetColorWritemask) + GetColorWritemask) (\(Color4 r g b a) -> glColorMask (marshalCapability r) (marshalCapability g) (marshalCapability b) (marshalCapability a)) --- | 'colorMaski' is a version of 'colorMask' that only applies to the specified drawbuffer + +-- | 'colorMaski' is a version of 'colorMask' that only applies to the specified +-- draw buffer. + colorMaski :: DrawBufferIndex -> StateVar (Color4 Capability) -colorMaski x = makeStateVar +colorMaski idx = + makeStateVar (getBoolean4i (\r g b a -> Color4 (unmarshalCapability r) - (unmarshalCapability g) - (unmarshalCapability b) - (unmarshalCapability a)) - GetColorWritemask x) - (\(Color4 r g b a) -> glColorMaski (x) (marshalCapability r) - (marshalCapability g) - (marshalCapability b) - (marshalCapability a)) - --------------------------------------------------------------------------------- + (unmarshalCapability g) + (unmarshalCapability b) + (unmarshalCapability a)) + GetColorWritemask idx) + (\(Color4 r g b a) -> glColorMaski idx + (marshalCapability r) + (marshalCapability g) + (marshalCapability b) + (marshalCapability a)) -- | Controls whether the depth buffer is enabled for writing. The initial state -- is 'Enabled'. @@ -241,23 +235,27 @@ depthMask = makeStateVar (getBoolean1 unmarshalCapability GetDepthWritemask) (glDepthMask . marshalCapability) --------------------------------------------------------------------------------- - -- | Controls the writing of individual bits in the stencil planes. The least -- significant /n/ bits of its value, where /n/ is the number of bits in the --- stencil buffer, specify a mask. Where a 1 appears in the mask, it is --- possible to write to the corresponding bit in the stencil buffer. Where a 0 --- appears, the corresponding bit is write-protected. --- Initially, all bits are enabled for writing. +-- stencil buffer, specify a mask. Where a 1 appears in the mask, it is possible +-- to write to the corresponding bit in the stencil buffer. Where a 0 appears, +-- the corresponding bit is write-protected. Initially, all bits are enabled for +-- writing. stencilMask :: StateVar GLuint stencilMask = - makeStateVar (getInteger1 fromIntegral GetStencilWritemask) glStencilMask + makeStateVar (get (stencilMaskSeparate Front)) glStencilMask -stencilMaskSeparate :: Face -> SettableStateVar GLuint +-- | A per-face version of 'stencilMask'. + +stencilMaskSeparate :: Face -> StateVar GLuint stencilMaskSeparate face = - makeSettableStateVar $ - glStencilMaskSeparate (marshalFace face) + makeStateVar + (case face of + Front -> getInteger1 fromIntegral GetStencilWritemask + Back -> getInteger1 fromIntegral GetStencilBackWritemask + FrontAndBack -> do recordInvalidEnum; return 0) + (glStencilMaskSeparate (marshalFace face)) -------------------------------------------------------------------------------- @@ -277,8 +275,6 @@ StencilBuffer -> gl_STENCIL_BUFFER_BIT DepthBuffer -> gl_DEPTH_BUFFER_BIT --------------------------------------------------------------------------------- - -- | Set the bitplane area of the window to values previously selected by -- 'clearColor', 'clearIndex', 'clearDepth', 'clearStencil', and 'clearAccum'. -- Multiple color buffers can be cleared simultaneously by selecting more than @@ -299,18 +295,13 @@ clear :: [ClearBuffer] -> IO () clear = glClear . sum . map marshalClearBuffer --------------------------------------------------------------------------------- - -- | Controls the red, green, blue, and alpha values used by 'clear' to clear --- the color buffers. Values written into 'clearColor' are clamped to the range --- [0, 1]. Initially, all values are 0. +-- the color buffers. Initially, all values are 0. -clearColor :: StateVar (Color4 GLclampf) -clearColor = makeStateVar (getClampf4 Color4 GetColorClearValue) +clearColor :: StateVar (Color4 GLfloat) +clearColor = makeStateVar (getFloat4 Color4 GetColorClearValue) (\(Color4 r g b a) -> glClearColor r g b a) --------------------------------------------------------------------------------- - -- | Controls the index /c/ used by 'clear' to clear the color index buffers. -- /c/ is not clamped. Rather, /c/ is converted to a fixed-point value with -- unspecified precision to the right of the binary point. The integer part of @@ -321,16 +312,16 @@ clearIndex = makeStateVar (getFloat1 Index1 GetIndexClearValue) (\(Index1 i) -> glClearIndex i) --------------------------------------------------------------------------------- +-- | Controls the depth value used by 'clear' to clear the depth buffer. The +-- initial value is 1. --- | Controls the depth value used by 'clear' to clear the depth buffer. Values --- written into 'clearDepth' are clamped to the range [0, 1]. The initial value --- is 1. +clearDepth :: StateVar GLdouble +clearDepth = makeStateVar (getDouble1 id GetDepthClearValue) glClearDepth -clearDepth :: StateVar GLclampd -clearDepth = makeStateVar (getClampd1 id GetDepthClearValue) glClearDepth +-- | A variant of 'clearDepth' with a 'GLfloat' argument. --------------------------------------------------------------------------------- +clearDepthf :: StateVar GLfloat +clearDepthf = makeStateVar (getFloat1 id GetDepthClearValue) glClearDepthf -- | Controls the value /s/ used by 'clear' to clear the stencil buffer. /s/ is -- masked with 2^/m/-1, where /m/ is the number of bits in the stencil buffer. @@ -339,8 +330,6 @@ clearStencil :: StateVar GLint clearStencil = makeStateVar (getInteger1 id GetStencilClearValue) glClearStencil --------------------------------------------------------------------------------- - -- | Controls the red, green, blue, and alpha values used by 'clear' to clear -- the accumulation buffer. Values written into 'clearAccum' are clamped to the -- range [-1, 1]. The initial values are all 0. @@ -349,6 +338,145 @@ clearAccum = makeStateVar (getFloat4 Color4 GetAccumClearValue) (\(Color4 r g b a) -> glClearAccum r g b a) + +-- | Describes which buffer(s) to clear and the value to use. + +data ClearBufferCommand + = ClearColorBufferInt DrawBufferIndex (Color4 GLint) + -- ^ Clear the signed integer color buffer(s) at the given index. + | ClearColorBufferFloat DrawBufferIndex (Color4 GLfloat) + -- ^ Clear the fixed- or floating-point color buffer(s) at the given index. + | ClearColorBufferUint DrawBufferIndex (Color4 GLuint) + -- ^ Clear the unsigned color buffer(s) at the given index. + | ClearDepthBuffer GLfloat + -- ^ Clear the depth buffer. + | ClearStencilBuffer GLint + -- ^ Clear the stencil buffer. + | ClearDepthAndStencilBuffers GLfloat GLint + -- ^ Clear the depth buffer and the stencil buffer. + deriving ( Eq, Ord, Show ) + +-- | Clear the given buffer(s). + +clearBuffer :: ClearBufferCommand -> IO () +clearBuffer cmd = case cmd of + ClearColorBufferInt i c -> + with c $ glClearBufferiv gl_COLOR (fromIntegral i) . castPtr + ClearColorBufferFloat i c -> + with c $ glClearBufferfv gl_COLOR (fromIntegral i) . castPtr + ClearColorBufferUint i c -> + with c $ glClearBufferuiv gl_COLOR (fromIntegral i) . castPtr + ClearDepthBuffer d -> + with d $ glClearBufferfv gl_DEPTH 0 + ClearStencilBuffer s -> + with s $ glClearBufferiv gl_STENCIL 0 + ClearDepthAndStencilBuffers d s -> + glClearBufferfi gl_DEPTH_STENCIL 0 d s + +-- | The direct-state-access version of 'clearBuffer'. + +clearNamedFramebuffer :: FramebufferObject -> ClearBufferCommand -> IO () +clearNamedFramebuffer fbo cmd = case cmd of + ClearColorBufferInt i c -> + with c $ glClearNamedFramebufferiv f gl_COLOR (fromIntegral i) . castPtr + ClearColorBufferFloat i c -> + with c $ glClearNamedFramebufferfv f gl_COLOR (fromIntegral i) . castPtr + ClearColorBufferUint i c -> + with c $ glClearNamedFramebufferuiv f gl_COLOR (fromIntegral i) . castPtr + ClearDepthBuffer d -> + with d $ glClearNamedFramebufferfv f gl_DEPTH 0 + ClearStencilBuffer s -> + with s $ glClearNamedFramebufferiv f gl_STENCIL 0 + ClearDepthAndStencilBuffers d s -> + glClearNamedFramebufferfi f gl_DEPTH_STENCIL d s + where f = framebufferID fbo + +-------------------------------------------------------------------------------- + +-- | Invalidate a region of the attachments bound to the given target. + +invalidateSubFramebuffer :: FramebufferTarget -> [FramebufferObjectAttachment] -> (Position, Size) -> IO () +invalidateSubFramebuffer target attachments (Position x y, Size w h) = + withAttachments attachments $ \numAttachments atts -> + glInvalidateSubFramebuffer (marshalFramebufferTarget target) numAttachments atts x y w h + +-- | The direct-state-access version of 'invalidateSubFramebuffer'. + +invalidateNamedFramebufferSubData :: FramebufferObject -> [FramebufferObjectAttachment] -> (Position, Size) -> IO () +invalidateNamedFramebufferSubData fbo attachments (Position x y, Size w h) = + withAttachments attachments $ \numAttachments atts -> + glInvalidateNamedFramebufferSubData (framebufferID fbo) numAttachments atts x y w h + +-- | A version of 'invalidateSubFramebuffer' affecting the whole viewport. + +invalidateFramebuffer :: FramebufferTarget -> [FramebufferObjectAttachment] -> IO () +invalidateFramebuffer target attachments = + withAttachments attachments $ + glInvalidateFramebuffer (marshalFramebufferTarget target) + +-- | The direct-state-access version of 'invalidateFramebuffer'. + +invalidateNamedFramebufferData :: FramebufferObject -> [FramebufferObjectAttachment] -> IO () +invalidateNamedFramebufferData fbo attachments = + withAttachments attachments $ + glInvalidateNamedFramebufferData (framebufferID fbo) + +withAttachments :: [FramebufferObjectAttachment] -> (GLsizei -> Ptr GLenum -> IO ()) -> IO () +withAttachments attachments success + | all isJust atts = withArrayLen (catMaybes atts) $ \len buf -> + success (fromIntegral len) buf + | otherwise = recordInvalidEnum + where atts = map marshalFramebufferObjectAttachment attachments + +-------------------------------------------------------------------------------- + +-- | The implementation and context dependent number of auxiliary buffers. + +auxBuffers :: GettableStateVar GLsizei +auxBuffers = makeGettableStateVar $ getSizei1 id GetAuxBuffers + +-- | 'True' if front and back buffers exist. + +doubleBuffer :: GettableStateVar Bool +doubleBuffer = + makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetDoublebuffer + +-- | 'True' if left and right buffers exist. + +stereoBuffer :: GettableStateVar Bool +stereoBuffer = + makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetStereo + +rgbaBits :: GettableStateVar (Color4 GLsizei) +rgbaBits = + makeGettableStateVar $ + liftM4 Color4 (getSizei1 id GetRedBits) + (getSizei1 id GetGreenBits) + (getSizei1 id GetBlueBits) + (getSizei1 id GetAlphaBits) + +stencilBits :: GettableStateVar GLsizei +stencilBits = makeGettableStateVar $ getSizei1 id GetStencilBits + +depthBits :: GettableStateVar GLsizei +depthBits = makeGettableStateVar $ getSizei1 id GetDepthBits + +accumBits :: GettableStateVar (Color4 GLsizei) +accumBits = + makeGettableStateVar $ + liftM4 Color4 (getSizei1 id GetAccumRedBits) + (getSizei1 id GetAccumGreenBits) + (getSizei1 id GetAccumBlueBits) + (getSizei1 id GetAccumAlphaBits) + +rgbaSignedComponents :: GettableStateVar (Color4 Bool) +rgbaSignedComponents = + makeGettableStateVar $ + getInteger4 (\r g b a -> Color4 (unmarshalGLboolean r) + (unmarshalGLboolean g) + (unmarshalGLboolean b) + (unmarshalGLboolean a)) + GetRGBASignedComponents -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs b/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs --- a/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs +++ b/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs @@ -2,14 +2,14 @@ -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject --- Copyright : (c) Sven Panne 2013 +-- Copyright : (c) Sven Panne 2013-2015 -- License : BSD3 -- -- Maintainer : Sven Panne -- Stability : stable -- Portability : portable -- --- This is a purely internal module for handling FrameBufferObjects. +-- This is a purely internal module for handling FramebufferObjects. -- -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs b/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs --- a/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs +++ b/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs @@ -2,14 +2,14 @@ -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment --- Copyright : (c) Sven Panne 2013 +-- Copyright : (c) Sven Panne 2013-2015 -- License : BSD3 -- -- Maintainer : Sven Panne -- Stability : stable -- Portability : portable -- --- This is a purely internal module for marshaling FrameBufferObjectAttachments. +-- This is a purely internal module for marshaling FramebufferObjectAttachments. -- -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs b/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs --- a/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs +++ b/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs @@ -2,14 +2,14 @@ -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget --- Copyright : (c) Sven Panne 2013 +-- Copyright : (c) Sven Panne 2013-2015 -- License : BSD3 -- -- Maintainer : Sven Panne -- Stability : stable -- Portability : portable -- --- This is a purely internal module for marshaling FrameBufferTargets. +-- This is a purely internal module for marshaling FramebufferTargets. -- -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs b/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs --- a/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs +++ b/src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects diff --git a/src/Graphics/Rendering/OpenGL/GL/IOState.hs b/src/Graphics/Rendering/OpenGL/GL/IOState.hs --- a/src/Graphics/Rendering/OpenGL/GL/IOState.hs +++ b/src/Graphics/Rendering/OpenGL/GL/IOState.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -------------------------------------------------------------------------------- -- | @@ -18,7 +19,9 @@ IOState(..), getIOState, peekIOState, evalIOState, nTimes ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ( Applicative(..) ) +#endif import Control.Monad ( ap, liftM, replicateM ) import Foreign.Ptr ( Ptr, plusPtr ) import Foreign.Storable ( Storable(sizeOf,peek) ) diff --git a/src/Graphics/Rendering/OpenGL/GL/PerFragment.hs b/src/Graphics/Rendering/OpenGL/GL/PerFragment.hs --- a/src/Graphics/Rendering/OpenGL/GL/PerFragment.hs +++ b/src/Graphics/Rendering/OpenGL/GL/PerFragment.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.PerFragment --- Copyright : (c) Sven Panne 2002-2013 +-- Copyright : (c) Sven Panne 2002-2015 -- License : BSD3 -- -- Maintainer : Sven Panne @@ -59,6 +59,7 @@ import Graphics.Rendering.OpenGL.GL.GLboolean import Graphics.Rendering.OpenGL.GL.QueryUtils import Graphics.Rendering.OpenGL.GL.VertexSpec +import Graphics.Rendering.OpenGL.GLU.ErrorsInternal import Graphics.Rendering.OpenGL.Raw -------------------------------------------------------------------------------- @@ -126,16 +127,28 @@ stencilFunc :: StateVar (ComparisonFunction, GLint, GLuint) stencilFunc = makeStateVar - (liftM3 (,,) (getEnum1 unmarshalComparisonFunction GetStencilFunc) - (getInteger1 id GetStencilRef) - (getInteger1 fromIntegral GetStencilValueMask)) + (get (stencilFuncSeparate Front)) (\(func, ref, mask) -> glStencilFunc (marshalComparisonFunction func) ref mask) -stencilFuncSeparate :: Face -> SettableStateVar (ComparisonFunction, GLint, GLuint) +stencilFuncSeparate :: Face -> StateVar (ComparisonFunction, GLint, GLuint) stencilFuncSeparate face = - makeSettableStateVar $ \(func, ref, mask) -> - glStencilFuncSeparate (marshalFace face) (marshalComparisonFunction func) ref mask + makeStateVar + (case face of + Front -> getStencilFunc GetStencilFunc + GetStencilRef + GetStencilValueMask + Back -> getStencilFunc GetStencilBackFunc + GetStencilBackRef + GetStencilBackValueMask + FrontAndBack -> do recordInvalidEnum; return (Never, 0, 0)) + (\(func, ref, mask) -> + glStencilFuncSeparate (marshalFace face) + (marshalComparisonFunction func) ref mask) + where getStencilFunc func ref mask = + liftM3 (,,) (getEnum1 unmarshalComparisonFunction func) + (getInteger1 id ref) + (getInteger1 fromIntegral mask) -------------------------------------------------------------------------------- @@ -178,20 +191,32 @@ stencilOp :: StateVar (StencilOp, StencilOp, StencilOp) stencilOp = makeStateVar - (liftM3 (,,) (getEnum1 unmarshalStencilOp GetStencilFail) - (getEnum1 unmarshalStencilOp GetStencilPassDepthFail) - (getEnum1 unmarshalStencilOp GetStencilPassDepthPass)) + (get (stencilOpSeparate Front)) (\(sf, spdf, spdp) -> glStencilOp (marshalStencilOp sf) (marshalStencilOp spdf) (marshalStencilOp spdp)) -stencilOpSeparate :: Face -> SettableStateVar (StencilOp, StencilOp, StencilOp) +stencilOpSeparate :: Face -> StateVar (StencilOp, StencilOp, StencilOp) stencilOpSeparate face = - makeSettableStateVar $ \(sf, spdf, spdp) -> - glStencilOpSeparate (marshalFace face) - (marshalStencilOp sf) - (marshalStencilOp spdf) - (marshalStencilOp spdp) + makeStateVar + (case face of + Front -> getStencilOp GetStencilFail + GetStencilPassDepthFail + GetStencilPassDepthPass + Back -> getStencilOp GetStencilBackFail + GetStencilBackPassDepthFail + GetStencilBackPassDepthPass + FrontAndBack -> do recordInvalidEnum + return (OpZero, OpZero, OpZero)) + (\(sf, spdf, spdp) -> glStencilOpSeparate (marshalFace face) + (marshalStencilOp sf) + (marshalStencilOp spdf) + (marshalStencilOp spdp)) + where getStencilOp sf spdf spdp = + (liftM3 (,,) (getEnum1 unmarshalStencilOp sf) + (getEnum1 unmarshalStencilOp spdf) + (getEnum1 unmarshalStencilOp spdp)) + -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs b/src/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs --- a/src/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs +++ b/src/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs @@ -17,10 +17,13 @@ -- * Primitive Modes PrimitiveMode(..), -- * Patches (Tessellation) - patchVertices, maxPatchVertices + patchVertices, maxPatchVertices, + patchDefaultOuterLevel, patchDefaultInnerLevel, maxTessGenLevel ) where import Data.StateVar +import Foreign.Marshal.Array +import Graphics.Rendering.OpenGL.GL.PeekPoke import Graphics.Rendering.OpenGL.GL.QueryUtils.PName import Graphics.Rendering.OpenGL.Raw @@ -84,10 +87,37 @@ patchVertices :: StateVar GLsizei patchVertices = - makeStateVar (getSizei1 id GetMaxPatchVertices) + makeStateVar (getSizei1 id GetPatchVertices) (glPatchParameteri gl_PATCH_VERTICES . fromIntegral) -- | Contains the maximumum number of vertices in a single patch. maxPatchVertices :: GettableStateVar GLsizei maxPatchVertices = makeGettableStateVar $ getSizei1 id GetMaxPatchVertices + +-- | Contains the four default outer tessellation levels to be used when no +-- tessellation control shader is present. + +patchDefaultOuterLevel :: StateVar (GLfloat, GLfloat, GLfloat, GLfloat) +patchDefaultOuterLevel = + makeStateVar + (getFloat4 (,,,) GetPatchDefaultOuterLevel) + (\(l0, l1, l2, l3) -> allocaArray 4 $ \ptr -> do + poke4 ptr l0 l1 l2 l3 + glPatchParameterfv gl_PATCH_DEFAULT_OUTER_LEVEL ptr) + +-- | Contains the two default inner tessellation levels to be used when no +-- tessellation control shader is present. + +patchDefaultInnerLevel :: StateVar (GLfloat, GLfloat) +patchDefaultInnerLevel = + makeStateVar + (getFloat2 (,) GetPatchDefaultInnerLevel) + (\(l0, l1) -> allocaArray 2 $ \ptr -> do + poke2 ptr l0 l1 + glPatchParameterfv gl_PATCH_DEFAULT_INNER_LEVEL ptr) + +-- | Contains the maximum allowed tessellation level. + +maxTessGenLevel :: GettableStateVar GLsizei +maxTessGenLevel = makeGettableStateVar $ getSizei1 id GetMaxTessGenLevel diff --git a/src/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs b/src/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs --- a/src/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs +++ b/src/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs @@ -479,6 +479,7 @@ | GetIndexWritemask -- ^ int | GetDepthWritemask -- ^ bool | GetStencilWritemask -- ^ bool + | GetStencilBackWritemask -- ^ bool | GetStencilClearValue -- ^ int -- Program | GetCurrentProgram -- ^ int @@ -495,11 +496,17 @@ | GetSampleCoverageInvert -- ^ bool | GetAlphaTestFunc -- ^ enum | GetStencilFunc -- ^ enum + | GetStencilBackFunc -- ^ enum | GetStencilValueMask -- ^ int + | GetStencilBackValueMask -- ^ int | GetStencilRef -- ^ int + | GetStencilBackRef -- ^ int | GetStencilFail -- ^ enum + | GetStencilBackFail -- ^ enum | GetStencilPassDepthFail -- ^ enum + | GetStencilBackPassDepthFail -- ^ enum | GetStencilPassDepthPass -- ^ enum + | GetStencilBackPassDepthPass -- ^ enum | GetActiveStencilFace -- ^ enum | GetLogicOpMode -- ^ enum | GetBlendDst -- ^ enum @@ -749,6 +756,7 @@ GetIndexWritemask -> Just gl_INDEX_WRITEMASK GetDepthWritemask -> Just gl_DEPTH_WRITEMASK GetStencilWritemask -> Just gl_STENCIL_WRITEMASK + GetStencilBackWritemask -> Just gl_STENCIL_BACK_WRITEMASK GetStencilClearValue -> Just gl_STENCIL_CLEAR_VALUE -- Program GetCurrentProgram -> Just gl_CURRENT_PROGRAM @@ -766,11 +774,17 @@ GetSampleCoverageInvert -> Just gl_SAMPLE_COVERAGE_INVERT GetAlphaTestFunc -> Just gl_ALPHA_TEST_FUNC GetStencilFunc -> Just gl_STENCIL_FUNC + GetStencilBackFunc -> Just gl_STENCIL_BACK_FUNC GetStencilValueMask -> Just gl_STENCIL_VALUE_MASK + GetStencilBackValueMask -> Just gl_STENCIL_BACK_VALUE_MASK GetStencilRef -> Just gl_STENCIL_REF + GetStencilBackRef -> Just gl_STENCIL_BACK_REF GetStencilFail -> Just gl_STENCIL_FAIL + GetStencilBackFail -> Just gl_STENCIL_BACK_FAIL GetStencilPassDepthFail -> Just gl_STENCIL_PASS_DEPTH_FAIL + GetStencilBackPassDepthFail -> Just gl_STENCIL_BACK_PASS_DEPTH_FAIL GetStencilPassDepthPass -> Just gl_STENCIL_PASS_DEPTH_PASS + GetStencilBackPassDepthPass -> Just gl_STENCIL_BACK_PASS_DEPTH_PASS GetActiveStencilFace -> Just gl_ACTIVE_STENCIL_FACE_EXT GetLogicOpMode -> Just gl_LOGIC_OP_MODE GetBlendDst -> Just gl_BLEND_DST @@ -1046,6 +1060,8 @@ | GetSmoothLineWidthRange -- ^ float -- PerFragment | GetDepthBounds -- ^ clampd + -- Tessellation + | GetPatchDefaultInnerLevel -- ^ float instance GetPName2F PName2F where @@ -1063,6 +1079,8 @@ GetSmoothLineWidthRange -> Just gl_SMOOTH_LINE_WIDTH_RANGE -- PerFragment GetDepthBounds -> Just gl_DEPTH_BOUNDS_EXT + -- Tessellation + GetPatchDefaultInnerLevel -> Just gl_PATCH_DEFAULT_INNER_LEVEL ----------------------------------------------------------------------------- @@ -1134,7 +1152,10 @@ | GetCurrentRasterSecondaryColor -- ^ float | GetCurrentRasterTextureCoords -- ^ float | GetCurrentRasterPosition -- ^ float + -- PerFragment | GetBlendColor -- ^ clampf + -- Tessellation + | GetPatchDefaultOuterLevel -- ^ float instance GetPName4F PName4F where @@ -1152,15 +1173,15 @@ -- Framebuffer GetColorClearValue -> Just gl_COLOR_CLEAR_VALUE GetAccumClearValue -> Just gl_ACCUM_CLEAR_VALUE - -- Rasterpos + -- RasterPos GetCurrentRasterColor -> Just gl_CURRENT_RASTER_COLOR GetCurrentRasterSecondaryColor -> Just gl_CURRENT_RASTER_SECONDARY_COLOR GetCurrentRasterTextureCoords -> Just gl_CURRENT_RASTER_TEXTURE_COORDS GetCurrentRasterPosition -> Just gl_CURRENT_RASTER_POSITION -- PerFragment GetBlendColor -> Just gl_BLEND_COLOR - - + -- Tessellation + GetPatchDefaultOuterLevel -> Just gl_PATCH_DEFAULT_OUTER_LEVEL -- 0x3000 through 0x3FFF are reserved for clip planes clipPlaneIndexToEnum :: GLsizei -> Maybe GLenum diff --git a/src/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs b/src/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs --- a/src/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs +++ b/src/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs @@ -15,8 +15,7 @@ module Graphics.Rendering.OpenGL.GL.Shaders.Limits ( maxVertexTextureImageUnits, maxTextureImageUnits, maxCombinedTextureImageUnits, maxTextureCoords, maxVertexUniformComponents, - maxFragmentUniformComponents, maxVertexAttribs, maxVaryingFloats, - maxTessGenLevel + maxFragmentUniformComponents, maxVertexAttribs, maxVaryingFloats ) where import Data.StateVar @@ -76,11 +75,6 @@ maxVaryingFloats :: GettableStateVar GLsizei maxVaryingFloats = getLimit GetMaxVaryingFloats - --- | Contains the maximum allowed tessellation level. - -maxTessGenLevel :: GettableStateVar GLsizei -maxTessGenLevel = getLimit GetMaxTessGenLevel getLimit :: PName1I -> GettableStateVar GLsizei getLimit = makeGettableStateVar . getSizei1 id diff --git a/src/Graphics/Rendering/OpenGL/GL/Tensor.hs b/src/Graphics/Rendering/OpenGL/GL/Tensor.hs --- a/src/Graphics/Rendering/OpenGL/GL/Tensor.hs +++ b/src/Graphics/Rendering/OpenGL/GL/Tensor.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, CPP #-} -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.Tensor @@ -19,9 +19,12 @@ Vector1(..), Vector2(..), Vector3(..), Vector4(..) ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ( Applicative(..) ) +import Data.Foldable ( Foldable(..) ) +#endif import Control.Monad ( ap ) -import Data.Foldable ( Foldable(..), foldlM ) +import Data.Foldable ( foldlM ) import Data.Ix ( Ix ) import Data.Traversable ( Traversable(..), mapAccumL ) import Data.Typeable ( Typeable ) diff --git a/src/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs b/src/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs --- a/src/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs +++ b/src/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs @@ -52,18 +52,21 @@ data TransformFeedbackBufferMode = InterleavedAttribs + | SeparateAttribs | SeperateAttribs deriving ( Eq, Ord, Show ) +{-# DEPRECATED SeperateAttribs "Use 'SeparateAttribs' instead." #-} marshalTransformFeedbackBufferMode :: TransformFeedbackBufferMode -> GLenum marshalTransformFeedbackBufferMode x = case x of InterleavedAttribs -> gl_INTERLEAVED_ATTRIBS + SeparateAttribs -> gl_SEPARATE_ATTRIBS SeperateAttribs -> gl_SEPARATE_ATTRIBS unmarshalTransformFeedbackBufferMode :: GLenum -> TransformFeedbackBufferMode unmarshalTransformFeedbackBufferMode x | x == gl_INTERLEAVED_ATTRIBS = InterleavedAttribs - | x == gl_SEPARATE_ATTRIBS = SeperateAttribs + | x == gl_SEPARATE_ATTRIBS = SeparateAttribs | otherwise = error $ "unmarshalTransformFeedbackBufferMode: illegal value " ++ show x -- limits diff --git a/src/Graphics/Rendering/OpenGL/GL/VertexArrays.hs b/src/Graphics/Rendering/OpenGL/GL/VertexArrays.hs --- a/src/Graphics/Rendering/OpenGL/GL/VertexArrays.hs +++ b/src/Graphics/Rendering/OpenGL/GL/VertexArrays.hs @@ -26,9 +26,21 @@ clientState, clientActiveTexture, -- * Dereferencing and Rendering - ArrayIndex, NumArrayIndices, NumIndexBlocks, - arrayElement, drawArrays, multiDrawArrays, drawElements, multiDrawElements, - drawRangeElements, maxElementsVertices, maxElementsIndices, lockArrays, + ArrayIndex, NumArrayIndices, NumIndexBlocks, NumInstances, + BaseInstance, BaseVertex, + arrayElement, + + drawArrays, drawArraysInstancedBaseInstance, drawArraysInstanced, + multiDrawArrays, + + drawElements, drawElementsInstancedBaseInstance, drawElementsInstanced, + multiDrawElements, drawRangeElements, + + drawElementsBaseVertex, drawRangeElementsBaseVertex, + drawElementsInstancedBaseVertex, drawElementsInstancedBaseVertexBaseInstance, + multiDrawElementsBaseVertex, + + maxElementsVertices, maxElementsIndices, lockArrays, primitiveRestartIndex, primitiveRestartIndexNV, -- * Generic Vertex Attribute Arrays @@ -322,6 +334,16 @@ type NumIndexBlocks = GLsizei +type NumInstances = GLsizei + +type BaseInstance = GLuint + +type BaseVertex = GLint + +-- TODO: The ranges (ArrayIndex, ArrayIndex) below should actually use GLuint: +-- type RangeStart = GLuint +-- type RangeEnd = GLuint + -------------------------------------------------------------------------------- arrayElement :: ArrayIndex -> IO () @@ -330,26 +352,44 @@ drawArrays :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> IO () drawArrays = glDrawArrays . marshalPrimitiveMode -multiDrawArrays :: - PrimitiveMode -> Ptr ArrayIndex -> Ptr NumArrayIndices -> NumIndexBlocks - -> IO () +drawArraysInstancedBaseInstance :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> NumInstances -> BaseInstance -> IO () +drawArraysInstancedBaseInstance = glDrawArraysInstancedBaseInstance . marshalPrimitiveMode + +drawArraysInstanced :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> NumInstances -> IO () +drawArraysInstanced = glDrawArraysInstanced . marshalPrimitiveMode + +multiDrawArrays :: PrimitiveMode -> Ptr ArrayIndex -> Ptr NumArrayIndices -> NumIndexBlocks -> IO () multiDrawArrays = glMultiDrawArrays . marshalPrimitiveMode drawElements :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> IO () drawElements m c = glDrawElements (marshalPrimitiveMode m) c . marshalDataType -multiDrawElements :: - PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a) - -> NumIndexBlocks -> IO () -multiDrawElements m c = - glMultiDrawElements (marshalPrimitiveMode m) c . marshalDataType +drawElementsInstancedBaseInstance :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> NumInstances -> BaseInstance -> IO () +drawElementsInstancedBaseInstance m c = glDrawElementsInstancedBaseInstance (marshalPrimitiveMode m) c . marshalDataType -drawRangeElements :: - PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType - -> Ptr a -> IO () -drawRangeElements m (s, e) c = - glDrawRangeElements (marshalPrimitiveMode m) (fromIntegral s) - (fromIntegral e) c . marshalDataType +drawElementsInstanced :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> NumInstances -> IO () +drawElementsInstanced m c = glDrawElementsInstanced (marshalPrimitiveMode m) c . marshalDataType + +multiDrawElements :: PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a) -> NumIndexBlocks -> IO () +multiDrawElements m c = glMultiDrawElements (marshalPrimitiveMode m) c . marshalDataType + +drawRangeElements :: PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType -> Ptr a -> IO () +drawRangeElements m (s, e) c = glDrawRangeElements (marshalPrimitiveMode m) (fromIntegral s) (fromIntegral e) c . marshalDataType + +drawElementsBaseVertex :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> BaseVertex -> IO () +drawElementsBaseVertex m c = glDrawElementsBaseVertex (marshalPrimitiveMode m) c . marshalDataType + +drawRangeElementsBaseVertex :: PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType -> Ptr a -> BaseVertex -> IO () +drawRangeElementsBaseVertex m (s, e) c = glDrawRangeElementsBaseVertex (marshalPrimitiveMode m) (fromIntegral s) (fromIntegral e) c . marshalDataType + +drawElementsInstancedBaseVertex :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> NumInstances -> BaseVertex -> IO () +drawElementsInstancedBaseVertex m c = glDrawElementsInstancedBaseVertex (marshalPrimitiveMode m) c . marshalDataType + +drawElementsInstancedBaseVertexBaseInstance :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> NumInstances -> BaseVertex -> BaseInstance -> IO () +drawElementsInstancedBaseVertexBaseInstance m c = glDrawElementsInstancedBaseVertexBaseInstance (marshalPrimitiveMode m) c . marshalDataType + +multiDrawElementsBaseVertex :: PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a) -> NumIndexBlocks -> Ptr BaseVertex -> IO () +multiDrawElementsBaseVertex m c = glMultiDrawElementsBaseVertex (marshalPrimitiveMode m) c . marshalDataType maxElementsVertices :: GettableStateVar NumArrayIndices maxElementsVertices = makeGettableStateVar (getSizei1 id GetMaxElementsVertices) diff --git a/src/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs b/src/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs --- a/src/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs +++ b/src/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, CPP #-} {-# OPTIONS_HADDOCK hide #-} -------------------------------------------------------------------------------- -- | @@ -22,7 +22,9 @@ Index1(..) ) where -import Control.Applicative +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ( Applicative(..) ) +#endif import Control.Monad import Data.Foldable import Data.Ix diff --git a/src/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs b/src/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs --- a/src/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs +++ b/src/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-cse #-} - {-# OPTIONS_HADDOCK hide #-} -------------------------------------------------------------------------------- -- | @@ -22,8 +22,6 @@ ) where import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) -import Foreign.C.String ( peekCString ) -import Foreign.Ptr ( castPtr ) import Graphics.Rendering.GLU.Raw import Graphics.Rendering.OpenGL.Raw import System.IO.Unsafe ( unsafePerformIO ) @@ -36,12 +34,11 @@ data Error = Error ErrorCategory String deriving ( Eq, Ord, Show ) --------------------------------------------------------------------------------- - -- | General GL\/GLU error categories data ErrorCategory - = InvalidEnum + = ContextLost + | InvalidEnum | InvalidValue | InvalidOperation | InvalidFramebufferOperation @@ -53,61 +50,130 @@ | NURBSError deriving ( Eq, Ord, Show ) -unmarshalErrorCategory :: GLenum -> ErrorCategory -unmarshalErrorCategory c - | isInvalidEnum c = InvalidEnum - | isInvalidValue c = InvalidValue - | isInvalidOperation c = InvalidOperation - | isInvalidFramebufferOperation c = InvalidFramebufferOperation - | isOutOfMemory c = OutOfMemory - | isStackOverflow c = StackOverflow - | isStackUnderflow c = StackUnderflow - | isTableTooLarge c = TableTooLarge - | isTesselatorError c = TesselatorError - | isNURBSError c = NURBSError - | otherwise = error "unmarshalErrorCategory" - -isInvalidEnum :: GLenum -> Bool -isInvalidEnum c = c == gl_INVALID_ENUM || c == glu_INVALID_ENUM - -isInvalidValue :: GLenum -> Bool -isInvalidValue c = c == gl_INVALID_VALUE || c == glu_INVALID_VALUE - -isInvalidOperation :: GLenum -> Bool -isInvalidOperation c = c == gl_INVALID_OPERATION || c == glu_INVALID_OPERATION - -isInvalidFramebufferOperation :: GLenum -> Bool -isInvalidFramebufferOperation c = c == gl_INVALID_FRAMEBUFFER_OPERATION - -isOutOfMemory :: GLenum -> Bool -isOutOfMemory c = c == gl_OUT_OF_MEMORY || c == glu_OUT_OF_MEMORY - -isStackOverflow :: GLenum -> Bool -isStackOverflow c = c == gl_STACK_OVERFLOW - -isStackUnderflow :: GLenum -> Bool -isStackUnderflow c = c == gl_STACK_UNDERFLOW - -isTableTooLarge :: GLenum -> Bool -isTableTooLarge c = c == gl_TABLE_TOO_LARGE - -isTesselatorError :: GLenum -> Bool -isTesselatorError c = glu_TESS_ERROR1 <= c && c <= glu_TESS_ERROR8 - -isNURBSError :: GLenum -> Bool -isNURBSError c = glu_NURBS_ERROR1 <= c && c <= glu_NURBS_ERROR37 - --------------------------------------------------------------------------------- - --- The returned error string is statically allocated, so peekCString --- does the right thing here. No malloc/free necessary here. - -makeError :: GLenum -> IO Error -makeError e = do - let category = unmarshalErrorCategory e - ptr <- gluErrorString e - description <- peekCString (castPtr ptr) - return $ Error category description +makeError :: GLenum -> Error +makeError c + -- GL errors + | c == gl_CONTEXT_LOST = + Error ContextLost "context lost" + | c == gl_INVALID_ENUM = + Error InvalidEnum "invalid enumerant" + | c == gl_INVALID_VALUE = + Error InvalidValue "invalid value" + | c == gl_INVALID_OPERATION = + Error InvalidOperation "invalid operation" + | c == gl_INVALID_FRAMEBUFFER_OPERATION = + Error InvalidFramebufferOperation "invalid framebuffer operation" + | c == gl_OUT_OF_MEMORY + = Error OutOfMemory "out of memory" + | c == gl_STACK_OVERFLOW = + Error StackOverflow "stack overflow" + | c == gl_STACK_UNDERFLOW = + Error StackUnderflow "stack underflow" + | c == gl_TABLE_TOO_LARGE = + Error TableTooLarge "table too large" + -- GLU errors + | c == glu_INVALID_ENUM = + Error InvalidEnum "invalid enumerant" + | c == glu_INVALID_VALUE = + Error InvalidValue "invalid value" + | c == glu_INVALID_OPERATION = + Error InvalidOperation "invalid operation" + | c == glu_OUT_OF_MEMORY + = Error OutOfMemory "out of memory" + -- GLU tesselator error + | c == glu_TESS_ERROR1 = + Error TesselatorError "gluTessBeginPolygon() must precede a gluTessEndPolygon()" + | c == glu_TESS_ERROR2 = + Error TesselatorError "gluTessBeginContour() must precede a gluTessEndContour()" + | c == glu_TESS_ERROR3 = + Error TesselatorError "gluTessEndPolygon() must follow a gluTessBeginPolygon()" + | c == glu_TESS_ERROR4 = + Error TesselatorError "gluTessEndContour() must follow a gluTessBeginContour()" + | c == glu_TESS_ERROR5 = + Error TesselatorError "a coordinate is too large" + | c == glu_TESS_ERROR6 = + Error TesselatorError "need combine callback" + | c == glu_TESS_ERROR7 = + Error TesselatorError "tesselation error 7" + | c == glu_TESS_ERROR8 = + Error TesselatorError "tesselation error 8" + -- GLU NUBRS errors + | c == glu_NURBS_ERROR1 = + Error NURBSError "spline order un-supported" + | c == glu_NURBS_ERROR2 = + Error NURBSError "too few knots" + | c == glu_NURBS_ERROR3 = + Error NURBSError "valid knot range is empty" + | c == glu_NURBS_ERROR4 = + Error NURBSError "decreasing knot sequence knot" + | c == glu_NURBS_ERROR5 = + Error NURBSError "knot multiplicity greater than order of spline" + | c == glu_NURBS_ERROR6 = + Error NURBSError "gluEndCurve() must follow gluBeginCurve()" + | c == glu_NURBS_ERROR7 = + Error NURBSError "gluBeginCurve() must precede gluEndCurve()" + | c == glu_NURBS_ERROR8 = + Error NURBSError "missing or extra geometric data" + | c == glu_NURBS_ERROR9 = + Error NURBSError "can't draw piecewise linear trimming curves" + | c == glu_NURBS_ERROR10 = + Error NURBSError "missing or extra domain data" + | c == glu_NURBS_ERROR11 = + Error NURBSError "missing or extra domain data" + | c == glu_NURBS_ERROR12 = + Error NURBSError "gluEndTrim() must precede gluEndSurface()" + | c == glu_NURBS_ERROR13 = + Error NURBSError "gluBeginSurface() must precede gluEndSurface()" + | c == glu_NURBS_ERROR14 = + Error NURBSError "curve of improper type passed as trim curve" + | c == glu_NURBS_ERROR15 = + Error NURBSError "gluBeginSurface() must precede gluBeginTrim()" + | c == glu_NURBS_ERROR16 = + Error NURBSError "gluEndTrim() must follow gluBeginTrim()" + | c == glu_NURBS_ERROR17 = + Error NURBSError "gluBeginTrim() must precede gluEndTrim()" + | c == glu_NURBS_ERROR18 = + Error NURBSError "invalid or missing trim curve" + | c == glu_NURBS_ERROR19 = + Error NURBSError "gluBeginTrim() must precede gluPwlCurve()" + | c == glu_NURBS_ERROR20 = + Error NURBSError "piecewise linear trimming curve referenced twice" + | c == glu_NURBS_ERROR21 = + Error NURBSError "piecewise linear trimming curve and nurbs curve mixed" + | c == glu_NURBS_ERROR22 = + Error NURBSError "improper usage of trim data type" + | c == glu_NURBS_ERROR23 = + Error NURBSError "nurbs curve referenced twice" + | c == glu_NURBS_ERROR24 = + Error NURBSError "nurbs curve and piecewise linear trimming curve mixed" + | c == glu_NURBS_ERROR25 = + Error NURBSError "nurbs surface referenced twice" + | c == glu_NURBS_ERROR26 = + Error NURBSError "invalid property" + | c == glu_NURBS_ERROR27 = + Error NURBSError "gluEndSurface() must follow gluBeginSurface()" + | c == glu_NURBS_ERROR28 = + Error NURBSError "intersecting or misoriented trim curves" + | c == glu_NURBS_ERROR29 = + Error NURBSError "intersecting trim curves" + | c == glu_NURBS_ERROR30 = + Error NURBSError "UNUSED" + | c == glu_NURBS_ERROR31 = + Error NURBSError "unconnected trim curves" + | c == glu_NURBS_ERROR32 = + Error NURBSError "unknown knot error" + | c == glu_NURBS_ERROR33 = + Error NURBSError "negative vertex count encountered" + | c == glu_NURBS_ERROR34 = + Error NURBSError "negative byte-stride encounteed" + | c == glu_NURBS_ERROR35 = + Error NURBSError "unknown type descriptor" + | c == glu_NURBS_ERROR36 = + Error NURBSError "null control point reference" + | c == glu_NURBS_ERROR37 = + Error NURBSError "duplicate point on piecewise linear trimming curve" + -- Something went terribly wrong... + | otherwise = error "makeError" -------------------------------------------------------------------------------- @@ -141,9 +207,7 @@ -------------------------------------------------------------------------------- getErrors :: IO [Error] -getErrors = do - es <- getErrorCodesAux (const ([], True)) - mapM makeError es +getErrors = map makeError `fmap` getErrorCodesAux (const ([], True)) recordErrorCode :: GLenum -> IO () recordErrorCode e = do