OpenGL 2.11.0.0 → 2.11.1.0

raw patch · 6 files changed

+365/−47 lines, 6 filesdep ~OpenGLRawPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: OpenGLRaw

API changes (from Hackage documentation)

Files

• OpenGL.cabal +9/−1
• src/Graphics/Rendering/OpenGL/GL.hs +2/−0
• src/Graphics/Rendering/OpenGL/GL/Capability.hs +4/−0
• src/Graphics/Rendering/OpenGL/GL/DebugOutput.hs +283/−0
• src/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs +66/−5
• src/Graphics/Rendering/OpenGL/GL/VertexArrays.hs +1/−41

@@ -1,5 +1,5 @@ name: OpenGL-version: 2.11.0.0+version: 2.11.1.0 synopsis: A binding for the OpenGL graphics system description:   A Haskell binding for the OpenGL graphics system (GL, version 4.5) and its@@ -36,6 +36,7 @@     Graphics.Rendering.OpenGL.GL.Colors     Graphics.Rendering.OpenGL.GL.ConditionalRendering     Graphics.Rendering.OpenGL.GL.CoordTrans+    Graphics.Rendering.OpenGL.GL.DebugOutput     Graphics.Rendering.OpenGL.GL.DisplayLists     Graphics.Rendering.OpenGL.GL.Evaluators     Graphics.Rendering.OpenGL.GL.Feedback@@ -154,6 +155,13 @@     DeriveDataTypeable     KindSignatures     TypeSynonymInstances+  if os(windows)+    if arch(i386)+      cpp-options: "-DCALLCONV=stdcall"+    else+      cpp-options: "-DCALLCONV=ccall"+  else+    cpp-options: "-DCALLCONV=ccall"  source-repository head   type: git

@@ -65,6 +65,7 @@    module Graphics.Rendering.OpenGL.GL.Hints,    module Graphics.Rendering.OpenGL.GL.PixellikeObject,    module Graphics.Rendering.OpenGL.GL.TransformFeedback,+   module Graphics.Rendering.OpenGL.GL.DebugOutput,     -- * State and State Requests    module Graphics.Rendering.OpenGL.GL.StateVar,@@ -117,6 +118,7 @@ import Graphics.Rendering.OpenGL.GL.Hints import Graphics.Rendering.OpenGL.GL.PixellikeObject import Graphics.Rendering.OpenGL.GL.TransformFeedback+import Graphics.Rendering.OpenGL.GL.DebugOutput  import Graphics.Rendering.OpenGL.GL.StateVar import Graphics.Rendering.OpenGL.GL.Tensor

@@ -139,6 +139,8 @@    | CapTextureColorTable    | CapVertexProgramPointSize    | CapVertexProgramTwoSide+   | CapDebugOutput+   | CapDebugOutputSynchronous  marshalEnableCap :: EnableCap -> Maybe GLenum marshalEnableCap x = case x of@@ -236,6 +238,8 @@    CapTextureColorTable -> Just gl_TEXTURE_COLOR_TABLE_SGI    CapVertexProgramPointSize -> Just gl_VERTEX_PROGRAM_POINT_SIZE    CapVertexProgramTwoSide -> Just gl_VERTEX_PROGRAM_TWO_SIDE+   CapDebugOutput -> Just gl_DEBUG_OUTPUT+   CapDebugOutputSynchronous -> Just gl_DEBUG_OUTPUT_SYNCHRONOUS  -------------------------------------------------------------------------------- 

