{-# LANGUAGE CPP #-}
module Graphics.Rendering.OpenGL.GL.DebugOutput (
debugOutput, DebugMessage(..), DebugSource(..), DebugType(..),
DebugMessageID(DebugMessageID), DebugSeverity(..), maxDebugMessageLength,
debugMessageCallback,
maxDebugLoggedMessages, debugLoggedMessages,
MessageGroup(..), debugMessageControl,
debugMessageInsert,
DebugGroup(..), pushDebugGroup, popDebugGroup, withDebugGroup,
maxDebugGroupStackDepth,
CanBeLabeled(..), maxLabelLength,
debugOutputSynchronous
) where
import Control.Monad ( unless, replicateM )
import Data.StateVar
import Foreign.C.String ( peekCStringLen, withCStringLen )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Array ( allocaArray, withArrayLen )
import Foreign.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.GL
debugOutput :: StateVar Capability
debugOutput :: StateVar Capability
debugOutput = EnableCap -> StateVar Capability
makeCapability EnableCap
CapDebugOutput
data DebugMessage =
DebugMessage DebugSource DebugType DebugMessageID DebugSeverity String
deriving ( DebugMessage -> DebugMessage -> Bool
(DebugMessage -> DebugMessage -> Bool)
-> (DebugMessage -> DebugMessage -> Bool) -> Eq DebugMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugMessage -> DebugMessage -> Bool
$c/= :: DebugMessage -> DebugMessage -> Bool
== :: DebugMessage -> DebugMessage -> Bool
$c== :: DebugMessage -> DebugMessage -> Bool
Eq, Eq DebugMessage
Eq DebugMessage
-> (DebugMessage -> DebugMessage -> Ordering)
-> (DebugMessage -> DebugMessage -> Bool)
-> (DebugMessage -> DebugMessage -> Bool)
-> (DebugMessage -> DebugMessage -> Bool)
-> (DebugMessage -> DebugMessage -> Bool)
-> (DebugMessage -> DebugMessage -> DebugMessage)
-> (DebugMessage -> DebugMessage -> DebugMessage)
-> Ord DebugMessage
DebugMessage -> DebugMessage -> Bool
DebugMessage -> DebugMessage -> Ordering
DebugMessage -> DebugMessage -> DebugMessage
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
min :: DebugMessage -> DebugMessage -> DebugMessage
$cmin :: DebugMessage -> DebugMessage -> DebugMessage
max :: DebugMessage -> DebugMessage -> DebugMessage
$cmax :: DebugMessage -> DebugMessage -> DebugMessage
>= :: DebugMessage -> DebugMessage -> Bool
$c>= :: DebugMessage -> DebugMessage -> Bool
> :: DebugMessage -> DebugMessage -> Bool
$c> :: DebugMessage -> DebugMessage -> Bool
<= :: DebugMessage -> DebugMessage -> Bool
$c<= :: DebugMessage -> DebugMessage -> Bool
< :: DebugMessage -> DebugMessage -> Bool
$c< :: DebugMessage -> DebugMessage -> Bool
compare :: DebugMessage -> DebugMessage -> Ordering
$ccompare :: DebugMessage -> DebugMessage -> Ordering
Ord, Int -> DebugMessage -> ShowS
[DebugMessage] -> ShowS
DebugMessage -> String
(Int -> DebugMessage -> ShowS)
-> (DebugMessage -> String)
-> ([DebugMessage] -> ShowS)
-> Show DebugMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugMessage] -> ShowS
$cshowList :: [DebugMessage] -> ShowS
show :: DebugMessage -> String
$cshow :: DebugMessage -> String
showsPrec :: Int -> DebugMessage -> ShowS
$cshowsPrec :: Int -> DebugMessage -> ShowS
Show )
data DebugSource =
DebugSourceAPI
| DebugSourceShaderCompiler
| DebugSourceWindowSystem
| DebugSourceThirdParty
| DebugSourceApplication
| DebugSourceOther
deriving ( DebugSource -> DebugSource -> Bool
(DebugSource -> DebugSource -> Bool)
-> (DebugSource -> DebugSource -> Bool) -> Eq DebugSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugSource -> DebugSource -> Bool
$c/= :: DebugSource -> DebugSource -> Bool
== :: DebugSource -> DebugSource -> Bool
$c== :: DebugSource -> DebugSource -> Bool
Eq, Eq DebugSource
Eq DebugSource
-> (DebugSource -> DebugSource -> Ordering)
-> (DebugSource -> DebugSource -> Bool)
-> (DebugSource -> DebugSource -> Bool)
-> (DebugSource -> DebugSource -> Bool)
-> (DebugSource -> DebugSource -> Bool)
-> (DebugSource -> DebugSource -> DebugSource)
-> (DebugSource -> DebugSource -> DebugSource)
-> Ord DebugSource
DebugSource -> DebugSource -> Bool
DebugSource -> DebugSource -> Ordering
DebugSource -> DebugSource -> DebugSource
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
min :: DebugSource -> DebugSource -> DebugSource
$cmin :: DebugSource -> DebugSource -> DebugSource
max :: DebugSource -> DebugSource -> DebugSource
$cmax :: DebugSource -> DebugSource -> DebugSource
>= :: DebugSource -> DebugSource -> Bool
$c>= :: DebugSource -> DebugSource -> Bool
> :: DebugSource -> DebugSource -> Bool
$c> :: DebugSource -> DebugSource -> Bool
<= :: DebugSource -> DebugSource -> Bool
$c<= :: DebugSource -> DebugSource -> Bool
< :: DebugSource -> DebugSource -> Bool
$c< :: DebugSource -> DebugSource -> Bool
compare :: DebugSource -> DebugSource -> Ordering
$ccompare :: DebugSource -> DebugSource -> Ordering
Ord, Int -> DebugSource -> ShowS
[DebugSource] -> ShowS
DebugSource -> String
(Int -> DebugSource -> ShowS)
-> (DebugSource -> String)
-> ([DebugSource] -> ShowS)
-> Show DebugSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugSource] -> ShowS
$cshowList :: [DebugSource] -> ShowS
show :: DebugSource -> String
$cshow :: DebugSource -> String
showsPrec :: Int -> DebugSource -> ShowS
$cshowsPrec :: Int -> DebugSource -> ShowS
Show )
marshalDebugSource :: DebugSource -> GLenum
marshalDebugSource :: DebugSource -> GLenum
marshalDebugSource DebugSource
x = case DebugSource
x of
DebugSource
DebugSourceAPI -> GLenum
GL_DEBUG_SOURCE_API
DebugSource
DebugSourceShaderCompiler -> GLenum
GL_DEBUG_SOURCE_SHADER_COMPILER
DebugSource
DebugSourceWindowSystem -> GLenum
GL_DEBUG_SOURCE_WINDOW_SYSTEM
DebugSource
DebugSourceThirdParty -> GLenum
GL_DEBUG_SOURCE_THIRD_PARTY
DebugSource
DebugSourceApplication -> GLenum
GL_DEBUG_SOURCE_APPLICATION
DebugSource
DebugSourceOther -> GLenum
GL_DEBUG_SOURCE_OTHER
unmarshalDebugSource :: GLenum -> DebugSource
unmarshalDebugSource :: GLenum -> DebugSource
unmarshalDebugSource GLenum
x
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SOURCE_API = DebugSource
DebugSourceAPI
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SOURCE_SHADER_COMPILER = DebugSource
DebugSourceShaderCompiler
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SOURCE_WINDOW_SYSTEM = DebugSource
DebugSourceWindowSystem
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SOURCE_THIRD_PARTY = DebugSource
DebugSourceThirdParty
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SOURCE_APPLICATION = DebugSource
DebugSourceApplication
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SOURCE_OTHER = DebugSource
DebugSourceOther
| Bool
otherwise = String -> DebugSource
forall a. HasCallStack => String -> a
error (String
"unmarshalDebugSource: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
x)
data DebugType =
DebugTypeError
| DebugTypeDeprecatedBehavior
| DebugTypeUndefinedBehavior
| DebugTypePerformance
| DebugTypePortability
| DebugTypeMarker
| DebugTypePushGroup
| DebugTypePopGroup
| DebugTypeOther
deriving ( DebugType -> DebugType -> Bool
(DebugType -> DebugType -> Bool)
-> (DebugType -> DebugType -> Bool) -> Eq DebugType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugType -> DebugType -> Bool
$c/= :: DebugType -> DebugType -> Bool
== :: DebugType -> DebugType -> Bool
$c== :: DebugType -> DebugType -> Bool
Eq, Eq DebugType
Eq DebugType
-> (DebugType -> DebugType -> Ordering)
-> (DebugType -> DebugType -> Bool)
-> (DebugType -> DebugType -> Bool)
-> (DebugType -> DebugType -> Bool)
-> (DebugType -> DebugType -> Bool)
-> (DebugType -> DebugType -> DebugType)
-> (DebugType -> DebugType -> DebugType)
-> Ord DebugType
DebugType -> DebugType -> Bool
DebugType -> DebugType -> Ordering
DebugType -> DebugType -> DebugType
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
min :: DebugType -> DebugType -> DebugType
$cmin :: DebugType -> DebugType -> DebugType
max :: DebugType -> DebugType -> DebugType
$cmax :: DebugType -> DebugType -> DebugType
>= :: DebugType -> DebugType -> Bool
$c>= :: DebugType -> DebugType -> Bool
> :: DebugType -> DebugType -> Bool
$c> :: DebugType -> DebugType -> Bool
<= :: DebugType -> DebugType -> Bool
$c<= :: DebugType -> DebugType -> Bool
< :: DebugType -> DebugType -> Bool
$c< :: DebugType -> DebugType -> Bool
compare :: DebugType -> DebugType -> Ordering
$ccompare :: DebugType -> DebugType -> Ordering
Ord, Int -> DebugType -> ShowS
[DebugType] -> ShowS
DebugType -> String
(Int -> DebugType -> ShowS)
-> (DebugType -> String)
-> ([DebugType] -> ShowS)
-> Show DebugType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugType] -> ShowS
$cshowList :: [DebugType] -> ShowS
show :: DebugType -> String
$cshow :: DebugType -> String
showsPrec :: Int -> DebugType -> ShowS
$cshowsPrec :: Int -> DebugType -> ShowS
Show )
marshalDebugType :: DebugType -> GLenum
marshalDebugType :: DebugType -> GLenum
marshalDebugType DebugType
x = case DebugType
x of
DebugType
DebugTypeError -> GLenum
GL_DEBUG_TYPE_ERROR
DebugType
DebugTypeDeprecatedBehavior -> GLenum
GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR
DebugType
DebugTypeUndefinedBehavior -> GLenum
GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR
DebugType
DebugTypePerformance -> GLenum
GL_DEBUG_TYPE_PERFORMANCE
DebugType
DebugTypePortability -> GLenum
GL_DEBUG_TYPE_PORTABILITY
DebugType
DebugTypeMarker -> GLenum
GL_DEBUG_TYPE_MARKER
DebugType
DebugTypePushGroup -> GLenum
GL_DEBUG_TYPE_PUSH_GROUP
DebugType
DebugTypePopGroup -> GLenum
GL_DEBUG_TYPE_POP_GROUP
DebugType
DebugTypeOther -> GLenum
GL_DEBUG_TYPE_OTHER
unmarshalDebugType :: GLenum -> DebugType
unmarshalDebugType :: GLenum -> DebugType
unmarshalDebugType GLenum
x
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_ERROR = DebugType
DebugTypeError
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR = DebugType
DebugTypeDeprecatedBehavior
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR = DebugType
DebugTypeUndefinedBehavior
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_PERFORMANCE = DebugType
DebugTypePerformance
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_PORTABILITY = DebugType
DebugTypePortability
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_MARKER = DebugType
DebugTypeMarker
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_PUSH_GROUP = DebugType
DebugTypePushGroup
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_POP_GROUP = DebugType
DebugTypePopGroup
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_TYPE_OTHER = DebugType
DebugTypeOther
| Bool
otherwise = String -> DebugType
forall a. HasCallStack => String -> a
error (String
"unmarshalDebugType: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
x)
newtype DebugMessageID = DebugMessageID { DebugMessageID -> GLenum
debugMessageID :: GLuint }
deriving ( DebugMessageID -> DebugMessageID -> Bool
(DebugMessageID -> DebugMessageID -> Bool)
-> (DebugMessageID -> DebugMessageID -> Bool) -> Eq DebugMessageID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugMessageID -> DebugMessageID -> Bool
$c/= :: DebugMessageID -> DebugMessageID -> Bool
== :: DebugMessageID -> DebugMessageID -> Bool
$c== :: DebugMessageID -> DebugMessageID -> Bool
Eq, Eq DebugMessageID
Eq DebugMessageID
-> (DebugMessageID -> DebugMessageID -> Ordering)
-> (DebugMessageID -> DebugMessageID -> Bool)
-> (DebugMessageID -> DebugMessageID -> Bool)
-> (DebugMessageID -> DebugMessageID -> Bool)
-> (DebugMessageID -> DebugMessageID -> Bool)
-> (DebugMessageID -> DebugMessageID -> DebugMessageID)
-> (DebugMessageID -> DebugMessageID -> DebugMessageID)
-> Ord DebugMessageID
DebugMessageID -> DebugMessageID -> Bool
DebugMessageID -> DebugMessageID -> Ordering
DebugMessageID -> DebugMessageID -> DebugMessageID
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
min :: DebugMessageID -> DebugMessageID -> DebugMessageID
$cmin :: DebugMessageID -> DebugMessageID -> DebugMessageID
max :: DebugMessageID -> DebugMessageID -> DebugMessageID
$cmax :: DebugMessageID -> DebugMessageID -> DebugMessageID
>= :: DebugMessageID -> DebugMessageID -> Bool
$c>= :: DebugMessageID -> DebugMessageID -> Bool
> :: DebugMessageID -> DebugMessageID -> Bool
$c> :: DebugMessageID -> DebugMessageID -> Bool
<= :: DebugMessageID -> DebugMessageID -> Bool
$c<= :: DebugMessageID -> DebugMessageID -> Bool
< :: DebugMessageID -> DebugMessageID -> Bool
$c< :: DebugMessageID -> DebugMessageID -> Bool
compare :: DebugMessageID -> DebugMessageID -> Ordering
$ccompare :: DebugMessageID -> DebugMessageID -> Ordering
Ord, Int -> DebugMessageID -> ShowS
[DebugMessageID] -> ShowS
DebugMessageID -> String
(Int -> DebugMessageID -> ShowS)
-> (DebugMessageID -> String)
-> ([DebugMessageID] -> ShowS)
-> Show DebugMessageID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugMessageID] -> ShowS
$cshowList :: [DebugMessageID] -> ShowS
show :: DebugMessageID -> String
$cshow :: DebugMessageID -> String
showsPrec :: Int -> DebugMessageID -> ShowS
$cshowsPrec :: Int -> DebugMessageID -> ShowS
Show )
data DebugSeverity =
DebugSeverityHigh
| DebugSeverityMedium
| DebugSeverityLow
| DebugSeverityNotification
deriving ( DebugSeverity -> DebugSeverity -> Bool
(DebugSeverity -> DebugSeverity -> Bool)
-> (DebugSeverity -> DebugSeverity -> Bool) -> Eq DebugSeverity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugSeverity -> DebugSeverity -> Bool
$c/= :: DebugSeverity -> DebugSeverity -> Bool
== :: DebugSeverity -> DebugSeverity -> Bool
$c== :: DebugSeverity -> DebugSeverity -> Bool
Eq, Eq DebugSeverity
Eq DebugSeverity
-> (DebugSeverity -> DebugSeverity -> Ordering)
-> (DebugSeverity -> DebugSeverity -> Bool)
-> (DebugSeverity -> DebugSeverity -> Bool)
-> (DebugSeverity -> DebugSeverity -> Bool)
-> (DebugSeverity -> DebugSeverity -> Bool)
-> (DebugSeverity -> DebugSeverity -> DebugSeverity)
-> (DebugSeverity -> DebugSeverity -> DebugSeverity)
-> Ord DebugSeverity
DebugSeverity -> DebugSeverity -> Bool
DebugSeverity -> DebugSeverity -> Ordering
DebugSeverity -> DebugSeverity -> DebugSeverity
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
min :: DebugSeverity -> DebugSeverity -> DebugSeverity
$cmin :: DebugSeverity -> DebugSeverity -> DebugSeverity
max :: DebugSeverity -> DebugSeverity -> DebugSeverity
$cmax :: DebugSeverity -> DebugSeverity -> DebugSeverity
>= :: DebugSeverity -> DebugSeverity -> Bool
$c>= :: DebugSeverity -> DebugSeverity -> Bool
> :: DebugSeverity -> DebugSeverity -> Bool
$c> :: DebugSeverity -> DebugSeverity -> Bool
<= :: DebugSeverity -> DebugSeverity -> Bool
$c<= :: DebugSeverity -> DebugSeverity -> Bool
< :: DebugSeverity -> DebugSeverity -> Bool
$c< :: DebugSeverity -> DebugSeverity -> Bool
compare :: DebugSeverity -> DebugSeverity -> Ordering
$ccompare :: DebugSeverity -> DebugSeverity -> Ordering
Ord, Int -> DebugSeverity -> ShowS
[DebugSeverity] -> ShowS
DebugSeverity -> String
(Int -> DebugSeverity -> ShowS)
-> (DebugSeverity -> String)
-> ([DebugSeverity] -> ShowS)
-> Show DebugSeverity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugSeverity] -> ShowS
$cshowList :: [DebugSeverity] -> ShowS
show :: DebugSeverity -> String
$cshow :: DebugSeverity -> String
showsPrec :: Int -> DebugSeverity -> ShowS
$cshowsPrec :: Int -> DebugSeverity -> ShowS
Show )
marshalDebugSeverity :: DebugSeverity -> GLenum
marshalDebugSeverity :: DebugSeverity -> GLenum
marshalDebugSeverity DebugSeverity
x = case DebugSeverity
x of
DebugSeverity
DebugSeverityHigh -> GLenum
GL_DEBUG_SEVERITY_HIGH
DebugSeverity
DebugSeverityMedium -> GLenum
GL_DEBUG_SEVERITY_MEDIUM
DebugSeverity
DebugSeverityLow -> GLenum
GL_DEBUG_SEVERITY_LOW
DebugSeverity
DebugSeverityNotification -> GLenum
GL_DEBUG_SEVERITY_NOTIFICATION
unmarshalDebugSeverity :: GLenum -> DebugSeverity
unmarshalDebugSeverity :: GLenum -> DebugSeverity
unmarshalDebugSeverity GLenum
x
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SEVERITY_HIGH = DebugSeverity
DebugSeverityHigh
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SEVERITY_MEDIUM = DebugSeverity
DebugSeverityMedium
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SEVERITY_LOW = DebugSeverity
DebugSeverityLow
| GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEBUG_SEVERITY_NOTIFICATION = DebugSeverity
DebugSeverityNotification
| Bool
otherwise = String -> DebugSeverity
forall a. HasCallStack => String -> a
error (String
"unmarshalDebugSeverity: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
x)
maxDebugMessageLength :: GettableStateVar GLsizei
maxDebugMessageLength :: GettableStateVar GLsizei
maxDebugMessageLength =
GettableStateVar GLsizei -> GettableStateVar GLsizei
forall a. IO a -> IO a
makeGettableStateVar ((GLsizei -> GLsizei) -> PName1I -> GettableStateVar GLsizei
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 GLsizei -> GLsizei
forall a. a -> a
id PName1I
GetMaxDebugMessageLength)
debugMessageCallback :: StateVar (Maybe (DebugMessage -> IO ()))
debugMessageCallback :: StateVar (Maybe (DebugMessage -> IO ()))
debugMessageCallback =
IO (Maybe (DebugMessage -> IO ()))
-> (Maybe (DebugMessage -> IO ()) -> IO ())
-> StateVar (Maybe (DebugMessage -> IO ()))
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar IO (Maybe (DebugMessage -> IO ()))
getDebugMessageCallback Maybe (DebugMessage -> IO ()) -> IO ()
setDebugMessageCallback
getDebugMessageCallback :: IO (Maybe (DebugMessage -> IO ()))
getDebugMessageCallback :: IO (Maybe (DebugMessage -> IO ()))
getDebugMessageCallback = do
FunPtr GLDEBUGPROCFunc
cb <- IO (FunPtr GLDEBUGPROCFunc)
getDebugCallbackFunction
Maybe (DebugMessage -> IO ()) -> IO (Maybe (DebugMessage -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (DebugMessage -> IO ())
-> IO (Maybe (DebugMessage -> IO ())))
-> Maybe (DebugMessage -> IO ())
-> IO (Maybe (DebugMessage -> IO ()))
forall a b. (a -> b) -> a -> b
$ if (FunPtr GLDEBUGPROCFunc
cb FunPtr GLDEBUGPROCFunc -> FunPtr GLDEBUGPROCFunc -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr GLDEBUGPROCFunc
forall a. FunPtr a
nullFunPtr)
then Maybe (DebugMessage -> IO ())
forall a. Maybe a
Nothing
else (DebugMessage -> IO ()) -> Maybe (DebugMessage -> IO ())
forall a. a -> Maybe a
Just ((DebugMessage -> IO ()) -> Maybe (DebugMessage -> IO ()))
-> (FunPtr GLDEBUGPROCFunc -> DebugMessage -> IO ())
-> FunPtr GLDEBUGPROCFunc
-> Maybe (DebugMessage -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLDEBUGPROCFunc -> DebugMessage -> IO ()
toDebugProc (GLDEBUGPROCFunc -> DebugMessage -> IO ())
-> (FunPtr GLDEBUGPROCFunc -> GLDEBUGPROCFunc)
-> FunPtr GLDEBUGPROCFunc
-> DebugMessage
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunPtr GLDEBUGPROCFunc -> GLDEBUGPROCFunc
dyn_debugProc (FunPtr GLDEBUGPROCFunc -> Maybe (DebugMessage -> IO ()))
-> FunPtr GLDEBUGPROCFunc -> Maybe (DebugMessage -> IO ())
forall a b. (a -> b) -> a -> b
$ FunPtr GLDEBUGPROCFunc
cb
foreign import CALLCONV "dynamic" dyn_debugProc
:: FunPtr GLDEBUGPROCFunc -> GLDEBUGPROCFunc
toDebugProc:: GLDEBUGPROCFunc -> DebugMessage -> IO ()
toDebugProc :: GLDEBUGPROCFunc -> DebugMessage -> IO ()
toDebugProc GLDEBUGPROCFunc
debugFunc (DebugMessage DebugSource
source DebugType
typ DebugMessageID
msgID DebugSeverity
severity String
message) =
String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
message ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr GLchar
msg, Int
len) -> do
GLDEBUGPROCFunc
debugFunc (DebugSource -> GLenum
marshalDebugSource DebugSource
source)
(DebugType -> GLenum
marshalDebugType DebugType
typ)
(DebugSeverity -> GLenum
marshalDebugSeverity DebugSeverity
severity)
(DebugMessageID -> GLenum
debugMessageID DebugMessageID
msgID)
(Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
Ptr GLchar
msg
Ptr ()
forall a. Ptr a
nullPtr
setDebugMessageCallback :: Maybe (DebugMessage -> IO ()) -> IO ()
setDebugMessageCallback :: Maybe (DebugMessage -> IO ()) -> IO ()
setDebugMessageCallback Maybe (DebugMessage -> IO ())
maybeDebugProc = do
FunPtr GLDEBUGPROCFunc
oldCB <- IO (FunPtr GLDEBUGPROCFunc)
getDebugCallbackFunction
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr GLDEBUGPROCFunc
oldCB FunPtr GLDEBUGPROCFunc -> FunPtr GLDEBUGPROCFunc -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr GLDEBUGPROCFunc
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
FunPtr GLDEBUGPROCFunc -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr GLDEBUGPROCFunc
oldCB
FunPtr GLDEBUGPROCFunc
newCB <-
IO (FunPtr GLDEBUGPROCFunc)
-> ((DebugMessage -> IO ()) -> IO (FunPtr GLDEBUGPROCFunc))
-> Maybe (DebugMessage -> IO ())
-> IO (FunPtr GLDEBUGPROCFunc)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FunPtr GLDEBUGPROCFunc -> IO (FunPtr GLDEBUGPROCFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr GLDEBUGPROCFunc
forall a. FunPtr a
nullFunPtr) (GLDEBUGPROCFunc -> IO (FunPtr GLDEBUGPROCFunc)
makeGLDEBUGPROC (GLDEBUGPROCFunc -> IO (FunPtr GLDEBUGPROCFunc))
-> ((DebugMessage -> IO ()) -> GLDEBUGPROCFunc)
-> (DebugMessage -> IO ())
-> IO (FunPtr GLDEBUGPROCFunc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DebugMessage -> IO ()) -> GLDEBUGPROCFunc
fromDebugProc) Maybe (DebugMessage -> IO ())
maybeDebugProc
FunPtr GLDEBUGPROCFunc -> Ptr Any -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
FunPtr GLDEBUGPROCFunc -> Ptr a -> m ()
glDebugMessageCallbackARB FunPtr GLDEBUGPROCFunc
newCB Ptr Any
forall a. Ptr a
nullPtr
fromDebugProc:: (DebugMessage -> IO ()) -> GLDEBUGPROCFunc
fromDebugProc :: (DebugMessage -> IO ()) -> GLDEBUGPROCFunc
fromDebugProc DebugMessage -> IO ()
debugProc GLenum
source GLenum
typ GLenum
msgID GLenum
severity GLsizei
len Ptr GLchar
message Ptr ()
_userParam = do
String
msg <- CStringLen -> IO String
peekCStringLen (Ptr GLchar
message, GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
len)
DebugMessage -> IO ()
debugProc (DebugSource
-> DebugType
-> DebugMessageID
-> DebugSeverity
-> String
-> DebugMessage
DebugMessage (GLenum -> DebugSource
unmarshalDebugSource GLenum
source)
(GLenum -> DebugType
unmarshalDebugType GLenum
typ)
(GLenum -> DebugMessageID
DebugMessageID GLenum
msgID)
(GLenum -> DebugSeverity
unmarshalDebugSeverity GLenum
severity)
String
msg)
getDebugCallbackFunction :: IO (FunPtr GLDEBUGPROCFunc)
getDebugCallbackFunction :: IO (FunPtr GLDEBUGPROCFunc)
getDebugCallbackFunction =
Ptr Any -> FunPtr GLDEBUGPROCFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr (Ptr Any -> FunPtr GLDEBUGPROCFunc)
-> IO (Ptr Any) -> IO (FunPtr GLDEBUGPROCFunc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` GetPointervPName -> IO (Ptr Any)
forall a. GetPointervPName -> IO (Ptr a)
getPointer GetPointervPName
DebugCallbackFunction
maxDebugLoggedMessages :: GettableStateVar GLsizei
maxDebugLoggedMessages :: GettableStateVar GLsizei
maxDebugLoggedMessages =
GettableStateVar GLsizei -> GettableStateVar GLsizei
forall a. IO a -> IO a
makeGettableStateVar ((GLsizei -> GLsizei) -> PName1I -> GettableStateVar GLsizei
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 GLsizei -> GLsizei
forall a. a -> a
id PName1I
GetMaxDebugLoggedMessages)
debugLoggedMessages :: IO [DebugMessage]
debugLoggedMessages :: IO [DebugMessage]
debugLoggedMessages = do
Int
count <- (GLsizei -> Int) -> PName1I -> IO Int
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PName1I
GetDebugLoggedMessages
Int -> IO DebugMessage -> IO [DebugMessage]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
count IO DebugMessage
debugNextLoggedMessage
debugNextLoggedMessage :: IO DebugMessage
debugNextLoggedMessage :: IO DebugMessage
debugNextLoggedMessage = do
GLsizei
len <- (GLsizei -> GLsizei) -> PName1I -> GettableStateVar GLsizei
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 GLsizei -> GLsizei
forall a. a -> a
id PName1I
GetDebugNextLoggedMessageLength
(Ptr GLenum -> IO DebugMessage) -> IO DebugMessage
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLenum -> IO DebugMessage) -> IO DebugMessage)
-> (Ptr GLenum -> IO DebugMessage) -> IO DebugMessage
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
sourceBuf ->
(Ptr GLenum -> IO DebugMessage) -> IO DebugMessage
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLenum -> IO DebugMessage) -> IO DebugMessage)
-> (Ptr GLenum -> IO DebugMessage) -> IO DebugMessage
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
typeBuf ->
(Ptr GLenum -> IO DebugMessage) -> IO DebugMessage
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLenum -> IO DebugMessage) -> IO DebugMessage)
-> (Ptr GLenum -> IO DebugMessage) -> IO DebugMessage
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
idBuf ->
(Ptr GLenum -> IO DebugMessage) -> IO DebugMessage
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GLenum -> IO DebugMessage) -> IO DebugMessage)
-> (Ptr GLenum -> IO DebugMessage) -> IO DebugMessage
forall a b. (a -> b) -> a -> b
$ \Ptr GLenum
severityBuf ->
Int -> (Ptr GLchar -> IO DebugMessage) -> IO DebugMessage
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
len) ((Ptr GLchar -> IO DebugMessage) -> IO DebugMessage)
-> (Ptr GLchar -> IO DebugMessage) -> IO DebugMessage
forall a b. (a -> b) -> a -> b
$ \Ptr GLchar
messageBuf -> do
GLenum
_ <- GLenum
-> GLsizei
-> Ptr GLenum
-> Ptr GLenum
-> Ptr GLenum
-> Ptr GLenum
-> Ptr GLsizei
-> Ptr GLchar
-> IO GLenum
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLsizei
-> Ptr GLenum
-> Ptr GLenum
-> Ptr GLenum
-> Ptr GLenum
-> Ptr GLsizei
-> Ptr GLchar
-> m GLenum
glGetDebugMessageLog GLenum
1 GLsizei
len Ptr GLenum
sourceBuf Ptr GLenum
typeBuf Ptr GLenum
idBuf
Ptr GLenum
severityBuf Ptr GLsizei
forall a. Ptr a
nullPtr Ptr GLchar
messageBuf
DebugSource
source <- (GLenum -> DebugSource) -> Ptr GLenum -> IO DebugSource
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLenum -> DebugSource
unmarshalDebugSource Ptr GLenum
sourceBuf
DebugType
typ <- (GLenum -> DebugType) -> Ptr GLenum -> IO DebugType
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLenum -> DebugType
unmarshalDebugType Ptr GLenum
typeBuf
DebugMessageID
msgID <- (GLenum -> DebugMessageID) -> Ptr GLenum -> IO DebugMessageID
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLenum -> DebugMessageID
DebugMessageID Ptr GLenum
idBuf
DebugSeverity
severity <- (GLenum -> DebugSeverity) -> Ptr GLenum -> IO DebugSeverity
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLenum -> DebugSeverity
unmarshalDebugSeverity Ptr GLenum
severityBuf
String
message <- CStringLen -> IO String
peekCStringLen (Ptr GLchar
messageBuf, GLsizei -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
len)
DebugMessage -> IO DebugMessage
forall (m :: * -> *) a. Monad m => a -> m a
return (DebugMessage -> IO DebugMessage)
-> DebugMessage -> IO DebugMessage
forall a b. (a -> b) -> a -> b
$ DebugSource
-> DebugType
-> DebugMessageID
-> DebugSeverity
-> String
-> DebugMessage
DebugMessage DebugSource
source DebugType
typ DebugMessageID
msgID DebugSeverity
severity String
message
data MessageGroup =
MessageGroup (Maybe DebugSource) (Maybe DebugType) (Maybe DebugSeverity)
| MessageGroupWithIDs DebugSource DebugType [DebugMessageID]
deriving ( MessageGroup -> MessageGroup -> Bool
(MessageGroup -> MessageGroup -> Bool)
-> (MessageGroup -> MessageGroup -> Bool) -> Eq MessageGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageGroup -> MessageGroup -> Bool
$c/= :: MessageGroup -> MessageGroup -> Bool
== :: MessageGroup -> MessageGroup -> Bool
$c== :: MessageGroup -> MessageGroup -> Bool
Eq, Eq MessageGroup
Eq MessageGroup
-> (MessageGroup -> MessageGroup -> Ordering)
-> (MessageGroup -> MessageGroup -> Bool)
-> (MessageGroup -> MessageGroup -> Bool)
-> (MessageGroup -> MessageGroup -> Bool)
-> (MessageGroup -> MessageGroup -> Bool)
-> (MessageGroup -> MessageGroup -> MessageGroup)
-> (MessageGroup -> MessageGroup -> MessageGroup)
-> Ord MessageGroup
MessageGroup -> MessageGroup -> Bool
MessageGroup -> MessageGroup -> Ordering
MessageGroup -> MessageGroup -> MessageGroup
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
min :: MessageGroup -> MessageGroup -> MessageGroup
$cmin :: MessageGroup -> MessageGroup -> MessageGroup
max :: MessageGroup -> MessageGroup -> MessageGroup
$cmax :: MessageGroup -> MessageGroup -> MessageGroup
>= :: MessageGroup -> MessageGroup -> Bool
$c>= :: MessageGroup -> MessageGroup -> Bool
> :: MessageGroup -> MessageGroup -> Bool
$c> :: MessageGroup -> MessageGroup -> Bool
<= :: MessageGroup -> MessageGroup -> Bool
$c<= :: MessageGroup -> MessageGroup -> Bool
< :: MessageGroup -> MessageGroup -> Bool
$c< :: MessageGroup -> MessageGroup -> Bool
compare :: MessageGroup -> MessageGroup -> Ordering
$ccompare :: MessageGroup -> MessageGroup -> Ordering
Ord, Int -> MessageGroup -> ShowS
[MessageGroup] -> ShowS
MessageGroup -> String
(Int -> MessageGroup -> ShowS)
-> (MessageGroup -> String)
-> ([MessageGroup] -> ShowS)
-> Show MessageGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageGroup] -> ShowS
$cshowList :: [MessageGroup] -> ShowS
show :: MessageGroup -> String
$cshow :: MessageGroup -> String
showsPrec :: Int -> MessageGroup -> ShowS
$cshowsPrec :: Int -> MessageGroup -> ShowS
Show )
debugMessageControl :: MessageGroup -> SettableStateVar Capability
debugMessageControl :: MessageGroup -> SettableStateVar Capability
debugMessageControl MessageGroup
x = case MessageGroup
x of
MessageGroup Maybe DebugSource
maybeSource Maybe DebugType
maybeType Maybe DebugSeverity
maybeSeverity ->
Maybe DebugSource
-> Maybe DebugType
-> Maybe DebugSeverity
-> [DebugMessageID]
-> SettableStateVar Capability
doDebugMessageControl Maybe DebugSource
maybeSource Maybe DebugType
maybeType Maybe DebugSeverity
maybeSeverity []
MessageGroupWithIDs DebugSource
source DebugType
typ [DebugMessageID]
messageIDs ->
Maybe DebugSource
-> Maybe DebugType
-> Maybe DebugSeverity
-> [DebugMessageID]
-> SettableStateVar Capability
doDebugMessageControl (DebugSource -> Maybe DebugSource
forall a. a -> Maybe a
Just DebugSource
source) (DebugType -> Maybe DebugType
forall a. a -> Maybe a
Just DebugType
typ) Maybe DebugSeverity
forall a. Maybe a
Nothing [DebugMessageID]
messageIDs
doDebugMessageControl :: Maybe DebugSource
-> Maybe DebugType
-> Maybe DebugSeverity
-> [DebugMessageID]
-> SettableStateVar Capability
doDebugMessageControl :: Maybe DebugSource
-> Maybe DebugType
-> Maybe DebugSeverity
-> [DebugMessageID]
-> SettableStateVar Capability
doDebugMessageControl Maybe DebugSource
maybeSource Maybe DebugType
maybeType Maybe DebugSeverity
maybeSeverity [DebugMessageID]
messageIDs =
(Capability -> IO ()) -> SettableStateVar Capability
forall a. (a -> IO ()) -> SettableStateVar a
makeSettableStateVar ((Capability -> IO ()) -> SettableStateVar Capability)
-> (Capability -> IO ()) -> SettableStateVar Capability
forall a b. (a -> b) -> a -> b
$ \Capability
cap ->
[GLenum] -> (Int -> Ptr GLenum -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((DebugMessageID -> GLenum) -> [DebugMessageID] -> [GLenum]
forall a b. (a -> b) -> [a] -> [b]
map DebugMessageID -> GLenum
debugMessageID [DebugMessageID]
messageIDs) ((Int -> Ptr GLenum -> IO ()) -> IO ())
-> (Int -> Ptr GLenum -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
len Ptr GLenum
idsBuf ->
GLenum
-> GLenum -> GLenum -> GLsizei -> Ptr GLenum -> GLboolean -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLenum -> GLenum -> GLsizei -> Ptr GLenum -> GLboolean -> m ()
glDebugMessageControl (GLenum -> (DebugSource -> GLenum) -> Maybe DebugSource -> GLenum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GLenum
GL_DONT_CARE DebugSource -> GLenum
marshalDebugSource Maybe DebugSource
maybeSource)
(GLenum -> (DebugType -> GLenum) -> Maybe DebugType -> GLenum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GLenum
GL_DONT_CARE DebugType -> GLenum
marshalDebugType Maybe DebugType
maybeType)
(GLenum
-> (DebugSeverity -> GLenum) -> Maybe DebugSeverity -> GLenum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GLenum
GL_DONT_CARE DebugSeverity -> GLenum
marshalDebugSeverity Maybe DebugSeverity
maybeSeverity)
(Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
Ptr GLenum
idsBuf
(Capability -> GLboolean
marshalCapability Capability
cap)
debugMessageInsert :: DebugMessage -> IO ()
debugMessageInsert :: DebugMessage -> IO ()
debugMessageInsert (DebugMessage DebugSource
source DebugType
typ DebugMessageID
msgID DebugSeverity
severity String
message) =
String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
message ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr GLchar
msg, Int
len) ->
GLenum
-> GLenum -> GLenum -> GLenum -> GLsizei -> Ptr GLchar -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum
-> GLenum -> GLenum -> GLenum -> GLsizei -> Ptr GLchar -> m ()
glDebugMessageInsert (DebugSource -> GLenum
marshalDebugSource DebugSource
source)
(DebugType -> GLenum
marshalDebugType DebugType
typ)
(DebugMessageID -> GLenum
debugMessageID DebugMessageID
msgID)
(DebugSeverity -> GLenum
marshalDebugSeverity DebugSeverity
severity)
(Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
Ptr GLchar
msg
data DebugGroup = DebugGroup DebugSource DebugMessageID String
pushDebugGroup :: DebugSource -> DebugMessageID -> String -> IO ()
pushDebugGroup :: DebugSource -> DebugMessageID -> String -> IO ()
pushDebugGroup DebugSource
source DebugMessageID
msgID String
message =
String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
message ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr GLchar
msg, Int
len) ->
GLenum -> GLenum -> GLsizei -> Ptr GLchar -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLsizei -> Ptr GLchar -> m ()
glPushDebugGroup (DebugSource -> GLenum
marshalDebugSource DebugSource
source)
(DebugMessageID -> GLenum
debugMessageID DebugMessageID
msgID)
(Int -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
Ptr GLchar
msg
popDebugGroup :: IO ()
popDebugGroup :: IO ()
popDebugGroup = IO ()
forall (m :: * -> *). MonadIO m => m ()
glPopDebugGroup
withDebugGroup :: DebugSource -> DebugMessageID -> String -> IO a -> IO a
withDebugGroup :: forall a. DebugSource -> DebugMessageID -> String -> IO a -> IO a
withDebugGroup DebugSource
source DebugMessageID
msgID String
message =
IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (DebugSource -> DebugMessageID -> String -> IO ()
pushDebugGroup DebugSource
source DebugMessageID
msgID String
message) IO ()
popDebugGroup
maxDebugGroupStackDepth :: GettableStateVar GLsizei
maxDebugGroupStackDepth :: GettableStateVar GLsizei
maxDebugGroupStackDepth =
GettableStateVar GLsizei -> GettableStateVar GLsizei
forall a. IO a -> IO a
makeGettableStateVar ((GLsizei -> GLsizei) -> PName1I -> GettableStateVar GLsizei
forall p a. GetPName1I p => (GLsizei -> a) -> p -> IO a
getSizei1 GLsizei -> GLsizei
forall a. a -> a
id PName1I
GetMaxDebugGroupStackDepth)
class CanBeLabeled a where
objectLabel :: a -> StateVar (Maybe String)
debugOutputSynchronous :: StateVar Capability
debugOutputSynchronous :: StateVar Capability
debugOutputSynchronous = EnableCap -> StateVar Capability
makeCapability EnableCap
CapDebugOutputSynchronous