@@ -0,0 +1,283 @@+{-# LANGUAGE CPP #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.DebugOutput+-- Copyright   :  (c) Sven Panne 2015+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 20 (Debug Output) of the OpenGL 4.5+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.DebugOutput (+  -- * Debug Messages+  debugOutput, DebugMessage(..), DebugSource(..), DebugType(..),+  DebugMessageID(..), DebugSeverity(..), maxDebugMessageLength,++  -- * Debug Message Callback+  debugMessageCallback,++  -- * Debug Message Log+  maxDebugLoggedMessages, debugLoggedMessages,++  -- * Controlling Debug Messages (TODO)++  -- * Externally Generated Messages+  debugMessageInsert,++  -- * Debug Groups+  DebugGroup(..), pushDebugGroup, popDebugGroup, withDebugGroup,+  maxDebugGroupStackDepth,++  -- * Debug Labels (TODO)++  -- * Asynchronous and Synchronous Debug Output+  debugOutputSynchronous+) where++import Control.Monad ( unless, replicateM )+import Foreign.C.String ( peekCStringLen, withCStringLen )+import Foreign.C.Types+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( allocaArray )+import Foreign.Ptr (+  Ptr, nullPtr, castPtrToFunPtr, FunPtr, nullFunPtr, freeHaskellFunPtr )+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++debugOutput :: StateVar Capability+debugOutput = makeCapability CapDebugOutput++--------------------------------------------------------------------------------++data DebugMessage =+  DebugMessage DebugSource DebugType DebugMessageID DebugSeverity String+  deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data DebugSource =+    DebugSourceAPI+  | DebugSourceShaderCompiler+  | DebugSourceWindowSystem+  | DebugSourceThirdParty+  | DebugSourceApplication+  | DebugSourceOther+  deriving ( Eq, Ord, Show )++marshalDebugSource :: DebugSource -> GLenum+marshalDebugSource x = case x of+  DebugSourceAPI -> gl_DEBUG_SOURCE_API+  DebugSourceShaderCompiler -> gl_DEBUG_SOURCE_SHADER_COMPILER+  DebugSourceWindowSystem -> gl_DEBUG_SOURCE_WINDOW_SYSTEM+  DebugSourceThirdParty -> gl_DEBUG_SOURCE_THIRD_PARTY+  DebugSourceApplication -> gl_DEBUG_SOURCE_APPLICATION+  DebugSourceOther -> gl_DEBUG_SOURCE_OTHER++unmarshalDebugSource :: GLenum -> DebugSource+unmarshalDebugSource x+  | x == gl_DEBUG_SOURCE_API = DebugSourceAPI+  | x == gl_DEBUG_SOURCE_SHADER_COMPILER = DebugSourceShaderCompiler+  | x == gl_DEBUG_SOURCE_WINDOW_SYSTEM = DebugSourceWindowSystem+  | x == gl_DEBUG_SOURCE_THIRD_PARTY = DebugSourceThirdParty+  | x == gl_DEBUG_SOURCE_APPLICATION = DebugSourceApplication+  | x == gl_DEBUG_SOURCE_OTHER = DebugSourceOther+  | otherwise = error ("unmarshalDebugSource: illegal value " ++ show x)++--------------------------------------------------------------------------------++data DebugType =+    DebugTypeError+  | DebugTypeDeprecatedBehavior+  | DebugTypeUndefinedBehavior+  | DebugTypePerformance+  | DebugTypePortability+  | DebugTypeMarker+  | DebugTypePushGroup+  | DebugTypePopGroup+  | DebugTypeOther+  deriving ( Eq, Ord, Show )++marshalDebugType :: DebugType -> GLenum+marshalDebugType x = case x of+  DebugTypeError -> gl_DEBUG_TYPE_ERROR+  DebugTypeDeprecatedBehavior -> gl_DEBUG_TYPE_DEPRECATED_BEHAVIOR+  DebugTypeUndefinedBehavior -> gl_DEBUG_TYPE_UNDEFINED_BEHAVIOR+  DebugTypePerformance -> gl_DEBUG_TYPE_PERFORMANCE+  DebugTypePortability -> gl_DEBUG_TYPE_PORTABILITY+  DebugTypeMarker -> gl_DEBUG_TYPE_MARKER+  DebugTypePushGroup -> gl_DEBUG_TYPE_PUSH_GROUP+  DebugTypePopGroup -> gl_DEBUG_TYPE_POP_GROUP+  DebugTypeOther -> gl_DEBUG_TYPE_OTHER++unmarshalDebugType :: GLenum -> DebugType+unmarshalDebugType x+  | x == gl_DEBUG_TYPE_ERROR = DebugTypeError+  | x == gl_DEBUG_TYPE_DEPRECATED_BEHAVIOR = DebugTypeDeprecatedBehavior+  | x == gl_DEBUG_TYPE_UNDEFINED_BEHAVIOR = DebugTypeUndefinedBehavior+  | x == gl_DEBUG_TYPE_PERFORMANCE = DebugTypePerformance+  | x == gl_DEBUG_TYPE_PORTABILITY = DebugTypePortability+  | x == gl_DEBUG_TYPE_MARKER = DebugTypeMarker+  | x == gl_DEBUG_TYPE_PUSH_GROUP = DebugTypePushGroup+  | x == gl_DEBUG_TYPE_POP_GROUP = DebugTypePopGroup+  | x == gl_DEBUG_TYPE_OTHER = DebugTypeOther+  | otherwise = error ("unmarshalDebugType: illegal value " ++ show x)++--------------------------------------------------------------------------------++newtype DebugMessageID = DebugMessageID { debugMessageID :: GLuint }+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data DebugSeverity =+    DebugSeverityHigh+  | DebugSeverityMedium+  | DebugSeverityLow+  | DebugSeverityNotification+  deriving ( Eq, Ord, Show )++marshalDebugSeverity :: DebugSeverity -> GLenum+marshalDebugSeverity x = case x of+  DebugSeverityHigh -> gl_DEBUG_SEVERITY_HIGH+  DebugSeverityMedium -> gl_DEBUG_SEVERITY_MEDIUM+  DebugSeverityLow -> gl_DEBUG_SEVERITY_LOW+  DebugSeverityNotification -> gl_DEBUG_SEVERITY_NOTIFICATION++unmarshalDebugSeverity :: GLenum -> DebugSeverity+unmarshalDebugSeverity x+  | x == gl_DEBUG_SEVERITY_HIGH = DebugSeverityHigh+  | x == gl_DEBUG_SEVERITY_MEDIUM = DebugSeverityMedium+  | x == gl_DEBUG_SEVERITY_LOW = DebugSeverityLow+  | x == gl_DEBUG_SEVERITY_NOTIFICATION = DebugSeverityNotification+  | otherwise = error ("unmarshalDebugSeverity: illegal value " ++ show x)++--------------------------------------------------------------------------------++maxDebugMessageLength :: GettableStateVar GLsizei+maxDebugMessageLength =+  makeGettableStateVar (getSizei1 id GetMaxDebugMessageLength)++--------------------------------------------------------------------------------++debugMessageCallback :: StateVar (Maybe (DebugMessage -> IO ()))+debugMessageCallback =+  makeStateVar getDebugMessageCallback setDebugMessageCallback++getDebugMessageCallback :: IO (Maybe (DebugMessage -> IO ()))+getDebugMessageCallback = do+  cb <- castPtrToFunPtr `fmap` getPointer DebugCallbackFunction+  return $ if (cb == nullFunPtr)+             then Nothing+             else Just . toDebugProc . dyn_debugProc $ cb++foreign import CALLCONV "dynamic" dyn_debugProc+  :: FunPtr GLDEBUGPROCFunc -> GLDEBUGPROCFunc++toDebugProc:: GLDEBUGPROCFunc -> DebugMessage -> IO ()+toDebugProc debugFunc (DebugMessage source typ msgID severity message) =+  withCStringLen message $ \(msg, len) -> do+    debugFunc (marshalDebugSource source)+              (marshalDebugType typ)+              (marshalDebugSeverity severity)+              (debugMessageID msgID)+              (fromIntegral len)+              msg+              nullPtr++setDebugMessageCallback :: Maybe (DebugMessage -> IO ()) -> IO ()+setDebugMessageCallback maybeDebugProc = do+  oldCB <- castPtrToFunPtr `fmap` getPointer DebugCallbackFunction+  unless (oldCB == nullFunPtr) $+    freeHaskellFunPtr oldCB+  newCB <-+    maybe (return nullFunPtr) (makeGLDEBUGPROC . fromDebugProc) maybeDebugProc+  glDebugMessageCallbackARB newCB  nullPtr++fromDebugProc:: (DebugMessage -> IO ()) -> GLDEBUGPROCFunc+fromDebugProc debugProc source typ msgID severity len message _userParam = do+  msg <- peekCStringLen (message, fromIntegral len)+  debugProc (DebugMessage (unmarshalDebugSource source)+                          (unmarshalDebugType typ)+                          (DebugMessageID msgID)+                          (unmarshalDebugSeverity severity)+                          msg)++--------------------------------------------------------------------------------++maxDebugLoggedMessages :: GettableStateVar GLsizei+maxDebugLoggedMessages =+  makeGettableStateVar (getSizei1 id GetMaxDebugLoggedMessages)++debugLoggedMessages :: IO [DebugMessage]+debugLoggedMessages = do+  count <- getSizei1 fromIntegral GetDebugLoggedMessages+  replicateM count debugNextLoggedMessage++debugNextLoggedMessage :: IO DebugMessage+debugNextLoggedMessage = do+  len <- getSizei1 id GetDebugNextLoggedMessageLength+  alloca $ \sourceBuf ->+    alloca $ \typeBuf ->+      alloca $ \idBuf ->+        alloca $ \severityBuf ->+          allocaArray (fromIntegral len) $ \messageBuf -> do+            glGetDebugMessageLog 1 len sourceBuf typeBuf idBuf severityBuf+                                 nullPtr messageBuf+            source <- peek1 unmarshalDebugSource sourceBuf+            typ <- peek1 unmarshalDebugType typeBuf+            msgID <- peek1 DebugMessageID idBuf+            severity <- peek1 unmarshalDebugSeverity severityBuf+            message <- peekCStringLen (messageBuf, fromIntegral len)+            return $ DebugMessage source typ msgID severity message++--------------------------------------------------------------------------------++debugMessageInsert :: DebugMessage -> IO ()+debugMessageInsert (DebugMessage source typ msgID severity message) =+  withCStringLen message $ \(msg, len) ->+    glDebugMessageInsert (marshalDebugSource source)+                         (marshalDebugType typ)+                         (debugMessageID msgID)+                         (marshalDebugSeverity severity)+                         (fromIntegral len)+                         msg++--------------------------------------------------------------------------------++data DebugGroup = DebugGroup DebugSource DebugMessageID String++pushDebugGroup :: DebugSource -> DebugMessageID -> String -> IO ()+pushDebugGroup source msgID message =+  withCStringLen message $ \(msg, len) ->+    glPushDebugGroup (marshalDebugSource source)+                     (debugMessageID msgID)+                     (fromIntegral len)+                     msg++popDebugGroup :: IO ()+popDebugGroup = glPopDebugGroup++withDebugGroup :: DebugSource -> DebugMessageID -> String -> IO a -> IO a+withDebugGroup source msgID message =+  bracket_ (pushDebugGroup source msgID message) popDebugGroup++maxDebugGroupStackDepth :: GettableStateVar GLsizei+maxDebugGroupStackDepth =+  makeGettableStateVar (getSizei1 id GetMaxDebugGroupStackDepth)++--------------------------------------------------------------------------------++debugOutputSynchronous :: StateVar Capability+debugOutputSynchronous = makeCapability CapDebugOutputSynchronous

@@ -28,13 +28,16 @@     GetPNameMatrix(..),     PNameMatrix(..), -    clipPlaneIndexToEnum+    clipPlaneIndexToEnum,++    GetPointervPName(..), getPointer ) where -import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( allocaArray, peekArray )+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( Ptr, nullPtr, castPtr )+import Foreign.Storable ( Storable(peek) ) import Graphics.Rendering.OpenGL.GL.PeekPoke import Graphics.Rendering.OpenGL.GLU.ErrorsInternal import Graphics.Rendering.OpenGL.Raw@@ -552,6 +555,12 @@     | GetShaderCompiler             -- ^ bool     | GetNumShaderBinaryFormats     -- ^ int     | GetNumProgramBinaryFormats    -- ^ int+    -- Debug Output+    | GetMaxDebugMessageLength        -- ^ int+    | GetMaxDebugLoggedMessages       -- ^ int+    | GetDebugLoggedMessages          -- ^ int+    | GetDebugNextLoggedMessageLength -- ^ int+    | GetMaxDebugGroupStackDepth      -- ^ int  instance GetPName1I PName1I where @@ -815,6 +824,12 @@         GetShaderCompiler -> Just gl_SHADER_COMPILER         GetNumShaderBinaryFormats -> Just gl_NUM_SHADER_BINARY_FORMATS         GetNumProgramBinaryFormats -> Just gl_NUM_PROGRAM_BINARY_FORMATS+        -- Debug Output+        GetMaxDebugMessageLength -> Just gl_MAX_DEBUG_MESSAGE_LENGTH+        GetMaxDebugLoggedMessages -> Just gl_MAX_DEBUG_LOGGED_MESSAGES+        GetDebugLoggedMessages -> Just gl_DEBUG_LOGGED_MESSAGES+        GetDebugNextLoggedMessageLength -> Just gl_DEBUG_NEXT_LOGGED_MESSAGE_LENGTH+        GetMaxDebugGroupStackDepth -> Just gl_MAX_DEBUG_GROUP_STACK_DEPTH  -- 0x8825 through 0x8834 are reserved for draw buffers @@ -1187,3 +1202,49 @@         GetTextureMatrix -> Just gl_TEXTURE_MATRIX         GetColorMatrix -> Just gl_COLOR_MATRIX         GetMatrixPalette -> Just gl_MATRIX_PALETTE_ARB++--------------------------------------------------------------------------------++data GetPointervPName =+   -- core profile+     DebugCallbackFunction+   | DebugCallbackUserParam+   -- compatibility profile+   | SelectionBufferPointer+   | FeedbackBufferPointer+   | VertexArrayPointer+   | NormalArrayPointer+   | ColorArrayPointer+   | SecondaryColorArrayPointer+   | IndexArrayPointer+   | TextureCoordArrayPointer+   | FogCoordArrayPointer+   | EdgeFlagArrayPointer+   -- GL_ARB_vertex_blend+   | WeightArrayPointer+   -- GL_ARB_matrix_palette+   | MatrixIndexArrayPointer++marshalGetPointervPName :: GetPointervPName -> GLenum+marshalGetPointervPName x = case x of+   DebugCallbackFunction -> gl_DEBUG_CALLBACK_FUNCTION+   DebugCallbackUserParam -> gl_DEBUG_CALLBACK_USER_PARAM+   SelectionBufferPointer -> gl_SELECTION_BUFFER_POINTER+   FeedbackBufferPointer -> gl_FEEDBACK_BUFFER_POINTER+   VertexArrayPointer -> gl_VERTEX_ARRAY_POINTER+   NormalArrayPointer -> gl_NORMAL_ARRAY_POINTER+   ColorArrayPointer -> gl_COLOR_ARRAY_POINTER+   SecondaryColorArrayPointer -> gl_SECONDARY_COLOR_ARRAY_POINTER+   IndexArrayPointer -> gl_INDEX_ARRAY_POINTER+   TextureCoordArrayPointer -> gl_TEXTURE_COORD_ARRAY_POINTER+   FogCoordArrayPointer -> gl_FOG_COORD_ARRAY_POINTER+   EdgeFlagArrayPointer -> gl_EDGE_FLAG_ARRAY_POINTER+   WeightArrayPointer -> gl_WEIGHT_ARRAY_POINTER_ARB+   MatrixIndexArrayPointer -> gl_MATRIX_INDEX_ARRAY_POINTER_ARB++--------------------------------------------------------------------------------++getPointer :: GetPointervPName -> IO (Ptr a)+getPointer n = with nullPtr $ \buf -> do+   glGetPointerv (marshalGetPointervPName n) buf+   peek buf

@@ -35,9 +35,7 @@    vertexAttribPointer, vertexAttribArray, ) where -import Foreign.Marshal.Utils-import Foreign.Ptr-import Foreign.Storable+import Foreign.Ptr ( Ptr, nullPtr ) import Graphics.Rendering.OpenGL.GL.Capability import Graphics.Rendering.OpenGL.GL.DataType import Graphics.Rendering.OpenGL.GL.GLboolean@@ -404,44 +402,6 @@    Nothing  -> glDisableClientState gl_PRIMITIVE_RESTART_NV    Just idx -> do glEnableClientState gl_PRIMITIVE_RESTART_NV                   glPrimitiveRestartIndexNV (fromIntegral idx)------------------------------------------------------------------------------------data GetPointervPName =-     VertexArrayPointer-   | NormalArrayPointer-   | ColorArrayPointer-   | IndexArrayPointer-   | TextureCoordArrayPointer-   | EdgeFlagArrayPointer-   | FogCoordArrayPointer-   | SecondaryColorArrayPointer-   | FeedbackBufferPointer-   | SelectionBufferPointer-   | WeightArrayPointer-   | MatrixIndexArrayPointer--marshalGetPointervPName :: GetPointervPName -> GLenum-marshalGetPointervPName x = case x of-   VertexArrayPointer -> gl_VERTEX_ARRAY_POINTER-   NormalArrayPointer -> gl_NORMAL_ARRAY_POINTER-   ColorArrayPointer -> gl_COLOR_ARRAY_POINTER-   IndexArrayPointer -> gl_INDEX_ARRAY_POINTER-   TextureCoordArrayPointer -> gl_TEXTURE_COORD_ARRAY_POINTER-   EdgeFlagArrayPointer -> gl_EDGE_FLAG_ARRAY_POINTER-   FogCoordArrayPointer -> gl_FOG_COORD_ARRAY_POINTER-   SecondaryColorArrayPointer -> gl_SECONDARY_COLOR_ARRAY_POINTER-   FeedbackBufferPointer -> gl_FEEDBACK_BUFFER_POINTER-   SelectionBufferPointer -> gl_SELECTION_BUFFER_POINTER-   WeightArrayPointer -> gl_WEIGHT_ARRAY_POINTER_ARB-   MatrixIndexArrayPointer -> gl_MATRIX_INDEX_ARRAY_POINTER_ARB------------------------------------------------------------------------------------getPointer :: GetPointervPName -> IO (Ptr a)-getPointer n = with nullPtr $ \buf -> do-   glGetPointerv (marshalGetPointervPName n) buf-   peek buf  --------------------------------------------------------------------------------