diff --git a/Graphics/Rendering/OpenGL/GL.hs b/Graphics/Rendering/OpenGL/GL.hs --- a/Graphics/Rendering/OpenGL/GL.hs +++ b/Graphics/Rendering/OpenGL/GL.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -19,6 +19,7 @@ module Graphics.Rendering.OpenGL.GL.BeginEnd, module Graphics.Rendering.OpenGL.GL.VertexSpec, module Graphics.Rendering.OpenGL.GL.VertexArrays, + module Graphics.Rendering.OpenGL.GL.VertexArrayObjects, module Graphics.Rendering.OpenGL.GL.BufferObjects, module Graphics.Rendering.OpenGL.GL.Rectangles, module Graphics.Rendering.OpenGL.GL.CoordTrans, @@ -29,6 +30,7 @@ -- * Rasterization module Graphics.Rendering.OpenGL.GL.Antialiasing, + module Graphics.Rendering.OpenGL.GL.FramebufferObjects, module Graphics.Rendering.OpenGL.GL.Points, module Graphics.Rendering.OpenGL.GL.LineSegments, module Graphics.Rendering.OpenGL.GL.Polygons, @@ -50,6 +52,10 @@ module Graphics.Rendering.OpenGL.GL.DisplayLists, module Graphics.Rendering.OpenGL.GL.FlushFinish, module Graphics.Rendering.OpenGL.GL.Hints, + module Graphics.Rendering.OpenGL.GL.PixellikeObject, + module Graphics.Rendering.OpenGL.GL.TransformFeedback, +-- is exported through PerFragment for backwards compatibility reasons +-- module Graphics.Rendering.OpenGL.GL.QueryObjects, -- * State and State Requests module Data.StateVar, @@ -65,6 +71,7 @@ import Graphics.Rendering.OpenGL.GL.BeginEnd import Graphics.Rendering.OpenGL.GL.VertexSpec import Graphics.Rendering.OpenGL.GL.VertexArrays +import Graphics.Rendering.OpenGL.GL.VertexArrayObjects import Graphics.Rendering.OpenGL.GL.BufferObjects import Graphics.Rendering.OpenGL.GL.Rectangles import Graphics.Rendering.OpenGL.GL.CoordTrans @@ -74,6 +81,7 @@ import Graphics.Rendering.OpenGL.GL.Shaders import Graphics.Rendering.OpenGL.GL.Antialiasing +import Graphics.Rendering.OpenGL.GL.FramebufferObjects import Graphics.Rendering.OpenGL.GL.Points import Graphics.Rendering.OpenGL.GL.LineSegments import Graphics.Rendering.OpenGL.GL.Polygons @@ -93,6 +101,10 @@ import Graphics.Rendering.OpenGL.GL.DisplayLists import Graphics.Rendering.OpenGL.GL.FlushFinish import Graphics.Rendering.OpenGL.GL.Hints +import Graphics.Rendering.OpenGL.GL.PixellikeObject +import Graphics.Rendering.OpenGL.GL.TransformFeedback +-- is exported through PerFragment for backwards compatibility reasons +--import Graphics.Rendering.OpenGL.GL.QueryObjects import Data.StateVar import Data.Tensor diff --git a/Graphics/Rendering/OpenGL/GL/Antialiasing.hs b/Graphics/Rendering/OpenGL/GL/Antialiasing.hs --- a/Graphics/Rendering/OpenGL/GL/Antialiasing.hs +++ b/Graphics/Rendering/OpenGL/GL/Antialiasing.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Antialiasing -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -36,5 +36,5 @@ subpixelBits :: GettableStateVar GLsizei subpixelBits = antialiasingInfo GetSubpixelBits -antialiasingInfo :: GetPName -> GettableStateVar GLsizei +antialiasingInfo :: GetPName1I p => p -> GettableStateVar GLsizei antialiasingInfo = makeGettableStateVar . getSizei1 id diff --git a/Graphics/Rendering/OpenGL/GL/BufferMode.hs b/Graphics/Rendering/OpenGL/GL/BufferMode.hs --- a/Graphics/Rendering/OpenGL/GL/BufferMode.hs +++ b/Graphics/Rendering/OpenGL/GL/BufferMode.hs @@ -4,7 +4,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.BufferMode -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -14,7 +14,8 @@ -------------------------------------------------------------------------------- module Graphics.Rendering.OpenGL.GL.BufferMode ( - BufferMode(..), marshalBufferMode, unmarshalBufferMode + BufferMode(..), marshalBufferMode, unmarshalBufferMode, unmarshalBufferModeSafe, + maxColorAttachments, ) where import Graphics.Rendering.OpenGL.Raw.Core31 @@ -60,6 +61,9 @@ -- front left color buffer is selected. | AuxBuffer GLsizei -- ^ Only the given auxiliary color buffer no. /i/ is selected. + | FBOColorAttachment GLsizei + -- ^ Only the given color attachment of the bound framebufferobject is selected for reading + -- or writing. deriving ( Eq, Ord, Show ) marshalBufferMode :: BufferMode -> Maybe GLenum @@ -77,21 +81,46 @@ AuxBuffer i | fromIntegral i <= maxAuxBuffer -> Just (gl_AUX0 + fromIntegral i) | otherwise -> Nothing + FBOColorAttachment i + | fromIntegral i <= maxColorAttachments -> Just (gl_COLOR_ATTACHMENT0 + fromIntegral i) + | otherwise -> Nothing unmarshalBufferMode :: GLenum -> BufferMode -unmarshalBufferMode x - | x == gl_NONE = NoBuffers - | x == gl_FRONT_LEFT = FrontLeftBuffer - | x == gl_FRONT_RIGHT = FrontRightBuffer - | x == gl_BACK_LEFT = BackLeftBuffer - | x == gl_BACK_RIGHT = BackRightBuffer - | x == gl_FRONT = FrontBuffers - | x == gl_BACK = BackBuffers - | x == gl_LEFT = LeftBuffers - | x == gl_RIGHT = RightBuffers - | x == gl_FRONT_AND_BACK = FrontAndBackBuffers - | gl_AUX0 <= x && x <= gl_AUX0 + maxAuxBuffer = AuxBuffer (fromIntegral (x - gl_AUX0)) - | otherwise = error ("unmarshalBufferMode: illegal value " ++ show x) +unmarshalBufferMode x = maybe + (error ("unmarshalBufferMode: illegal value " ++ show x)) id $ unmarshalBufferModeSafe x +--unmarshalBufferMode x +-- | x == gl_NONE = NoBuffers +-- | x == gl_FRONT_LEFT = FrontLeftBuffer +-- | x == gl_FRONT_RIGHT = FrontRightBuffer +-- | x == gl_BACK_LEFT = BackLeftBuffer +-- | x == gl_BACK_RIGHT = BackRightBuffer +-- | x == gl_FRONT = FrontBuffers +-- | x == gl_BACK = BackBuffers +-- | x == gl_LEFT = LeftBuffers +-- | x == gl_RIGHT = RightBuffers +-- | x == gl_FRONT_AND_BACK = FrontAndBackBuffers +-- | gl_AUX0 <= x && x <= gl_AUX0 + maxAuxBuffer = AuxBuffer (fromIntegral (x - gl_AUX0)) +-- | otherwise = error ("unmarshalBufferMode: illegal value " ++ show x) +unmarshalBufferModeSafe :: GLenum -> Maybe BufferMode +unmarshalBufferModeSafe x + | x == gl_NONE = Just NoBuffers + | x == gl_FRONT_LEFT = Just FrontLeftBuffer + | x == gl_FRONT_RIGHT = Just FrontRightBuffer + | x == gl_BACK_LEFT = Just BackLeftBuffer + | x == gl_BACK_RIGHT = Just BackRightBuffer + | x == gl_FRONT = Just FrontBuffers + | x == gl_BACK = Just BackBuffers + | x == gl_LEFT = Just LeftBuffers + | x == gl_RIGHT = Just RightBuffers + | x == gl_FRONT_AND_BACK = Just FrontAndBackBuffers + | gl_AUX0 <= x && x <= gl_AUX0 + maxAuxBuffer = Just . AuxBuffer . fromIntegral $ x - gl_AUX0 + | gl_COLOR_ATTACHMENT0 <= x && x <= gl_COLOR_ATTACHMENT0 + maxColorAttachments + = Just . FBOColorAttachment . fromIntegral $ x - gl_COLOR_ATTACHMENT0 + | otherwise = Nothing + maxAuxBuffer :: GLenum maxAuxBuffer = 246 + +maxColorAttachments :: GLenum +maxColorAttachments = 16 diff --git a/Graphics/Rendering/OpenGL/GL/BufferObjects.hs b/Graphics/Rendering/OpenGL/GL/BufferObjects.hs --- a/Graphics/Rendering/OpenGL/GL/BufferObjects.hs +++ b/Graphics/Rendering/OpenGL/GL/BufferObjects.hs @@ -30,15 +30,31 @@ -- * Mapping Buffer Objects BufferAccess(..), MappingFailure(..), withMappedBuffer, mapBuffer, unmapBuffer, - bufferAccess, bufferMapped + bufferAccess, bufferMapped, + + BufferRangeAccessBit(..), Offset, Length, + mapBufferRange, flushMappedBufferRange, + + -- * Indexed Buffer manipulation + BufferIndex, + RangeStartIndex, RangeSize, + BufferRange, + IndexedBufferTarget(..), + bindBufferBase, bindBufferRange, + indexedBufferStart, indexedBufferSize ) where import Data.ObjectName +import Data.List(foldl1') +import Data.Bits((.|.)) +import Data.Maybe + import Data.StateVar import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable + import Graphics.Rendering.OpenGL.GL.Exception import Graphics.Rendering.OpenGL.GL.GLboolean import Graphics.Rendering.OpenGL.GL.PeekPoke @@ -75,6 +91,7 @@ | ElementArrayBuffer | PixelPackBuffer | PixelUnpackBuffer + | TransformFeedbackBuffer deriving ( Eq, Ord, Show ) marshalBufferTarget :: BufferTarget -> GLenum @@ -85,8 +102,9 @@ ElementArrayBuffer -> gl_ELEMENT_ARRAY_BUFFER PixelPackBuffer -> gl_PIXEL_PACK_BUFFER PixelUnpackBuffer -> gl_PIXEL_UNPACK_BUFFER + TransformFeedbackBuffer -> gl_TRANSFORM_FEEDBACK_BUFFER -bufferTargetToGetPName :: BufferTarget -> GetPName +bufferTargetToGetPName :: BufferTarget -> PName1I bufferTargetToGetPName x = case x of ArrayBuffer -> GetArrayBufferBinding ElementArrayBuffer -> GetElementArrayBufferBinding @@ -94,6 +112,7 @@ CopyWriteBuffer -> GetCopyWriteBuffer PixelPackBuffer -> GetPixelPackBufferBinding PixelUnpackBuffer -> GetPixelUnpackBufferBinding + TransformFeedbackBuffer -> GetTransformFeedbackBufferBinding -------------------------------------------------------------------------------- @@ -163,7 +182,7 @@ getBindBuffer :: BufferTarget -> IO (Maybe BufferObject) getBindBuffer = bufferQuery bufferTargetToGetPName -bufferQuery :: (a -> GetPName) -> a -> IO (Maybe BufferObject) +bufferQuery :: (a -> PName1I) -> a -> IO (Maybe BufferObject) bufferQuery func t = do buf <- getInteger1 (BufferObject . fromIntegral) (func t) return $ if buf == noBufferObject then Nothing else Just buf @@ -173,9 +192,9 @@ setBindBuffer :: BufferTarget -> Maybe BufferObject -> IO () setBindBuffer t = - glBindBuffer (marshalBufferTarget t) . bufferID . maybe noBufferObject id + glBindBuffer (marshalBufferTarget t) . bufferID . fromMaybe noBufferObject -clientArrayTypeToGetPName :: ClientArrayType -> GetPName +clientArrayTypeToGetPName :: ClientArrayType -> PName1I clientArrayTypeToGetPName x = case x of VertexArray -> GetVertexArrayBufferBinding NormalArray -> GetNormalArrayBufferBinding @@ -291,3 +310,111 @@ bufferMapped :: BufferTarget -> GettableStateVar Bool bufferMapped t = makeGettableStateVar $ getBufferParameter t unmarshalGLboolean GetBufferMapped + +-------------------------------------------------------------------------------- + +data BufferRangeAccessBit = + ReadBit + | WriteBit + | InvalidateRangeBit + | InvalidateBufferBit + | FlushExplicitBit + | UnsychronizedBit + +type Offset = GLintptr +type Length = GLsizeiptr + +marshalBufferRangeAccessBit :: BufferRangeAccessBit -> GLenum +marshalBufferRangeAccessBit x = case x of + ReadBit -> gl_MAP_READ_BIT + WriteBit -> gl_MAP_WRITE_BIT + InvalidateRangeBit -> gl_MAP_INVALIDATE_RANGE_BIT + InvalidateBufferBit -> gl_MAP_INVALIDATE_BUFFER_BIT + FlushExplicitBit -> gl_MAP_FLUSH_EXPLICIT_BIT + UnsychronizedBit -> gl_MAP_FLUSH_EXPLICIT_BIT + +marshalToBitfield :: [BufferRangeAccessBit] -> GLenum +marshalToBitfield b = foldl1' (.|.) $ map marshalBufferRangeAccessBit b + +-------------------------------------------------------------------------------- + +mapBufferRange_ :: BufferTarget -> Offset -> Length -> + [BufferRangeAccessBit] -> IO (Ptr a) +mapBufferRange_ t o l b = glMapBufferRange (marshalBufferTarget t) o l + (fromIntegral $ marshalToBitfield b) + +mapBufferRange :: BufferTarget -> Offset -> Length -> + [BufferRangeAccessBit] -> IO (Maybe (Ptr a)) +mapBufferRange t o l b = fmap (maybeNullPtr Nothing Just) $ mapBufferRange_ t o l b + +flushMappedBufferRange :: BufferTarget -> Offset -> Length -> IO() +flushMappedBufferRange t = glFlushMappedBufferRange (marshalBufferTarget t) + + +-------------------------------------------------------------------------------- +type BufferIndex = GLuint + +type RangeStartIndex = GLintptr +type RangeSize = GLsizeiptr +type BufferRange = (BufferObject, RangeStartIndex, RangeSize) + +data IndexedBufferTarget = + IndexedTransformFeedBackbuffer +--marshaling +marshalIndexedBufferTarget :: IndexedBufferTarget -> IPName1I +marshalIndexedBufferTarget x = case x of + IndexedTransformFeedBackbuffer -> GetTransformFeedbackBuffer + +marshalIndexedBufferStart :: IndexedBufferTarget -> IPName1I +marshalIndexedBufferStart x = case x of + IndexedTransformFeedBackbuffer -> GetTransformFeedbackBufferStart + +marshalIndexedBufferSize :: IndexedBufferTarget -> IPName1I +marshalIndexedBufferSize x = case x of + IndexedTransformFeedBackbuffer -> GetTransformFeedbackBufferSize + +getIndexed :: Num a => IPName1I -> BufferIndex -> GettableStateVar a +getIndexed e i = makeGettableStateVar $ getInteger1i fromIntegral e i + +--buffer +bindBufferBase :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferObject) +bindBufferBase t i = makeStateVar (getIndexedBufferBinding t i) (setIndexedBufferBase t i) + +setIndexedBufferBase :: IndexedBufferTarget -> BufferIndex -> Maybe BufferObject -> IO () +setIndexedBufferBase t i buf= + case marshalGetPName . marshalIndexedBufferTarget $ t of + Nothing -> recordInvalidEnum + Just t' -> + glBindBufferBase t' i . bufferID . fromMaybe noBufferObject $ buf + +getIndexedBufferBinding :: IndexedBufferTarget -> BufferIndex -> IO (Maybe BufferObject) +getIndexedBufferBinding t i = do + buf <- getInteger1i (BufferObject . fromIntegral) (marshalIndexedBufferTarget t) i + return $ if buf == noBufferObject then Nothing else Just buf + +bindBufferRange :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferRange) +bindBufferRange t i = makeStateVar (getIndexedBufferRange t i) (setIndexedBufferRange t i) + +setIndexedBufferRange :: IndexedBufferTarget -> BufferIndex -> Maybe BufferRange -> IO () +setIndexedBufferRange t i (Just (buf, start, range)) = + case marshalGetPName . marshalIndexedBufferTarget $ t of + Nothing -> recordInvalidEnum + Just t' -> glBindBufferRange t' i (bufferID buf) start range +setIndexedBufferRange t i Nothing = setIndexedBufferBase t i Nothing + +getIndexedBufferRange :: IndexedBufferTarget -> BufferIndex -> IO(Maybe BufferRange) +getIndexedBufferRange t i = do + buf <- getInteger1i (BufferObject . fromIntegral) (marshalIndexedBufferTarget t) i + if buf == noBufferObject + then return Nothing + else do + start <- get $ indexedBufferStart t i + size <- get $ indexedBufferSize t i + return $ Just (buf, start, size) + + +indexedBufferStart :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeStartIndex +indexedBufferStart = getIndexed . marshalIndexedBufferStart + +indexedBufferSize :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeSize +indexedBufferSize = getIndexed . marshalIndexedBufferSize diff --git a/Graphics/Rendering/OpenGL/GL/Capability.hs b/Graphics/Rendering/OpenGL/GL/Capability.hs --- a/Graphics/Rendering/OpenGL/GL/Capability.hs +++ b/Graphics/Rendering/OpenGL/GL/Capability.hs @@ -4,7 +4,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Capability -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -16,7 +16,9 @@ module Graphics.Rendering.OpenGL.GL.Capability ( Capability(..), marshalCapability, unmarshalCapability, - EnableCap(..), makeCapability, makeStateVarMaybe + EnableCap(..), makeCapability, makeStateVarMaybe, + + IndexedEnableCap(..), makeIndexedCapability, ) where import Data.StateVar @@ -150,6 +152,7 @@ | CapPointSprite | CapStencilTestTwoSide | CapRasterPositionUnclipped + | CapRasterizerDiscard | CapTextureColorTable | CapVertexProgramPointSize | CapVertexProgramTwoSide @@ -242,6 +245,7 @@ CapStencilTestTwoSide -> Just gl_STENCIL_TEST_TWO_SIDE -- TODO: use RASTER_POSITION_UNCLIPPED_IBM from IBM_rasterpos_clip extension CapRasterPositionUnclipped -> Just 0x19262 + CapRasterizerDiscard -> Just gl_RASTERIZER_DISCARD -- TODO: use TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension CapTextureColorTable -> Just 0x80bc CapVertexProgramPointSize -> Just gl_VERTEX_PROGRAM_POINT_SIZE @@ -287,3 +291,30 @@ setStateVarMaybe getCap act val = do capability <- fmap makeCapability getCap maybe (capability $= Disabled) (\x -> act x >> capability $= Enabled) val + +-------------------------------------------------------------------------------- + +data IndexedEnableCap = + BlendI + +marshalIndexedEnableCap :: IndexedEnableCap -> Maybe GLenum +marshalIndexedEnableCap x = case x of + BlendI -> Just gl_BLEND + +makeIndexedCapability ::(a -> GLuint) -> IndexedEnableCap -> a + -> StateVar Capability +makeIndexedCapability f cap val = makeStateVar + (isIndexedEnabled (f val) cap) + (\state -> enableIndexed (f val) cap state) + +isIndexedEnabled :: GLuint -> IndexedEnableCap -> IO Capability +isIndexedEnabled i = + maybe (do recordInvalidEnum; return Disabled) + (\cap -> fmap unmarshalCapability $ glIsEnabledi cap i) . + marshalIndexedEnableCap + +enableIndexed :: GLuint -> IndexedEnableCap -> Capability -> IO () +enableIndexed i cap state = + maybe recordInvalidEnum (f state) (marshalIndexedEnableCap cap) + where f Enabled = \c -> glEnablei c i + f Disabled = \c -> glDisablei c i diff --git a/Graphics/Rendering/OpenGL/GL/Clipping.hs b/Graphics/Rendering/OpenGL/GL/Clipping.hs --- a/Graphics/Rendering/OpenGL/GL/Clipping.hs +++ b/Graphics/Rendering/OpenGL/GL/Clipping.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Clipping -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -17,12 +17,10 @@ ) where import Data.StateVar -import Foreign.Marshal.Alloc import Foreign.Marshal.Utils import Foreign.Ptr import Graphics.Rendering.OpenGL.GL.Capability import Graphics.Rendering.OpenGL.GL.CoordTrans -import Graphics.Rendering.OpenGL.GL.PeekPoke import Graphics.Rendering.OpenGL.GL.QueryUtils import Graphics.Rendering.OpenGL.GLU.ErrorsInternal import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glClipPlane ) @@ -39,9 +37,10 @@ clipPlane (ClipPlaneName i) = makeStateVarMaybe (return (CapClipPlane i)) - (alloca $ \buf -> do - getDoublev (GetClipPlane i) (castPtr buf) - peek1 id (buf :: Ptr (Plane GLdouble))) +-- (alloca $ \buf -> do +-- getDoublev (GetClipPlane i) (castPtr buf) +-- peek1 id (buf :: Ptr (Plane GLdouble))) + (getDouble4 Plane (GetClipPlane i)) (\plane -> maybe recordInvalidEnum (with plane . glClipPlane_) (clipPlaneIndexToEnum i)) diff --git a/Graphics/Rendering/OpenGL/GL/Colors.hs b/Graphics/Rendering/OpenGL/GL/Colors.hs --- a/Graphics/Rendering/OpenGL/GL/Colors.hs +++ b/Graphics/Rendering/OpenGL/GL/Colors.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Colors -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -36,7 +36,11 @@ ColorMaterialParameter(..), colorMaterial, -- * Flatshading - ShadingModel(..), shadeModel + ShadingModel(..), shadeModel, + + -- * Color clamping + ClampTarget(..), ClampMode(..), + clampColor, ) where import Control.Monad @@ -62,7 +66,8 @@ gl_LIGHT_MODEL_LOCAL_VIEWER, gl_LIGHT_MODEL_TWO_SIDE, gl_LINEAR_ATTENUATION, gl_POSITION, gl_QUADRATIC_ATTENUATION, gl_SEPARATE_SPECULAR_COLOR, gl_SHININESS, gl_SINGLE_COLOR, gl_SMOOTH, gl_SPECULAR, gl_SPOT_CUTOFF, - gl_SPOT_DIRECTION, gl_SPOT_EXPONENT ) + gl_SPOT_DIRECTION, gl_SPOT_EXPONENT, + gl_CLAMP_FRAGMENT_COLOR, gl_CLAMP_VERTEX_COLOR ) import Graphics.Rendering.OpenGL.Raw.Core31 -------------------------------------------------------------------------------- @@ -359,7 +364,7 @@ lightModelLocalViewer = makeLightModelCapVar GetLightModelLocalViewer LightModelLocalViewer -makeLightModelCapVar :: GetPName -> LightModelParameter -> StateVar Capability +makeLightModelCapVar :: PName1I -> LightModelParameter -> StateVar Capability makeLightModelCapVar pname lightModelParameter = makeStateVar (getBoolean1 unmarshalCapability pname) @@ -466,3 +471,50 @@ makeStateVar (getEnum1 unmarshalShadingModel GetShadeModel) (glShadeModel . marshalShadingModel) + +-------------------------------------------------------------------------------- + +data ClampTarget = + ClampVertexColor + | ClampFragmentColor + | ClampReadColor + +marshalClampTarget :: ClampTarget -> GLenum +marshalClampTarget x = case x of + ClampVertexColor -> gl_CLAMP_VERTEX_COLOR + ClampFragmentColor -> gl_CLAMP_FRAGMENT_COLOR + ClampReadColor -> gl_CLAMP_READ_COLOR + +marshalClampTargetToPName :: ClampTarget -> PName1I +marshalClampTargetToPName x = case x of + ClampFragmentColor -> GetFragmentColorClamp + ClampVertexColor -> GetVertexColorClamp + ClampReadColor -> GetReadColorClamp + + +-------------------------------------------------------------------------------- + +data ClampMode = + ClampOn + | FixedOnly + | ClampOff + +marshalClampMode :: ClampMode -> GLenum +marshalClampMode x = case x of + ClampOn -> gl_TRUE + FixedOnly -> gl_FIXED_ONLY + ClampOff -> gl_FALSE + +unmarshalClampMode :: GLenum -> ClampMode +unmarshalClampMode x + | x == gl_TRUE = ClampOn + | x == gl_FIXED_ONLY = FixedOnly + | x == gl_FALSE = ClampOff + | otherwise = error $ "unmarshalClampMode: unknown enum value " ++ show x + +-------------------------------------------------------------------------------- + +clampColor :: ClampTarget -> StateVar ClampMode +clampColor ct = makeStateVar (getClampColor ct) (setClampColor ct) + where setClampColor t = glClampColor (marshalClampTarget t) . marshalClampMode + getClampColor = getEnum1 unmarshalClampMode . marshalClampTargetToPName diff --git a/Graphics/Rendering/OpenGL/GL/CoordTrans.hs b/Graphics/Rendering/OpenGL/GL/CoordTrans.hs --- a/Graphics/Rendering/OpenGL/GL/CoordTrans.hs +++ b/Graphics/Rendering/OpenGL/GL/CoordTrans.hs @@ -13,6 +13,8 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE TypeSynonymInstances #-} + module Graphics.Rendering.OpenGL.GL.CoordTrans ( -- * Controlling the Viewport depthRange, @@ -147,7 +149,7 @@ Just i -> Modelview i Nothing -> error ("unmarshalMatrixMode: illegal value " ++ show x) -matrixModeToGetMatrix :: MatrixMode -> GetPName +matrixModeToGetMatrix :: MatrixMode -> PNameMatrix matrixModeToGetMatrix x = case x of Modelview _ -> GetModelviewMatrix -- ??? Projection -> GetProjectionMatrix @@ -155,7 +157,7 @@ Color -> GetColorMatrix MatrixPalette -> GetMatrixPalette -matrixModeToGetStackDepth :: MatrixMode -> GetPName +matrixModeToGetStackDepth :: MatrixMode -> PName1I matrixModeToGetStackDepth x = case x of Modelview _ -> GetModelviewStackDepth Projection -> GetProjectionStackDepth @@ -163,7 +165,7 @@ Color -> GetColorMatrixStackDepth MatrixPalette -> error "matrixModeToGetStackDepth: impossible" -matrixModeToGetMaxStackDepth :: MatrixMode -> GetPName +matrixModeToGetMaxStackDepth :: MatrixMode -> PName1I matrixModeToGetMaxStackDepth x = case x of Modelview _ -> GetMaxModelviewStackDepth Projection -> GetMaxProjectionStackDepth @@ -189,7 +191,7 @@ -------------------------------------------------------------------------------- class Storable c => MatrixComponent c where - getMatrix :: GetPName -> Ptr c -> IO () + getMatrix :: GetPNameMatrix p => p -> Ptr c -> IO () loadMatrix :: Ptr c -> IO () loadTransposeMatrix :: Ptr c -> IO () multMatrix_ :: Ptr c -> IO () @@ -199,7 +201,7 @@ scale :: c -> c -> c -> IO () instance MatrixComponent GLfloat where - getMatrix = getFloatv + getMatrix = getMatrixf loadMatrix = glLoadMatrixf loadTransposeMatrix = glLoadTransposeMatrixf multMatrix_ = glMultMatrixf @@ -209,7 +211,7 @@ scale = glScalef instance MatrixComponent GLdouble where - getMatrix = getDoublev + getMatrix = getMatrixd loadMatrix = glLoadMatrixd loadTransposeMatrix = glLoadTransposeMatrixd multMatrix_ = glMultMatrixd @@ -274,7 +276,7 @@ matrixMode $= mode act -getMatrix' :: (Matrix m, MatrixComponent c) => GetPName -> IO (m c) +getMatrix' :: (Matrix m, MatrixComponent c) => PNameMatrix -> IO (m c) getMatrix' = withNewMatrix ColumnMajor . getMatrix setMatrix :: (Matrix m, MatrixComponent c) => m c -> IO () diff --git a/Graphics/Rendering/OpenGL/GL/DataType.hs b/Graphics/Rendering/OpenGL/GL/DataType.hs --- a/Graphics/Rendering/OpenGL/GL/DataType.hs +++ b/Graphics/Rendering/OpenGL/GL/DataType.hs @@ -4,7 +4,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.DataType -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -14,7 +14,8 @@ -------------------------------------------------------------------------------- module Graphics.Rendering.OpenGL.GL.DataType ( - DataType(..), marshalDataType, unmarshalDataType + DataType(..), marshalDataType, unmarshalDataType, + DataTypeType(..), marshalDataTypeType, unmarshalDataTypeType ) where import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( @@ -130,3 +131,30 @@ | x == gl_3_BYTES = ThreeBytes | x == gl_4_BYTES = FourBytes | otherwise = error ("unmarshalDataType: illegal value " ++ show x) + +data DataTypeType + = TNone + | TSignedNormalized + | TUnsignedNormalized + | TFloat + | TInt + | TUnsignedInt + +marshalDataTypeType :: DataTypeType -> GLenum +marshalDataTypeType x = case x of + TNone -> gl_NONE + TSignedNormalized -> gl_SIGNED_NORMALIZED + TUnsignedNormalized -> gl_UNSIGNED_NORMALIZED + TFloat -> gl_FLOAT + TInt -> gl_INT + TUnsignedInt -> gl_UNSIGNED_INT + +unmarshalDataTypeType :: GLenum -> DataTypeType +unmarshalDataTypeType x + | x == gl_NONE = TNone + | x == gl_SIGNED_NORMALIZED = TSignedNormalized + | x == gl_UNSIGNED_NORMALIZED = TUnsignedNormalized + | x == gl_FLOAT = TFloat + | x == gl_INT = TInt + | x == gl_UNSIGNED_INT = TUnsignedInt + | otherwise = error $ "unmarshalDataTypeType: illegal value " ++ show x diff --git a/Graphics/Rendering/OpenGL/GL/Domain.hs b/Graphics/Rendering/OpenGL/GL/Domain.hs --- a/Graphics/Rendering/OpenGL/GL/Domain.hs +++ b/Graphics/Rendering/OpenGL/GL/Domain.hs @@ -4,7 +4,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Domain -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -13,6 +13,8 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE TypeSynonymInstances #-} + module Graphics.Rendering.OpenGL.GL.Domain ( Domain(..) ) where @@ -39,8 +41,8 @@ evalCoord2v :: Ptr d -> IO () glMapGrid1 :: GLint -> d -> d -> IO () glMapGrid2 :: GLint -> d -> d -> GLint -> d -> d -> IO () - get2 :: (d -> d -> a) -> GetPName -> IO a - get4 :: (d -> d -> d -> d -> a) -> GetPName -> IO a + get2 :: GetPName2F p => (d -> d -> a) -> p -> IO a + get4 :: GetPName4F p => (d -> d -> d -> d -> a) -> p -> IO a -------------------------------------------------------------------------------- diff --git a/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs b/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs --- a/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs +++ b/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs @@ -33,4 +33,4 @@ unmarshalEdgeFlag :: GLboolean -> EdgeFlag unmarshalEdgeFlag f = - if unmarshalGLboolean f then BeginsBoundaryEdge else BeginsBoundaryEdge + if unmarshalGLboolean f then BeginsBoundaryEdge else BeginsInteriorEdge diff --git a/Graphics/Rendering/OpenGL/GL/Evaluators.hs b/Graphics/Rendering/OpenGL/GL/Evaluators.hs --- a/Graphics/Rendering/OpenGL/GL/Evaluators.hs +++ b/Graphics/Rendering/OpenGL/GL/Evaluators.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE KindSignatures #-} -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.Evaluators @@ -166,7 +167,7 @@ -------------------------------------------------------------------------------- -data (ControlPoint c, Domain d) => GLmap1 c d = +data GLmap1 (c :: * -> *) d = GLmap1 (MapDescriptor d) (ForeignPtr d) deriving ( Eq, Ord, Show ) @@ -266,7 +267,7 @@ -------------------------------------------------------------------------------- -data (ControlPoint c, Domain d) => GLmap2 c d = +data GLmap2 (c :: * -> *) d = GLmap2 (MapDescriptor d) (MapDescriptor d) (ForeignPtr d) deriving ( Eq, Ord, Show ) diff --git a/Graphics/Rendering/OpenGL/GL/Exception.hs b/Graphics/Rendering/OpenGL/GL/Exception.hs --- a/Graphics/Rendering/OpenGL/GL/Exception.hs +++ b/Graphics/Rendering/OpenGL/GL/Exception.hs @@ -5,7 +5,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Exception -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable diff --git a/Graphics/Rendering/OpenGL/GL/Framebuffer.hs b/Graphics/Rendering/OpenGL/GL/Framebuffer.hs --- a/Graphics/Rendering/OpenGL/GL/Framebuffer.hs +++ b/Graphics/Rendering/OpenGL/GL/Framebuffer.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Framebuffer -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -19,10 +19,10 @@ rgbaBits, stencilBits, depthBits, accumBits, rgbaSignedComponents, -- * Selecting a Buffer for Writing - BufferMode(..), drawBuffer, drawBuffers, maxDrawBuffers, + DrawBufferIndex, BufferMode(..), drawBuffer, drawBuffers, drawBufferi, maxDrawBuffers, -- * Fine Control of Buffer Updates - indexMask, colorMask, stencilMask, stencilMaskSeparate, depthMask, + indexMask, colorMask, colorMaski, stencilMask, stencilMaskSeparate, depthMask, -- * Clearing the Buffers ClearBuffer(..), clear, @@ -103,7 +103,7 @@ -- | When colors are written to the framebuffer, they are written into the color -- buffers specified by 'drawBuffer'. --- +-- -- If more than one color buffer is selected for drawing, then blending or -- logical operations are computed and applied independently for each color -- buffer and can produce different results in each buffer. @@ -124,6 +124,8 @@ -------------------------------------------------------------------------------- +type DrawBufferIndex = GLuint + -- | '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 @@ -161,6 +163,14 @@ glDrawBuffers (genericLength ms) else recordInvalidValue +-- | '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) + + -------------------------------------------------------------------------------- -- | Contains the maximum number of buffers that can activated via 'drawBuffers' @@ -209,6 +219,18 @@ (unmarshalCapability a)) 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 :: DrawBufferIndex -> StateVar (Color4 Capability) +colorMaski x = 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)) diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs @@ -0,0 +1,35 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.FramebufferObjects ( + module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments, + module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects, + module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries, + module Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects, +) where + + +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments + hiding (getFBAParameteriv) +-- import FramebufferObjects, hiding the constructor for FramebufferObject +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects + hiding ( FramebufferObject, marshalFramebufferTarget ) +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects + (FramebufferObject) +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries +-- import RenderbufferObjects, hiding the constructor for RenderbufferObject +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects + hiding ( RenderbufferObject, marshalRenderbufferTarget, getRBParameteriv ) +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects + (RenderbufferObject) diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs @@ -0,0 +1,147 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments ( + FramebufferObjectAttachment(..), + + fboaToBufferMode, fboaFromBufferMode, + + maxColorAttachments, + + FramebufferAttachment(..), + + framebufferRenderbuffer, framebufferTexture1D, framebufferTexture2D, + framebufferTexture3D, framebufferTextureLayer, + + getFBAParameteriv, +) where + +import Data.Maybe (fromMaybe) +import Foreign.Marshal +import Graphics.Rendering.OpenGL.Raw.Core31 +import Graphics.Rendering.OpenGL.GLU.ErrorsInternal + +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects + +import Graphics.Rendering.OpenGL.GL.BufferMode +import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.GL.Texturing.Objects +import Graphics.Rendering.OpenGL.GL.Texturing.Specification +import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget +----------------------------------------------------------------------------- + +data FramebufferObjectAttachment = + ColorAttachment !GLuint + | DepthAttachment + | StencilAttachment + | DepthStencilAttachment + deriving (Eq, Show) + +marshalFramebufferObjectAttachment :: FramebufferObjectAttachment -> Maybe GLenum +marshalFramebufferObjectAttachment x = case x of + ColorAttachment c -> let ec = fromIntegral c in if ec >= maxColorAttachments + then Nothing + else Just $ gl_COLOR_ATTACHMENT0 + ec + DepthAttachment -> Just gl_DEPTH_ATTACHMENT + StencilAttachment -> Just gl_STENCIL_ATTACHMENT + DepthStencilAttachment -> Just gl_DEPTH_STENCIL_ATTACHMENT + +fboaToBufferMode :: FramebufferObjectAttachment -> Maybe BufferMode +fboaToBufferMode (ColorAttachment i) = Just . FBOColorAttachment $ fromIntegral i +fboaToBufferMode _ = Nothing + +fboaFromBufferMode :: BufferMode -> Maybe FramebufferObjectAttachment +fboaFromBufferMode (FBOColorAttachment i) = Just . ColorAttachment $ fromIntegral i +fboaFromBufferMode _ = Nothing + +unmarshalFramebufferObjectAttachment :: GLenum -> FramebufferObjectAttachment +unmarshalFramebufferObjectAttachment x = maybe + (error $ "unmarshalFramebufferObjectAttachment: unknown enum value " ++ show x) id $ + unmarshalFramebufferObjectAttachmentSafe x +--unmarshalFramebufferObjectAttachment x +-- | x == gl_DEPTH_ATTACHMENT = DepthAttachment +-- | x == gl_STENCIL_ATTACHMENT = StencilAttachment +-- | x == gl_DEPTH_STENCIL_ATTACHMENT = DepthStencilAttachment +-- | x >= gl_COLOR_ATTACHMENT0 && x <= gl_COLOR_ATTACHMENT15 +-- = ColorAttachment . fromIntegral $ x - gl_COLOR_ATTACHMENT0 +-- | otherwise = error $ "unmarshalFramebufferObjectAttachment: unknown enum value " ++ show x + +unmarshalFramebufferObjectAttachmentSafe :: GLenum -> Maybe FramebufferObjectAttachment +unmarshalFramebufferObjectAttachmentSafe x + | x == gl_DEPTH_ATTACHMENT = Just DepthAttachment + | x == gl_STENCIL_ATTACHMENT = Just StencilAttachment + | x == gl_DEPTH_STENCIL_ATTACHMENT = Just DepthStencilAttachment + | x >= gl_COLOR_ATTACHMENT0 && x <= gl_COLOR_ATTACHMENT0 + maxColorAttachments + = Just . ColorAttachment . fromIntegral $ x - gl_COLOR_ATTACHMENT0 + | otherwise = Nothing + +----------------------------------------------------------------------------- + +class Show a => FramebufferAttachment a where + marshalAttachment :: a -> Maybe GLenum + unmarshalAttachment :: GLenum -> a + unmarshalAttachmentSafe :: GLenum -> Maybe a +instance FramebufferAttachment FramebufferObjectAttachment where + marshalAttachment = marshalFramebufferObjectAttachment + unmarshalAttachment = unmarshalFramebufferObjectAttachment + unmarshalAttachmentSafe = unmarshalFramebufferObjectAttachmentSafe +instance FramebufferAttachment BufferMode where + marshalAttachment = marshalBufferMode + unmarshalAttachment = unmarshalBufferMode + unmarshalAttachmentSafe = unmarshalBufferModeSafe + +----------------------------------------------------------------------------- + +framebufferRenderbuffer :: FramebufferTarget -> FramebufferObjectAttachment + -> RenderbufferTarget -> RenderbufferObject -> IO () +framebufferRenderbuffer fbt fba rbt (RenderbufferObject rboi) = + maybe recordInvalidValue (\mfba -> glFramebufferRenderbuffer (marshalFramebufferTarget fbt) + mfba (marshalRenderbufferTarget rbt) rboi) $ marshalFramebufferObjectAttachment fba + +framebufferTexture1D :: FramebufferTarget -> FramebufferObjectAttachment + -> TextureObject -> Level -> IO () +framebufferTexture1D fbt fba (TextureObject t) l = maybe recordInvalidValue + (\mfba -> glFramebufferTexture1D (marshalFramebufferTarget fbt) mfba + (marshalTextureTarget Texture1D) t l) $ marshalFramebufferObjectAttachment fba + +framebufferTexture2D :: FramebufferTarget -> FramebufferObjectAttachment + -> Maybe CubeMapTarget-> TextureObject -> Level -> IO () +framebufferTexture2D fbt fba mcmt (TextureObject t) l = maybe recordInvalidValue + (\mfba -> glFramebufferTexture2D (marshalFramebufferTarget fbt) mfba + (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mcmt) t l) + $ marshalFramebufferObjectAttachment fba + +framebufferTexture3D :: FramebufferTarget -> FramebufferObjectAttachment + -> TextureObject -> Level -> GLint -> IO () +framebufferTexture3D fbt fba (TextureObject t) le la = maybe recordInvalidValue + (\mfba -> glFramebufferTexture3D (marshalFramebufferTarget fbt) mfba + (marshalTextureTarget Texture1D) t le la) $ marshalFramebufferObjectAttachment fba + +framebufferTextureLayer :: FramebufferTarget -> FramebufferObjectAttachment + -> TextureObject -> Level -> GLint -> IO() +framebufferTextureLayer fbt fba (TextureObject t) le la = maybe recordInvalidValue + (\mfba -> glFramebufferTextureLayer (marshalFramebufferTarget fbt) + mfba t le la) $ marshalFramebufferObjectAttachment fba + + +----------------------------------------------------------------------------- + +getFBAParameteriv :: FramebufferAttachment fba => FramebufferTarget -> fba + -> (GLint -> a) -> GLenum -> IO a +getFBAParameteriv fbt fba f p = alloca $ \buf -> do + glGetFramebufferAttachmentParameteriv (marshalFramebufferTarget fbt) + mfba p buf + peek1 f buf + where mfba = fromMaybe (error $ "invalid value" ++ show fba) (marshalAttachment fba) diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs @@ -0,0 +1,111 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects ( + FramebufferObject(FramebufferObject), + defaultFramebufferObject, + FramebufferTarget(..), marshalFramebufferTarget, + + bindFramebuffer, + + FramebufferStatus(..), framebufferStatus, +) where + +import Data.ObjectName +import Data.StateVar +import Foreign.Marshal +import Graphics.Rendering.OpenGL.Raw.Core31 + +import Graphics.Rendering.OpenGL.GL.GLboolean +import Graphics.Rendering.OpenGL.GL.QueryUtils + + +----------------------------------------------------------------------------- + +data FramebufferObject = FramebufferObject{ fbufferID :: GLuint } + +instance ObjectName FramebufferObject where + genObjectNames n = + allocaArray n $ \buf -> do + glGenFramebuffers (fromIntegral n) buf + fmap (map FramebufferObject) $ peekArray n buf + deleteObjectNames objs = withArrayLen (map fbufferID objs) $ + glDeleteFramebuffers . fromIntegral + isObjectName = fmap unmarshalGLboolean . glIsFramebuffer . fbufferID + +defaultFramebufferObject :: FramebufferObject +defaultFramebufferObject = FramebufferObject 0 + +----------------------------------------------------------------------------- + +data FramebufferTarget = + DrawFramebuffer + | ReadFramebuffer + | Framebuffer + +marshalFramebufferTarget :: FramebufferTarget -> GLenum +marshalFramebufferTarget xs = case xs of + DrawFramebuffer -> gl_DRAW_FRAMEBUFFER + ReadFramebuffer -> gl_READ_FRAMEBUFFER + Framebuffer -> gl_FRAMEBUFFER + +marshalFramebufferTargetBinding :: FramebufferTarget -> PName1I +marshalFramebufferTargetBinding x = case x of + DrawFramebuffer -> GetDrawFramebufferBinding + ReadFramebuffer -> GetReadFramebufferBinding + Framebuffer -> GetFramebufferBinding + +----------------------------------------------------------------------------- + +bindFramebuffer :: FramebufferTarget -> StateVar FramebufferObject +bindFramebuffer fbt = + makeStateVar (getBoundFramebuffer fbt) (setFramebuffer fbt) + +getBoundFramebuffer :: FramebufferTarget -> IO FramebufferObject +getBoundFramebuffer = getInteger1 (FramebufferObject . fromIntegral) + . marshalFramebufferTargetBinding + +setFramebuffer :: FramebufferTarget -> FramebufferObject -> IO () +setFramebuffer fbt = glBindFramebuffer (marshalFramebufferTarget fbt) . fbufferID + +----------------------------------------------------------------------------- + +data FramebufferStatus = + Complete + | Undefined + | IncompleteMissingAttachment + | IncompleteDrawBuffer + | IncompleteReadBuffer + | IncompleteMultiSample + | Unsupported + +unmarshalFramebufferStatus :: GLenum -> FramebufferStatus +unmarshalFramebufferStatus x + | x == gl_FRAMEBUFFER_COMPLETE = Complete + | x == gl_FRAMEBUFFER_UNDEFINED = Undefined + | x == gl_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT + = IncompleteMissingAttachment + | x == gl_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER = IncompleteDrawBuffer + | x == gl_FRAMEBUFFER_INCOMPLETE_READ_BUFFER = IncompleteReadBuffer + | x == gl_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE = IncompleteMultiSample + | x == gl_FRAMEBUFFER_UNSUPPORTED = Unsupported + | otherwise = error $ "unmarshalFramebufferStatus: unknown value: " + ++ show x +----------------------------------------------------------------------------- + +framebufferStatus :: FramebufferTarget -> GettableStateVar FramebufferStatus +framebufferStatus t = makeGettableStateVar $ fmap unmarshalFramebufferStatus + . glCheckFramebufferStatus . marshalFramebufferTarget $ t + +----------------------------------------------------------------------------- diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs @@ -0,0 +1,235 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries ( + AttachmentObjectType(..), attachmentObjectType, attachmentObject, + attachmentTextureLayer, attachmentTextureLevel, + attachmentTextureCubeMapTarget, + + attachmentRedSize, attachmentBlueSize, attachmentGreenSize, + attachmentAlphaSize, attachmentDepthSize, attachmentStencilSize, + + renderbufferWidth, renderbufferHeight, + renderbufferInternalFormat, renderbufferSamples, + + renderbufferRedSize, renderbufferBlueSize, renderbufferGreenSize, + renderbufferAlphaSize, renderbufferDepthSize, renderbufferStencilSize, +) where + +import Data.StateVar +import Graphics.Rendering.OpenGL.Raw.Core31 + +import Graphics.Rendering.OpenGL.GL.Texturing.Objects(TextureObject(..)) +import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat +import Graphics.Rendering.OpenGL.GL.Texturing.Specification(Level) +import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget + +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments + + +----------------------------------------------------------------------------- + +data GetFramebufferAttachmentPName = + AttachmentObjectType + | AttachmentObjectName + | AttachmentTextureLevel + | AttachmentTextureCubeMapFace + | AttachmentTextureLayer + | AttachmentComponentType + | AttachmentColorEncoding + | AttachmentRedSize + | AttachmentBlueSize + | AttachmentGreenSize + | AttachmentAlphaSize + | AttachmentDepthSize + | AttachmentStencilSize + +marshalGetFBAPName :: GetFramebufferAttachmentPName -> GLenum +marshalGetFBAPName x = case x of + AttachmentObjectType -> gl_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE + AttachmentObjectName -> gl_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME + AttachmentTextureLevel -> gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL + AttachmentTextureCubeMapFace -> gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE + AttachmentTextureLayer -> gl_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER + AttachmentComponentType -> gl_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE -- TODO impement usefull function + AttachmentColorEncoding -> gl_FRAMEBUFFER_ATTACHMENT_COLOR_ENCODING -- TODO impement usefull function + AttachmentRedSize -> gl_FRAMEBUFFER_ATTACHMENT_RED_SIZE + AttachmentBlueSize -> gl_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE + AttachmentGreenSize -> gl_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE + AttachmentAlphaSize -> gl_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE + AttachmentDepthSize -> gl_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE + AttachmentStencilSize -> gl_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE + +getFBAPName :: FramebufferAttachment fba => FramebufferTarget -> fba + -> (GLint -> a) -> GetFramebufferAttachmentPName -> IO a +getFBAPName fbt fba f p = getFBAParameteriv fbt fba f (marshalGetFBAPName p) + +----------------------------------------------------------------------------- + +data AttachmentObjectType = + DefaultFramebufferAttachment + | TextureAttachment + | RenderbufferAttachment + +unmarshalAttachmentObjectType :: GLenum -> Maybe AttachmentObjectType +unmarshalAttachmentObjectType x + | x == gl_FRAMEBUFFER_DEFAULT = Just DefaultFramebufferAttachment + | x == gl_TEXTURE = Just TextureAttachment + | x == gl_RENDERBUFFER = Just RenderbufferAttachment + | x == gl_NONE = Nothing + | otherwise = error $ "unmarshalAttachmentObject: unknown value " ++ show x + +attachmentObjectType :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar (Maybe AttachmentObjectType) +attachmentObjectType fbt fba = makeGettableStateVar $ getFBAPName fbt fba + (unmarshalAttachmentObjectType . fromIntegral) AttachmentObjectType + +-- | tries to retrieve the object that is bound to the attachment point of the +-- given framebuffertarget. If the object type of it is None or the default, then +-- `Nothing` is returned, otherwise the bound `RenderbufferObject` or `TextureObject` +attachmentObject :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar (Maybe (Either RenderbufferObject TextureObject)) +attachmentObject fbt fba = makeGettableStateVar getter + where getter = do + objT <- get $ attachmentObjectType fbt fba + case objT of + Nothing -> return $ Nothing + (Just DefaultFramebufferAttachment) -> return $ Nothing + (Just TextureAttachment) -> getObjectName (Right . TextureObject) + (Just RenderbufferAttachment) -> getObjectName (Left . RenderbufferObject) + getObjectName :: Num n => (n -> Either RenderbufferObject TextureObject) -> IO (Maybe (Either RenderbufferObject TextureObject)) + getObjectName con = getFBAPName fbt fba (Just . con . fromIntegral) AttachmentObjectName + +attachmentTextureLayer :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar GLint +attachmentTextureLayer fbt fba = makeGettableStateVar $ + getFBAPName fbt fba id AttachmentTextureLayer + +attachmentTextureLevel :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar Level +attachmentTextureLevel fbt fba = makeGettableStateVar $ + getFBAPName fbt fba id AttachmentTextureLevel + +attachmentTextureCubeMapTarget :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar CubeMapTarget +attachmentTextureCubeMapTarget fbt fba = makeGettableStateVar $ + getFBAPName fbt fba (unmarshalCubeMapTarget . fromIntegral) AttachmentTextureLevel + +----------------------------------------------------------------------------- + +attachmentRedSize :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar GLint +attachmentRedSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba + id AttachmentRedSize + +attachmentGreenSize :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar GLint +attachmentGreenSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba + id AttachmentGreenSize + +attachmentBlueSize :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar GLint +attachmentBlueSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba + id AttachmentBlueSize + +attachmentAlphaSize :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar GLint +attachmentAlphaSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba + id AttachmentAlphaSize + +attachmentDepthSize :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar GLint +attachmentDepthSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba + id AttachmentDepthSize + +attachmentStencilSize :: FramebufferAttachment fba => FramebufferTarget -> fba + -> GettableStateVar GLint +attachmentStencilSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba + id AttachmentStencilSize + +----------------------------------------------------------------------------- + +data GetRenderbufferPName = + RenderbufferWidth + | RenderbufferHeight + | RenderbufferInternalFormat + | RenderbufferSamples + | RenderbufferRedSize + | RenderbufferBlueSize + | RenderbufferGreenSize + | RenderbufferAlphaSize + | RenderbufferDepthSize + | RenderbufferStencilSize + +marshalGetRBPname :: GetRenderbufferPName -> GLenum +marshalGetRBPname x = case x of + RenderbufferWidth -> gl_RENDERBUFFER_WIDTH + RenderbufferHeight -> gl_RENDERBUFFER_HEIGHT + RenderbufferInternalFormat -> gl_RENDERBUFFER_INTERNAL_FORMAT + RenderbufferSamples -> gl_RENDERBUFFER_SAMPLES + RenderbufferRedSize -> gl_RENDERBUFFER_RED_SIZE + RenderbufferBlueSize -> gl_RENDERBUFFER_BLUE_SIZE + RenderbufferGreenSize -> gl_RENDERBUFFER_GREEN_SIZE + RenderbufferAlphaSize -> gl_RENDERBUFFER_ALPHA_SIZE + RenderbufferDepthSize -> gl_RENDERBUFFER_DEPTH_SIZE + RenderbufferStencilSize -> gl_RENDERBUFFER_STENCIL_SIZE + +getRBPName :: RenderbufferTarget -> (GLint -> a) -> + GetRenderbufferPName -> IO a +getRBPName rbt f = getRBParameteriv rbt f . marshalGetRBPname + +----------------------------------------------------------------------------- + +renderbufferWidth :: RenderbufferTarget -> GettableStateVar GLsizei +renderbufferWidth rbt = makeGettableStateVar $ + getRBPName rbt fromIntegral RenderbufferWidth + +renderbufferHeight :: RenderbufferTarget -> GettableStateVar GLsizei +renderbufferHeight rbt = makeGettableStateVar $ + getRBPName rbt fromIntegral RenderbufferHeight + +renderbufferInternalFormat :: RenderbufferTarget + -> GettableStateVar PixelInternalFormat +renderbufferInternalFormat rbt = makeGettableStateVar $ + getRBPName rbt unmarshalPixelInternalFormat RenderbufferInternalFormat + +renderbufferSamples :: RenderbufferTarget -> GettableStateVar Samples +renderbufferSamples rbt = makeGettableStateVar $ + getRBPName rbt (Samples . fromIntegral) RenderbufferSamples + +renderbufferRedSize :: RenderbufferTarget -> GettableStateVar GLint +renderbufferRedSize rbt = makeGettableStateVar $ + getRBPName rbt id RenderbufferRedSize + +renderbufferGreenSize :: RenderbufferTarget -> GettableStateVar GLint +renderbufferGreenSize rbt = makeGettableStateVar $ + getRBPName rbt id RenderbufferGreenSize + +renderbufferBlueSize :: RenderbufferTarget -> GettableStateVar GLint +renderbufferBlueSize rbt = makeGettableStateVar $ + getRBPName rbt id RenderbufferBlueSize + +renderbufferAlphaSize :: RenderbufferTarget -> GettableStateVar GLint +renderbufferAlphaSize rbt = makeGettableStateVar $ + getRBPName rbt id RenderbufferAlphaSize + +renderbufferDepthSize :: RenderbufferTarget -> GettableStateVar GLint +renderbufferDepthSize rbt = makeGettableStateVar $ + getRBPName rbt id RenderbufferDepthSize + +renderbufferStencilSize :: RenderbufferTarget -> GettableStateVar GLint +renderbufferStencilSize rbt = makeGettableStateVar $ + getRBPName rbt id RenderbufferStencilSize diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs @@ -0,0 +1,107 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.RendebufferObjects +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects ( + RenderbufferObject(RenderbufferObject), + noRenderbufferObject, + RenderbufferTarget(..), marshalRenderbufferTarget, + RenderbufferSize(..), Samples(..), + + bindRenderbuffer, + + renderbufferStorage, renderbufferStorageMultiSample, + + getRBParameteriv, +) where + +import Data.ObjectName +import Data.StateVar +import Foreign.Marshal +import Graphics.Rendering.OpenGL.Raw.Core31 + +import Graphics.Rendering.OpenGL.GL.GLboolean +import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.GL.QueryUtils +import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat + +----------------------------------------------------------------------------- + +data RenderbufferObject = RenderbufferObject{ rbufferID :: GLuint} + +instance ObjectName RenderbufferObject where + genObjectNames n = + allocaArray n $ \buf -> do + glGenRenderbuffers (fromIntegral n) buf + fmap (map RenderbufferObject) $ peekArray n buf + deleteObjectNames objs = withArrayLen (map rbufferID objs) $ + glDeleteRenderbuffers . fromIntegral + isObjectName = fmap unmarshalGLboolean . glIsRenderbuffer . rbufferID + +noRenderbufferObject :: RenderbufferObject +noRenderbufferObject = RenderbufferObject 0 + +----------------------------------------------------------------------------- + +data RenderbufferTarget = + Renderbuffer + +marshalRenderbufferTarget :: RenderbufferTarget -> GLenum +marshalRenderbufferTarget x = case x of + Renderbuffer -> gl_RENDERBUFFER + +marshalRenderbufferTargetBinding :: RenderbufferTarget -> PName1I +marshalRenderbufferTargetBinding x = case x of + Renderbuffer -> GetRenderbufferBinding +----------------------------------------------------------------------------- + +data RenderbufferSize = RenderbufferSize !GLsizei !GLsizei + +newtype Samples = Samples GLsizei + +----------------------------------------------------------------------------- + +bindRenderbuffer :: RenderbufferTarget -> StateVar RenderbufferObject +bindRenderbuffer rbt = + makeStateVar (getBoundRenderbuffer rbt) (setRenderbuffer rbt) + +getBoundRenderbuffer :: RenderbufferTarget -> IO RenderbufferObject +getBoundRenderbuffer = getInteger1 (RenderbufferObject . fromIntegral) + . marshalRenderbufferTargetBinding + +setRenderbuffer :: RenderbufferTarget -> RenderbufferObject -> IO () +setRenderbuffer rbt = glBindRenderbuffer (marshalRenderbufferTarget rbt) + . rbufferID + +----------------------------------------------------------------------------- + +renderbufferStorageMultiSample :: RenderbufferTarget -> Samples + -> PixelInternalFormat -> RenderbufferSize -> IO () +renderbufferStorageMultiSample rbt (Samples s) pif (RenderbufferSize w h) = + glRenderbufferStorageMultisample (marshalRenderbufferTarget rbt) s + (marshalPixelInternalFormat' pif) w h + + +renderbufferStorage :: RenderbufferTarget -> PixelInternalFormat + -> RenderbufferSize -> IO () +renderbufferStorage rbt pif (RenderbufferSize w h) = + glRenderbufferStorage (marshalRenderbufferTarget rbt) + (marshalPixelInternalFormat' pif) w h + +----------------------------------------------------------------------------- + +getRBParameteriv :: RenderbufferTarget -> (GLint -> a) -> GLenum -> IO a +getRBParameteriv rbt f p = alloca $ \buf -> do + glGetRenderbufferParameteriv (marshalRenderbufferTarget rbt) + p buf + peek1 f buf diff --git a/Graphics/Rendering/OpenGL/GL/GLstring.hs b/Graphics/Rendering/OpenGL/GL/GLstring.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/GLstring.hs @@ -0,0 +1,50 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.GLstring +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.GLstring ( + peekGLstringLen, withGLStringLen, withGLString, + stringQuery +) where + +import Data.StateVar +import Foreign.C.String +import Foreign.Marshal.Array +import Foreign.Ptr + +import Graphics.Rendering.OpenGL.Raw.Core31 + +----------------------------------------------------------------------------- + +type GLStringLen = (Ptr GLchar, GLsizei) + +peekGLstringLen :: GLStringLen -> IO String +peekGLstringLen (p,l) = peekCAStringLen (castPtr p, fromIntegral l) + +withGLStringLen :: String -> (GLStringLen -> IO a) -> IO a +withGLStringLen s act = + withCAStringLen s $ \(p,len) -> + act (castPtr p, fromIntegral len) + +withGLString :: String -> (Ptr GLchar -> IO a) -> IO a +withGLString s act = withCAString s $ act . castPtr + +stringQuery :: GettableStateVar GLsizei -> (GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()) -> GettableStateVar String +stringQuery lengthVar getStr = + makeGettableStateVar $ do + len <- get lengthVar -- Note: This includes the NUL character! + if len == 0 + then return "" + else allocaArray (fromIntegral len) $ \buf -> do + getStr len nullPtr buf + peekGLstringLen (buf, len-1) diff --git a/Graphics/Rendering/OpenGL/GL/Hints.hs b/Graphics/Rendering/OpenGL/GL/Hints.hs --- a/Graphics/Rendering/OpenGL/GL/Hints.hs +++ b/Graphics/Rendering/OpenGL/GL/Hints.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Hints -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -51,7 +51,7 @@ PackCMYK -> gl_PACK_CMYK_HINT UnpackCMYK -> gl_UNPACK_CMYK_HINT -hintTargetToGetPName :: HintTarget -> GetPName +hintTargetToGetPName :: HintTarget -> PName1I hintTargetToGetPName x = case x of PerspectiveCorrection -> GetPerspectiveCorrectionHint PointSmooth -> GetPointSmoothHint diff --git a/Graphics/Rendering/OpenGL/GL/IOState.hs b/Graphics/Rendering/OpenGL/GL/IOState.hs --- a/Graphics/Rendering/OpenGL/GL/IOState.hs +++ b/Graphics/Rendering/OpenGL/GL/IOState.hs @@ -18,6 +18,8 @@ IOState(..), getIOState, peekIOState, evalIOState, nTimes ) where +import Control.Monad(replicateM) + import Foreign.Ptr ( Ptr, plusPtr ) import Foreign.Storable ( Storable(sizeOf,peek) ) @@ -53,4 +55,4 @@ evalIOState m s = do (a, _) <- runIOState m s ; return a nTimes :: Integral a => a -> IOState b c -> IOState b [c] -nTimes n = sequence . replicate (fromIntegral n) +nTimes n = replicateM (fromIntegral n) diff --git a/Graphics/Rendering/OpenGL/GL/PerFragment.hs b/Graphics/Rendering/OpenGL/GL/PerFragment.hs --- a/Graphics/Rendering/OpenGL/GL/PerFragment.hs +++ b/Graphics/Rendering/OpenGL/GL/PerFragment.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.PerFragment -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -33,36 +33,30 @@ -- * Depth Buffer Test depthFunc, - -- * Occlusion Queries - QueryObject(QueryObject), QueryTarget(..), withQuery, - beginQuery, endQuery, - queryCounterBits, currentQuery, - queryResult, queryResultAvailable, - -- * Blending - blend, BlendEquation(..), blendEquation, blendEquationSeparate, + blend, blendBuffer, BlendEquation(..), blendEquation, blendEquationSeparate, BlendingFactor(..), blendFuncSeparate, blendFunc, blendColor, -- * Dithering dither, -- * Logical Operation - LogicOp(..), logicOp + LogicOp(..), logicOp, + + -- * for backward compatibility reasons + module Graphics.Rendering.OpenGL.GL.QueryObjects ) where import Control.Monad -import Data.ObjectName import Data.StateVar -import Foreign.Marshal.Alloc -import Foreign.Marshal.Array import Graphics.Rendering.OpenGL.GL.BlendingFactor import Graphics.Rendering.OpenGL.GL.Capability import Graphics.Rendering.OpenGL.GL.ComparisonFunction import Graphics.Rendering.OpenGL.GL.CoordTrans -import Graphics.Rendering.OpenGL.GL.Exception import Graphics.Rendering.OpenGL.GL.Face +import Graphics.Rendering.OpenGL.GL.Framebuffer import Graphics.Rendering.OpenGL.GL.GLboolean -import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.GL.QueryObjects import Graphics.Rendering.OpenGL.GL.QueryUtils import Graphics.Rendering.OpenGL.GL.VertexSpec import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( @@ -213,106 +207,13 @@ -------------------------------------------------------------------------------- -newtype QueryObject = QueryObject { queryID :: GLuint } - deriving ( Eq, Ord, Show ) - --------------------------------------------------------------------------------- - -instance ObjectName QueryObject where - genObjectNames n = - allocaArray n $ \buf -> do - glGenQueries (fromIntegral n) buf - fmap (map QueryObject) $ peekArray n buf - - deleteObjectNames queryObjects = - withArrayLen (map queryID queryObjects) $ - glDeleteQueries . fromIntegral - - isObjectName = fmap unmarshalGLboolean . glIsQuery . queryID - --------------------------------------------------------------------------------- - -data QueryTarget = - SamplesPassed - deriving ( Eq, Ord, Show ) - -marshalQueryTarget :: QueryTarget -> GLenum -marshalQueryTarget x = case x of - SamplesPassed -> gl_SAMPLES_PASSED - --------------------------------------------------------------------------------- - -beginQuery :: QueryTarget -> QueryObject -> IO () -beginQuery t = glBeginQuery (marshalQueryTarget t) . queryID - -endQuery :: QueryTarget -> IO () -endQuery = glEndQuery . marshalQueryTarget - --- | Convenience function for an exception-safe combination of 'beginQuery' and --- 'endQuery'. -withQuery :: QueryTarget -> QueryObject -> IO a -> IO a -withQuery t q = bracket_ (beginQuery t q) (endQuery t) - --------------------------------------------------------------------------------- - -data GetQueryPName = - QueryCounterBits - | CurrentQuery - -marshalGetQueryPName :: GetQueryPName -> GLenum -marshalGetQueryPName x = case x of - QueryCounterBits -> gl_QUERY_COUNTER_BITS - CurrentQuery -> gl_CURRENT_QUERY - --------------------------------------------------------------------------------- - -queryCounterBits :: QueryTarget -> GettableStateVar GLsizei -queryCounterBits = getQueryi fromIntegral QueryCounterBits - -currentQuery :: QueryTarget -> GettableStateVar (Maybe QueryObject) -currentQuery = - getQueryi - (\q -> if q == 0 then Nothing else Just (QueryObject (fromIntegral q))) - CurrentQuery - -getQueryi :: (GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a -getQueryi f p t = - makeGettableStateVar $ - alloca $ \buf -> do - glGetQueryiv (marshalQueryTarget t) (marshalGetQueryPName p) buf - peek1 f buf - --------------------------------------------------------------------------------- - -data GetQueryObjectPName = - QueryResult - | QueryResultAvailable - -marshalGetQueryObjectPName :: GetQueryObjectPName -> GLenum -marshalGetQueryObjectPName x = case x of - QueryResult -> gl_QUERY_RESULT - QueryResultAvailable -> gl_QUERY_RESULT_AVAILABLE - --------------------------------------------------------------------------------- - -queryResult :: QueryObject -> GettableStateVar GLuint -queryResult = getQueryObjectui id QueryResult - -queryResultAvailable :: QueryObject -> GettableStateVar Bool -queryResultAvailable = getQueryObjectui unmarshalGLboolean QueryResultAvailable - -getQueryObjectui :: - (GLuint -> a) -> GetQueryObjectPName -> QueryObject -> GettableStateVar a -getQueryObjectui f p q = - makeGettableStateVar $ - alloca $ \buf -> do - glGetQueryObjectuiv (queryID q) (marshalGetQueryObjectPName p) buf - peek1 f buf - --------------------------------------------------------------------------------- - blend :: StateVar Capability blend = makeCapability CapBlend + +-- | enable or disable blending based on the buffer bound to the /i/'th drawBuffer +-- that is the buffer fmap (!! i) (get drawBuffers) +blendBuffer :: DrawBufferIndex -> StateVar Capability +blendBuffer = makeIndexedCapability ((fromIntegral gl_DRAW_BUFFER0) +) BlendI -------------------------------------------------------------------------------- diff --git a/Graphics/Rendering/OpenGL/GL/PixelFormat.hs b/Graphics/Rendering/OpenGL/GL/PixelFormat.hs --- a/Graphics/Rendering/OpenGL/GL/PixelFormat.hs +++ b/Graphics/Rendering/OpenGL/GL/PixelFormat.hs @@ -4,7 +4,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.PixelFormat -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -18,7 +18,7 @@ ) where import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( - gl_COLOR_INDEX, gl_LUMINANCE, gl_LUMINANCE_ALPHA ) + gl_COLOR_INDEX, gl_LUMINANCE, gl_LUMINANCE_ALPHA, gl_ALPHA_INTEGER ) import Graphics.Rendering.OpenGL.Raw.Core31 import Graphics.Rendering.OpenGL.Raw.EXT.Abgr ( gl_ABGR ) import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka ( gl_CMYK, gl_CMYKA ) @@ -31,14 +31,25 @@ ColorIndex | StencilIndex | DepthComponent + | DepthStencil | Red | Green | Blue | Alpha + | RG | RGB | RGBA | Luminance | LuminanceAlpha + | RedInteger + | GreenInteger + | BlueInteger + | AlphaInteger + | RGInteger + | RGBInteger + | RGBAInteger + | BGRInteger + | BGRAInteger | ABGR | BGR | BGRA @@ -49,7 +60,6 @@ | FourTwoTwoAverage | FourTwoTwoRevAverage | YCBCR422 - | DepthStencil deriving ( Eq, Ord, Show ) marshalPixelFormat :: PixelFormat -> GLenum @@ -61,10 +71,20 @@ Green -> gl_GREEN Blue -> gl_BLUE Alpha -> gl_ALPHA + RG -> gl_RG RGB -> gl_RGB RGBA -> gl_RGBA Luminance -> gl_LUMINANCE LuminanceAlpha -> gl_LUMINANCE_ALPHA + RedInteger -> gl_RED_INTEGER + GreenInteger -> gl_GREEN_INTEGER + BlueInteger -> gl_BLUE_INTEGER + AlphaInteger -> gl_ALPHA_INTEGER + RGInteger -> gl_RG_INTEGER + RGBInteger -> gl_RGB_INTEGER + RGBAInteger -> gl_RGBA_INTEGER + BGRInteger -> gl_BGR_INTEGER + BGRAInteger -> gl_BGRA_INTEGER ABGR -> gl_ABGR BGR -> gl_BGR BGRA -> gl_BGRA @@ -87,10 +107,20 @@ | x == gl_GREEN = Green | x == gl_BLUE = Blue | x == gl_ALPHA = Alpha + | x == gl_RG = RG | x == gl_RGB = RGB | x == gl_RGBA = RGBA | x == gl_LUMINANCE = Luminance | x == gl_LUMINANCE_ALPHA = LuminanceAlpha + | x == gl_RED_INTEGER = RedInteger + | x == gl_GREEN_INTEGER = GreenInteger + | x == gl_BLUE_INTEGER = BlueInteger + | x == gl_ALPHA_INTEGER = AlphaInteger + | x == gl_RG_INTEGER = RGInteger + | x == gl_RGB_INTEGER = RGBInteger + | x == gl_RGBA_INTEGER = RGBAInteger + | x == gl_BGR_INTEGER = BGRInteger + | x == gl_BGRA_INTEGER = BGRAInteger | x == gl_ABGR = ABGR | x == gl_BGR = BGR | x == gl_BGRA = BGRA diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs --- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs +++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -13,6 +13,8 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE TypeSynonymInstances #-} + module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap ( PixelMapTarget(..), PixelMapComponent, PixelMap(..), GLpixelmap, maxPixelMapTable, pixelMap, pixelMapIToRGBA, pixelMapRGBAToRGBA, @@ -61,7 +63,7 @@ BToB -> gl_PIXEL_MAP_B_TO_B AToA -> gl_PIXEL_MAP_A_TO_A -pixelMapTargetToGetPName :: PixelMapTarget -> GetPName +pixelMapTargetToGetPName :: PixelMapTarget -> PName1I pixelMapTargetToGetPName x = case x of IToI -> GetPixelMapIToISize SToS -> GetPixelMapSToSSize diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs --- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs +++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -105,13 +105,13 @@ -------------------------------------------------------------------------------- -pixelStoreb :: GetPName -> PixelStore -> StateVar Bool +pixelStoreb :: PName1I -> PixelStore -> StateVar Bool pixelStoreb pn ps = makeStateVar (getBoolean1 unmarshalGLboolean pn) (glPixelStorei (marshalPixelStore ps) . marshalGLboolean) -pixelStorei :: GetPName -> PixelStore -> StateVar GLint +pixelStorei :: PName1I -> PixelStore -> StateVar GLint pixelStorei pn ps = makeStateVar (getInteger1 id pn) diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs --- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs +++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -115,7 +115,7 @@ stageToGetScales :: PixelTransferStage - -> (GetPName, GetPName, GetPName, GetPName) + -> (PName1F, PName1F, PName1F, PName1F) stageToGetScales s = case s of PreConvolution -> (GetRedScale, GetGreenScale, @@ -149,7 +149,7 @@ stageToGetBiases :: PixelTransferStage - -> (GetPName, GetPName, GetPName, GetPName) + -> (PName1F, PName1F, PName1F, PName1F) stageToGetBiases s = case s of PreConvolution -> (GetRedBias, GetGreenBias, @@ -209,27 +209,27 @@ -------------------------------------------------------------------------------- -pixelTransferb :: GetPName -> PixelTransfer -> StateVar Capability +pixelTransferb :: GetPName1I p => p -> PixelTransfer -> StateVar Capability pixelTransferb pn pt = makeStateVar (getBoolean1 unmarshalCapability pn) (glPixelTransferi (marshalPixelTransfer pt) . fromIntegral . marshalCapability) -pixelTransferi :: GetPName -> PixelTransfer -> StateVar GLint +pixelTransferi :: GetPName1I p => p -> PixelTransfer -> StateVar GLint pixelTransferi pn pt = makeStateVar (getInteger1 id pn) (glPixelTransferi (marshalPixelTransfer pt)) -pixelTransferf :: GetPName -> PixelTransfer -> StateVar GLfloat +pixelTransferf :: GetPName1F p => p -> PixelTransfer -> StateVar GLfloat pixelTransferf pn pt = makeStateVar (getFloat1 id pn) (glPixelTransferf (marshalPixelTransfer pt)) -pixelTransfer4f :: - (GetPName, GetPName, GetPName, GetPName) +pixelTransfer4f :: GetPName1F p => + (p, p, p, p) -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer) -> StateVar (Color4 GLfloat) pixelTransfer4f (pr, pg, pb, pa) (tr, tg, tb, ta) = makeStateVar get4f set4f diff --git a/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs b/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs @@ -0,0 +1,84 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.PixellikeObject +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.PixellikeObject ( + PixellikeObjectGetPName(..), + PixellikeObjectTarget(pixellikeObjTarParam), +) where + +import Data.StateVar +import Foreign.Marshal.Alloc +import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.Raw.Core31 + +import Graphics.Rendering.OpenGL.GL.Texturing.Specification +import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget + +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects +import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects + +data PixellikeObjectGetPName = + RedSize + | BlueSize + | GreenSize + | AlphaSize + | DepthSize + | StencilSize + +class PixellikeObjectTarget t where + --dummy t to include it in the type class + marshalPixellikeOT :: t -> PixellikeObjectGetPName -> GLenum + pixObjTarQueryFunc :: t -> GLenum -> IO GLint + pixellikeObjTarParam :: t -> PixellikeObjectGetPName -> GettableStateVar GLint + pixellikeObjTarParam t p = makeGettableStateVar (pixObjTarQueryFunc t $ marshalPixellikeOT t p) + +instance PixellikeObjectTarget RenderbufferTarget where + marshalPixellikeOT _ x = case x of + RedSize -> gl_RENDERBUFFER_RED_SIZE + BlueSize -> gl_RENDERBUFFER_BLUE_SIZE + GreenSize -> gl_RENDERBUFFER_GREEN_SIZE + AlphaSize -> gl_RENDERBUFFER_ALPHA_SIZE + DepthSize -> gl_RENDERBUFFER_DEPTH_SIZE + StencilSize -> gl_RENDERBUFFER_STENCIL_SIZE + pixObjTarQueryFunc t = getRBParameteriv t id + +data FramebufferTargetAttachment = + FramebufferTargetAttachment FramebufferTarget FramebufferObjectAttachment + +instance PixellikeObjectTarget FramebufferTargetAttachment where + marshalPixellikeOT _ x = case x of + RedSize -> gl_FRAMEBUFFER_ATTACHMENT_RED_SIZE + BlueSize -> gl_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE + GreenSize -> gl_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE + AlphaSize -> gl_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE + DepthSize -> gl_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE + StencilSize -> gl_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE + pixObjTarQueryFunc (FramebufferTargetAttachment fbt fba) = + getFBAParameteriv fbt fba id + +data TextureTargetFull = TextureTargetFull (Either TextureTarget CubeMapTarget) Level +instance PixellikeObjectTarget TextureTargetFull where + marshalPixellikeOT _ x = case x of + RedSize -> gl_TEXTURE_RED_SIZE + BlueSize -> gl_TEXTURE_BLUE_SIZE + GreenSize -> gl_TEXTURE_GREEN_SIZE + AlphaSize -> gl_TEXTURE_ALPHA_SIZE + DepthSize -> gl_TEXTURE_DEPTH_SIZE + StencilSize -> gl_TEXTURE_STENCIL_SIZE + pixObjTarQueryFunc (TextureTargetFull t level) p = + alloca $ \buf -> do + glGetTexLevelParameteriv (marshalTarget t) level p buf + peek1 id buf + where marshalTarget = either marshalTextureTarget marshalCubeMapTarget diff --git a/Graphics/Rendering/OpenGL/GL/QueryObjects.hs b/Graphics/Rendering/OpenGL/GL/QueryObjects.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/QueryObjects.hs @@ -0,0 +1,166 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.QueryObject +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.QueryObjects ( +QueryObject, QueryTarget(..), marshalQueryTarget, + +beginQuery, endQuery, withQuery, + +queryCounterBits, currentQuery, + +queryResult, queryResultAvailable, +-- * Conditional rendering +ConditionalRenderMode(..), + +beginConditionalRender, endConditionalRender, withConditionalRender +) where + +import Data.ObjectName +import Data.StateVar +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Graphics.Rendering.OpenGL.GL.Exception +import Graphics.Rendering.OpenGL.GL.GLboolean +import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.Raw.Core31 + +newtype QueryObject = QueryObject { queryID :: GLuint } + deriving ( Eq, Ord, Show ) + +-------------------------------------------------------------------------------- + +instance ObjectName QueryObject where + genObjectNames n = + allocaArray n $ \buf -> do + glGenQueries (fromIntegral n) buf + fmap (map QueryObject) $ peekArray n buf + + deleteObjectNames queryObjects = + withArrayLen (map queryID queryObjects) $ + glDeleteQueries . fromIntegral + + isObjectName = fmap unmarshalGLboolean . glIsQuery . queryID + +-------------------------------------------------------------------------------- + +data QueryTarget = + SamplesPassed + | TransformFeedbackPrimitivesWritten + | PrimitivesGenerated + deriving ( Eq, Ord, Show ) + +marshalQueryTarget :: QueryTarget -> GLenum +marshalQueryTarget x = case x of + SamplesPassed -> gl_SAMPLES_PASSED + TransformFeedbackPrimitivesWritten -> gl_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN + PrimitivesGenerated -> gl_PRIMITIVES_GENERATED + +-------------------------------------------------------------------------------- + +beginQuery :: QueryTarget -> QueryObject -> IO () +beginQuery t = glBeginQuery (marshalQueryTarget t) . queryID + +endQuery :: QueryTarget -> IO () +endQuery = glEndQuery . marshalQueryTarget + +-- | Convenience function for an exception-safe combination of 'beginQuery' and +-- 'endQuery'. +withQuery :: QueryTarget -> QueryObject -> IO a -> IO a +withQuery t q = bracket_ (beginQuery t q) (endQuery t) + +-------------------------------------------------------------------------------- + +data GetQueryPName = + QueryCounterBits + | CurrentQuery + +marshalGetQueryPName :: GetQueryPName -> GLenum +marshalGetQueryPName x = case x of + QueryCounterBits -> gl_QUERY_COUNTER_BITS + CurrentQuery -> gl_CURRENT_QUERY + +-------------------------------------------------------------------------------- + +queryCounterBits :: QueryTarget -> GettableStateVar GLsizei +queryCounterBits = getQueryi fromIntegral QueryCounterBits + +currentQuery :: QueryTarget -> GettableStateVar (Maybe QueryObject) +currentQuery = + getQueryi + (\q -> if q == 0 then Nothing else Just (QueryObject (fromIntegral q))) + CurrentQuery + +getQueryi :: (GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a +getQueryi f p t = + makeGettableStateVar $ + alloca $ \buf -> do + glGetQueryiv (marshalQueryTarget t) (marshalGetQueryPName p) buf + peek1 f buf + +-------------------------------------------------------------------------------- + +data GetQueryObjectPName = + QueryResult + | QueryResultAvailable + +marshalGetQueryObjectPName :: GetQueryObjectPName -> GLenum +marshalGetQueryObjectPName x = case x of + QueryResult -> gl_QUERY_RESULT + QueryResultAvailable -> gl_QUERY_RESULT_AVAILABLE + +-------------------------------------------------------------------------------- + +queryResult :: QueryObject -> GettableStateVar GLuint +queryResult = getQueryObjectui id QueryResult + +queryResultAvailable :: QueryObject -> GettableStateVar Bool +queryResultAvailable = getQueryObjectui unmarshalGLboolean QueryResultAvailable + +getQueryObjectui :: + (GLuint -> a) -> GetQueryObjectPName -> QueryObject -> GettableStateVar a +getQueryObjectui f p q = + makeGettableStateVar $ + alloca $ \buf -> do + glGetQueryObjectuiv (queryID q) (marshalGetQueryObjectPName p) buf + peek1 f buf + +-------------------------------------------------------------------------------- + +data ConditionalRenderMode = + QueryWait + | QueryNoWait + | QueryByRegionWait + | QueryByRegionNoWait + +marshalConditionalRenderMode :: ConditionalRenderMode -> GLenum +marshalConditionalRenderMode x = case x of + QueryWait -> gl_QUERY_WAIT + QueryNoWait -> gl_QUERY_NO_WAIT + QueryByRegionWait -> gl_QUERY_BY_REGION_WAIT + QueryByRegionNoWait -> gl_QUERY_BY_REGION_NO_WAIT + +-------------------------------------------------------------------------------- + +beginConditionalRender :: QueryObject -> ConditionalRenderMode -> IO () +beginConditionalRender q m = glBeginConditionalRender (queryID q) (marshalConditionalRenderMode m) + +endConditionalRender :: IO () +endConditionalRender = glEndConditionalRender + +withConditionalRender :: QueryObject -> ConditionalRenderMode -> IO a -> IO a +withConditionalRender q m = bracket_ (beginConditionalRender q m) endConditionalRender + + + + diff --git a/Graphics/Rendering/OpenGL/GL/QueryUtils.hs b/Graphics/Rendering/OpenGL/GL/QueryUtils.hs --- a/Graphics/Rendering/OpenGL/GL/QueryUtils.hs +++ b/Graphics/Rendering/OpenGL/GL/QueryUtils.hs @@ -4,1175 +4,332 @@ -- Module : Graphics.Rendering.OpenGL.GL.QueryUtils -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- --- Maintainer : sven.panne@aedion.de --- Stability : stable --- Portability : portable --- --- This is a purely internal module with utilities to query OpenGL state. --- --------------------------------------------------------------------------------- - -module Graphics.Rendering.OpenGL.GL.QueryUtils ( - GetPName(..), - clipPlaneIndexToEnum, lightIndexToEnum, - modelviewIndexToEnum, modelviewEnumToIndex, - getBoolean1, getBoolean4, - getInteger1, getInteger2, getInteger4, getIntegerv, - getEnum1, - getSizei1, getSizei2, - getFloat1, getFloat2, getFloat3, getFloat4, getFloatv, - getClampf1, getClampf4, - getDouble1, getDouble2, getDouble4, getDoublev, - getClampd1, getClampd2, - maybeNullPtr, - AttribLocation(..), GetVertexAttribPName(..), - getVertexAttribInteger1, getVertexAttribEnum1, getVertexAttribBoolean1, - getVertexAttribFloat4, getVertexAttribIInteger4, getVertexAttribIuInteger4, - GetVertexAttribPointerPName(..), getVertexAttribPointer -) where - -import Foreign.Marshal.Alloc -import Foreign.Marshal.Array -import Foreign.Ptr -import Foreign.Storable -import Graphics.Rendering.OpenGL.GL.PeekPoke -import Graphics.Rendering.OpenGL.GLU.ErrorsInternal -import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( - gl_ACCUM_ALPHA_BITS, gl_ACCUM_BLUE_BITS, gl_ACCUM_CLEAR_VALUE, - gl_ACCUM_GREEN_BITS, gl_ACCUM_RED_BITS, gl_ALIASED_POINT_SIZE_RANGE, - gl_ALPHA_BIAS, gl_ALPHA_BITS, gl_ALPHA_SCALE, gl_ALPHA_TEST, - gl_ALPHA_TEST_FUNC, gl_ALPHA_TEST_REF, gl_ATTRIB_STACK_DEPTH, gl_AUTO_NORMAL, - gl_AUX_BUFFERS, gl_BLUE_BIAS, gl_BLUE_BITS, gl_BLUE_SCALE, - gl_CLIENT_ACTIVE_TEXTURE, gl_CLIENT_ATTRIB_STACK_DEPTH, gl_COLOR_ARRAY, - gl_COLOR_ARRAY_BUFFER_BINDING, gl_COLOR_ARRAY_SIZE, gl_COLOR_ARRAY_STRIDE, - gl_COLOR_ARRAY_TYPE, gl_COLOR_MATERIAL, gl_COLOR_MATERIAL_FACE, - gl_COLOR_MATERIAL_PARAMETER, gl_COLOR_MATRIX, gl_COLOR_MATRIX_STACK_DEPTH, - gl_COLOR_SUM, gl_COLOR_TABLE, gl_CONVOLUTION_1D, gl_CONVOLUTION_2D, - gl_CURRENT_COLOR, gl_CURRENT_FOG_COORD, gl_CURRENT_INDEX, gl_CURRENT_NORMAL, - gl_CURRENT_RASTER_COLOR, gl_CURRENT_RASTER_DISTANCE, gl_CURRENT_RASTER_INDEX, - gl_CURRENT_RASTER_POSITION, gl_CURRENT_RASTER_POSITION_VALID, - gl_CURRENT_RASTER_SECONDARY_COLOR, gl_CURRENT_RASTER_TEXTURE_COORDS, - gl_CURRENT_SECONDARY_COLOR, gl_CURRENT_TEXTURE_COORDS, gl_DEPTH_BIAS, - gl_DEPTH_BITS, gl_DEPTH_SCALE, gl_EDGE_FLAG, gl_EDGE_FLAG_ARRAY, - gl_EDGE_FLAG_ARRAY_BUFFER_BINDING, gl_EDGE_FLAG_ARRAY_STRIDE, - gl_FEEDBACK_BUFFER_SIZE, gl_FEEDBACK_BUFFER_TYPE, gl_FOG, gl_FOG_COLOR, - gl_FOG_COORD_ARRAY, gl_FOG_COORD_ARRAY_BUFFER_BINDING, - gl_FOG_COORD_ARRAY_STRIDE, gl_FOG_COORD_ARRAY_TYPE, gl_FOG_COORD_SRC, - gl_FOG_DENSITY, gl_FOG_END, gl_FOG_HINT, gl_FOG_INDEX, gl_FOG_MODE, - gl_FOG_START, gl_GENERATE_MIPMAP_HINT, gl_GREEN_BIAS, gl_GREEN_BITS, - gl_GREEN_SCALE, gl_HISTOGRAM, gl_INDEX_ARRAY, gl_INDEX_ARRAY_BUFFER_BINDING, - gl_INDEX_ARRAY_STRIDE, gl_INDEX_ARRAY_TYPE, gl_INDEX_BITS, - gl_INDEX_CLEAR_VALUE, gl_INDEX_LOGIC_OP, gl_INDEX_MODE, gl_INDEX_OFFSET, - gl_INDEX_SHIFT, gl_INDEX_WRITEMASK, gl_LIGHT0, gl_LIGHTING, - gl_LIGHT_MODEL_AMBIENT, gl_LIGHT_MODEL_COLOR_CONTROL, - gl_LIGHT_MODEL_LOCAL_VIEWER, gl_LIGHT_MODEL_TWO_SIDE, gl_LINE_STIPPLE, - gl_LINE_STIPPLE_PATTERN, gl_LINE_STIPPLE_REPEAT, gl_LIST_BASE, gl_LIST_INDEX, - gl_LIST_MODE, gl_MAP1_COLOR_4, gl_MAP1_GRID_DOMAIN, gl_MAP1_GRID_SEGMENTS, - gl_MAP1_INDEX, gl_MAP1_NORMAL, gl_MAP1_TEXTURE_COORD_1, - gl_MAP1_TEXTURE_COORD_2, gl_MAP1_TEXTURE_COORD_3, gl_MAP1_TEXTURE_COORD_4, - gl_MAP1_VERTEX_3, gl_MAP1_VERTEX_4, gl_MAP2_COLOR_4, gl_MAP2_GRID_DOMAIN, - gl_MAP2_GRID_SEGMENTS, gl_MAP2_INDEX, gl_MAP2_NORMAL, - gl_MAP2_TEXTURE_COORD_1, gl_MAP2_TEXTURE_COORD_2, gl_MAP2_TEXTURE_COORD_3, - gl_MAP2_TEXTURE_COORD_4, gl_MAP2_VERTEX_3, gl_MAP2_VERTEX_4, gl_MAP_COLOR, - gl_MAP_STENCIL, gl_MATRIX_MODE, gl_MAX_ATTRIB_STACK_DEPTH, - gl_MAX_CLIENT_ATTRIB_STACK_DEPTH, gl_MAX_COLOR_MATRIX_STACK_DEPTH, - gl_MAX_CONVOLUTION_HEIGHT, gl_MAX_CONVOLUTION_WIDTH, gl_MAX_EVAL_ORDER, - gl_MAX_LIGHTS, gl_MAX_LIST_NESTING, gl_MAX_MODELVIEW_STACK_DEPTH, - gl_MAX_NAME_STACK_DEPTH, gl_MAX_PIXEL_MAP_TABLE, - gl_MAX_PROJECTION_STACK_DEPTH, gl_MAX_TEXTURE_COORDS, - gl_MAX_TEXTURE_STACK_DEPTH, gl_MAX_TEXTURE_UNITS, gl_MINMAX, gl_MODELVIEW, - gl_MODELVIEW_MATRIX, gl_MODELVIEW_STACK_DEPTH, gl_NAME_STACK_DEPTH, - gl_NORMALIZE, gl_NORMAL_ARRAY, gl_NORMAL_ARRAY_BUFFER_BINDING, - gl_NORMAL_ARRAY_STRIDE, gl_NORMAL_ARRAY_TYPE, gl_PERSPECTIVE_CORRECTION_HINT, - gl_PIXEL_MAP_A_TO_A_SIZE, gl_PIXEL_MAP_B_TO_B_SIZE, gl_PIXEL_MAP_G_TO_G_SIZE, - gl_PIXEL_MAP_I_TO_A_SIZE, gl_PIXEL_MAP_I_TO_B_SIZE, gl_PIXEL_MAP_I_TO_G_SIZE, - gl_PIXEL_MAP_I_TO_I_SIZE, gl_PIXEL_MAP_I_TO_R_SIZE, gl_PIXEL_MAP_R_TO_R_SIZE, - gl_PIXEL_MAP_S_TO_S_SIZE, gl_POINT_DISTANCE_ATTENUATION, gl_POINT_SIZE_MAX, - gl_POINT_SIZE_MIN, gl_POINT_SMOOTH, gl_POINT_SMOOTH_HINT, gl_POLYGON_MODE, - gl_POLYGON_STIPPLE, gl_POST_COLOR_MATRIX_ALPHA_BIAS, - gl_POST_COLOR_MATRIX_ALPHA_SCALE, gl_POST_COLOR_MATRIX_BLUE_BIAS, - gl_POST_COLOR_MATRIX_BLUE_SCALE, gl_POST_COLOR_MATRIX_COLOR_TABLE, - gl_POST_COLOR_MATRIX_GREEN_BIAS, gl_POST_COLOR_MATRIX_GREEN_SCALE, - gl_POST_COLOR_MATRIX_RED_BIAS, gl_POST_COLOR_MATRIX_RED_SCALE, - gl_POST_CONVOLUTION_ALPHA_BIAS, gl_POST_CONVOLUTION_ALPHA_SCALE, - gl_POST_CONVOLUTION_BLUE_BIAS, gl_POST_CONVOLUTION_BLUE_SCALE, - gl_POST_CONVOLUTION_COLOR_TABLE, gl_POST_CONVOLUTION_GREEN_BIAS, - gl_POST_CONVOLUTION_GREEN_SCALE, gl_POST_CONVOLUTION_RED_BIAS, - gl_POST_CONVOLUTION_RED_SCALE, gl_PROJECTION_MATRIX, - gl_PROJECTION_STACK_DEPTH, gl_RED_BIAS, gl_RED_BITS, gl_RED_SCALE, - gl_RENDER_MODE, gl_RESCALE_NORMAL, gl_RGBA_MODE, gl_SECONDARY_COLOR_ARRAY, - gl_SECONDARY_COLOR_ARRAY_BUFFER_BINDING, gl_SECONDARY_COLOR_ARRAY_SIZE, - gl_SECONDARY_COLOR_ARRAY_STRIDE, gl_SECONDARY_COLOR_ARRAY_TYPE, - gl_SELECTION_BUFFER_SIZE, gl_SEPARABLE_2D, gl_SHADE_MODEL, gl_STENCIL_BITS, - gl_TEXTURE_COORD_ARRAY, gl_TEXTURE_COORD_ARRAY_BUFFER_BINDING, - gl_TEXTURE_COORD_ARRAY_SIZE, gl_TEXTURE_COORD_ARRAY_STRIDE, - gl_TEXTURE_COORD_ARRAY_TYPE, gl_TEXTURE_GEN_Q, gl_TEXTURE_GEN_R, - gl_TEXTURE_GEN_S, gl_TEXTURE_GEN_T, gl_TEXTURE_MATRIX, - gl_TEXTURE_STACK_DEPTH, gl_TRANSPOSE_COLOR_MATRIX, - gl_TRANSPOSE_MODELVIEW_MATRIX, gl_TRANSPOSE_PROJECTION_MATRIX, - gl_TRANSPOSE_TEXTURE_MATRIX, gl_VERTEX_ARRAY, gl_VERTEX_ARRAY_BUFFER_BINDING, - gl_VERTEX_ARRAY_SIZE, gl_VERTEX_ARRAY_STRIDE, gl_VERTEX_ARRAY_TYPE, - gl_ZOOM_X, gl_ZOOM_Y ) -import Graphics.Rendering.OpenGL.Raw.ARB.FragmentProgram ( - gl_CURRENT_MATRIX, gl_CURRENT_MATRIX_STACK_DEPTH ) -import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette ( - gl_CURRENT_MATRIX_INDEX, gl_CURRENT_PALETTE_MATRIX, gl_MATRIX_INDEX_ARRAY, - gl_MATRIX_INDEX_ARRAY_SIZE, gl_MATRIX_INDEX_ARRAY_STRIDE, - gl_MATRIX_INDEX_ARRAY_TYPE, gl_MATRIX_PALETTE, - gl_MAX_MATRIX_PALETTE_STACK_DEPTH, gl_MAX_PALETTE_MATRICES ) -import Graphics.Rendering.OpenGL.Raw.ARB.VertexBlend ( - gl_ACTIVE_VERTEX_UNITS, gl_CURRENT_WEIGHT, gl_MAX_VERTEX_UNITS, - gl_MODELVIEW1, gl_MODELVIEW2, gl_MODELVIEW31, gl_VERTEX_BLEND, - gl_WEIGHT_ARRAY, gl_WEIGHT_ARRAY_SIZE, gl_WEIGHT_ARRAY_STRIDE, - gl_WEIGHT_ARRAY_TYPE, gl_WEIGHT_SUM_UNITY ) -import Graphics.Rendering.OpenGL.Raw.Core32 -import Graphics.Rendering.OpenGL.Raw.EXT ( gl_RGBA_SIGNED_COMPONENTS ) -import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka ( gl_PACK_CMYK_HINT, gl_UNPACK_CMYK_HINT ) -import Graphics.Rendering.OpenGL.Raw.EXT.CompiledVertexArray ( gl_ARRAY_ELEMENT_LOCK_FIRST, gl_ARRAY_ELEMENT_LOCK_COUNT ) -import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( gl_DEPTH_BOUNDS, ) -import Graphics.Rendering.OpenGL.Raw.EXT.SharedTexturePalette ( gl_SHARED_TEXTURE_PALETTE ) -import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( gl_ACTIVE_STENCIL_FACE ) -import Graphics.Rendering.OpenGL.Raw.EXT.TextureFilterAnisotropic ( gl_MAX_TEXTURE_MAX_ANISOTROPY ) -import Graphics.Rendering.OpenGL.Raw.NV.FogDistance ( gl_FOG_DISTANCE_MODE ) -import Graphics.Rendering.OpenGL.Raw.NV.LightMaxExponent ( gl_MAX_SHININESS, gl_MAX_SPOT_EXPONENT ) -import Graphics.Rendering.OpenGL.Raw.NV.PrimitiveRestart ( gl_PRIMITIVE_RESTART_INDEX_NV, gl_PRIMITIVE_RESTART_NV ) - --------------------------------------------------------------------------------- - -data GetPName = - GetCurrentColor - | GetCurrentIndex - | GetCurrentNormal - | GetCurrentTextureCoords - | GetCurrentRasterColor - | GetCurrentRasterSecondaryColor - | GetCurrentRasterIndex - | GetCurrentRasterTextureCoords - | GetCurrentRasterPosition - | GetCurrentRasterPositionValid - | GetCurrentRasterDistance - | GetCurrentMatrixIndex - | GetPointSmooth - | GetPointSize - | GetPointSizeRange - | GetPointSizeGranularity - | GetLineSmooth - | GetLineWidth - | GetLineWidthRange - | GetLineWidthGranularity - | GetLineStipple - | GetLineStipplePattern - | GetLineStippleRepeat - | GetSmoothPointSizeRange - | GetSmoothPointSizeGranularity - | GetSmoothLineWidthRange - | GetSmoothLineWidthGranularity - | GetAliasedPointSizeRange - | GetAliasedLineWidthRange - | GetListMode - | GetMaxListNesting - | GetListBase - | GetListIndex - | GetPolygonMode - | GetPolygonSmooth - | GetPolygonStipple - | GetEdgeFlag - | GetCullFace - | GetCullFaceMode - | GetFrontFace - | GetLighting - | GetLightModelLocalViewer - | GetLightModelTwoSide - | GetLightModelAmbient - | GetShadeModel - | GetColorMaterialFace - | GetColorMaterialParameter - | GetColorMaterial - | GetFog - | GetFogIndex - | GetFogDensity - | GetFogStart - | GetFogEnd - | GetFogMode - | GetFogColor - | GetFogCoordSrc - | GetCurrentFogCoord - | GetDepthRange - | GetDepthTest - | GetDepthWritemask - | GetDepthClearValue - | GetDepthFunc - | GetAccumClearValue - | GetStencilTest - | GetStencilClearValue - | GetStencilFunc - | GetStencilValueMask - | GetStencilFail - | GetStencilPassDepthFail - | GetStencilPassDepthPass - | GetStencilRef - | GetStencilWritemask - | GetMatrixMode - | GetNormalize - | GetViewport - | GetModelviewStackDepth - | GetProjectionStackDepth - | GetTextureStackDepth - | GetModelviewMatrix - | GetProjectionMatrix - | GetTextureMatrix - | GetAttribStackDepth - | GetClientAttribStackDepth - | GetAlphaTest - | GetAlphaTestFunc - | GetAlphaTestRef - | GetDither - | GetBlendDst - | GetBlendSrc - | GetBlend - | GetLogicOpMode - | GetIndexLogicOp - | GetLogicOp - | GetColorLogicOp - | GetAuxBuffers - | GetDrawBuffer - | GetReadBuffer - | GetScissorBox - | GetScissorTest - | GetIndexClearValue - | GetIndexWritemask - | GetColorClearValue - | GetColorWritemask - | GetIndexMode - | GetRGBAMode - | GetDoublebuffer - | GetStereo - | GetRenderMode - | GetPerspectiveCorrectionHint - | GetPointSmoothHint - | GetLineSmoothHint - | GetPolygonSmoothHint - | GetFogHint - | GetGenerateMipmapHint - | GetTextureCompressionHint - | GetTextureGenS - | GetTextureGenT - | GetTextureGenR - | GetTextureGenQ - | GetPixelMapIToISize - | GetPixelMapSToSSize - | GetPixelMapIToRSize - | GetPixelMapIToGSize - | GetPixelMapIToBSize - | GetPixelMapIToASize - | GetPixelMapRToRSize - | GetPixelMapGToGSize - | GetPixelMapBToBSize - | GetPixelMapAToASize - | GetUnpackSwapBytes - | GetUnpackLSBFirst - | GetUnpackRowLength - | GetUnpackSkipRows - | GetUnpackSkipPixels - | GetUnpackAlignment - | GetPackSwapBytes - | GetPackLSBFirst - | GetPackRowLength - | GetPackSkipRows - | GetPackSkipPixels - | GetPackAlignment - | GetMapColor - | GetMapStencil - | GetIndexShift - | GetIndexOffset - | GetRedScale - | GetRedBias - | GetZoomX - | GetZoomY - | GetGreenScale - | GetGreenBias - | GetBlueScale - | GetBlueBias - | GetAlphaScale - | GetAlphaBias - | GetDepthScale - | GetDepthBias - | GetMaxEvalOrder - | GetMaxLights - | GetMaxClipPlanes - | GetMaxTextureSize - | GetMaxPixelMapTable - | GetMaxAttribStackDepth - | GetMaxModelviewStackDepth - | GetMaxNameStackDepth - | GetMaxProjectionStackDepth - | GetMaxTextureStackDepth - | GetMaxViewportDims - | GetMaxClientAttribStackDepth - | GetSubpixelBits - | GetIndexBits - | GetRedBits - | GetGreenBits - | GetBlueBits - | GetAlphaBits - | GetDepthBits - | GetStencilBits - | GetAccumRedBits - | GetAccumGreenBits - | GetAccumBlueBits - | GetAccumAlphaBits - | GetNameStackDepth - | GetAutoNormal - | GetMap1Color4 - | GetMap1Index - | GetMap1Normal - | GetMap1TextureCoord1 - | GetMap1TextureCoord2 - | GetMap1TextureCoord3 - | GetMap1TextureCoord4 - | GetMap1Vertex3 - | GetMap1Vertex4 - | GetMap2Color4 - | GetMap2Index - | GetMap2Normal - | GetMap2TextureCoord1 - | GetMap2TextureCoord2 - | GetMap2TextureCoord3 - | GetMap2TextureCoord4 - | GetMap2Vertex3 - | GetMap2Vertex4 - | GetMap1GridDomain - | GetMap1GridSegments - | GetMap2GridDomain - | GetMap2GridSegments - | GetTexture1D - | GetTexture2D - | GetFeedbackBufferSize - | GetFeedbackBufferType - | GetSelectionBufferSize - | GetPolygonOffsetUnits - | GetPolygonOffsetPoint - | GetPolygonOffsetLine - | GetPolygonOffsetFill - | GetPolygonOffsetFactor - | GetTextureBinding1D - | GetTextureBinding2D - | GetTextureBinding3D - | GetVertexArray - | GetNormalArray - | GetColorArray - | GetIndexArray - | GetTextureCoordArray - | GetEdgeFlagArray - | GetFogCoordArray - | GetSecondaryColorArray - | GetMatrixIndexArray - | GetVertexArraySize - | GetVertexArrayType - | GetVertexArrayStride - | GetNormalArrayType - | GetNormalArrayStride - | GetColorArraySize - | GetColorArrayType - | GetColorArrayStride - | GetIndexArrayType - | GetIndexArrayStride - | GetTextureCoordArraySize - | GetTextureCoordArrayType - | GetTextureCoordArrayStride - | GetEdgeFlagArrayStride - | GetFogCoordArrayType - | GetFogCoordArrayStride - | GetSecondaryColorArraySize - | GetSecondaryColorArrayType - | GetSecondaryColorArrayStride - | GetMatrixIndexArraySize - | GetMatrixIndexArrayType - | GetMatrixIndexArrayStride - | GetClipPlane GLsizei - | GetLight GLsizei - | GetTransposeModelviewMatrix - | GetTransposeProjectionMatrix - | GetTransposeTextureMatrix - | GetTransposeColorMatrix - | GetLightModelColorControl - | GetBlendColor - | GetBlendEquation - | GetBlendEquationAlpha - | GetColorTable - | GetPostConvolutionColorTable - | GetPostColorMatrixColorTable - | GetConvolution1D - | GetConvolution2D - | GetSeparable2D - | GetMaxConvolutionWidth - | GetMaxConvolutionHeight - | GetPostConvolutionRedScale - | GetPostConvolutionGreenScale - | GetPostConvolutionBlueScale - | GetPostConvolutionAlphaScale - | GetPostConvolutionRedBias - | GetPostConvolutionGreenBias - | GetPostConvolutionBlueBias - | GetPostConvolutionAlphaBias - | GetHistogram - | GetMinmax - | GetColorSum - | GetCurrentSecondaryColor - | GetRescaleNormal - | GetSharedTexturePalette - | GetTexture3DBinding - | GetPackSkipImages - | GetPackImageHeight - | GetUnpackSkipImages - | GetUnpackImageHeight - | GetTexture3D - | GetMax3DTextureSize - | GetMaxTextureLODBias - | GetMaxTextureMaxAnisotropy - | GetMultisample - | GetSampleAlphaToCoverage - | GetSampleAlphaToOne - | GetSampleCoverage - | GetSampleBuffers - | GetSamples - | GetSampleCoverageValue - | GetSampleCoverageInvert - | GetPointSizeMin - | GetPointSizeMax - | GetPointFadeThresholdSize - | GetPointDistanceAttenuation - | GetColorMatrix - | GetColorMatrixStackDepth - | GetMaxColorMatrixStackDepth - | GetPostColorMatrixRedScale - | GetPostColorMatrixGreenScale - | GetPostColorMatrixBlueScale - | GetPostColorMatrixAlphaScale - | GetPostColorMatrixRedBias - | GetPostColorMatrixGreenBias - | GetPostColorMatrixBlueBias - | GetPostColorMatrixAlphaBias - | GetMaxElementsVertices - | GetMaxElementsIndices - | GetActiveTexture - | GetClientActiveTexture - | GetMaxTextureUnits - | GetTextureCubeMap - | GetMaxCubeMapTextureSize - | GetMaxRectangleTextureSize - | GetNumCompressedTextureFormats - | GetCompressedTextureFormats - | GetMaxVertexUnits - | GetActiveVertexUnits - | GetWeightSumUnity - | GetVertexBlend - | GetModelview GLsizei - | GetCurrentWeight - | GetWeightArrayType - | GetWeightArrayStride - | GetWeightArraySize - | GetWeightArray - | GetMatrixPalette - | GetMaxMatrixPaletteStackDepth - | GetMaxPaletteMatrices - | GetCurrentPaletteMatrix - | GetBlendDstRGB - | GetBlendSrcRGB - | GetBlendDstAlpha - | GetBlendSrcAlpha - | GetPackCMYKHint - | GetUnpackCMYKHint - | GetArrayElementLockFirst - | GetArrayElementLockCount - | GetMaxShininess - | GetMaxSpotExponent - | GetFogDistanceMode - | GetDepthBounds - | GetPrimitiveRestartIndex - | GetPrimitiveRestartNV - | GetPrimitiveRestartIndexNV - | GetActiveStencilFace - | GetArrayBufferBinding - | GetElementArrayBufferBinding - | GetVertexArrayBufferBinding - | GetNormalArrayBufferBinding - | GetColorArrayBufferBinding - | GetIndexArrayBufferBinding - | GetTextureCoordArrayBufferBinding - | GetEdgeFlagArrayBufferBinding - | GetSecondaryColorArrayBufferBinding - | GetFogCoordArrayBufferBinding - | GetTextureBindingCubeMap - | GetTextureBindingRectangle - | GetCurrentMatrix - | GetCurrentMatrixStackDepth - | GetMaxCombinedTextureImageUnits - | GetMaxDrawBuffers - | GetMaxFragmentUniformComponents - | GetMaxTextureCoords - | GetMaxTextureImageUnits - | GetMaxVaryingFloats - | GetMaxVertexAttribs - | GetMaxVertexTextureImageUnits - | GetMaxVertexUniformComponents - | GetCurrentProgram - | GetPixelPackBufferBinding - | GetPixelUnpackBufferBinding - | GetDrawBufferN GLsizei - | GetRGBASignedComponents - | GetCopyReadBuffer - | GetCopyWriteBuffer - -- GetWeightArrayBufferBinding - | GetContextProfileMask - -marshalGetPName :: GetPName -> Maybe GLenum -marshalGetPName x = case x of - GetCurrentColor -> Just gl_CURRENT_COLOR - GetCurrentIndex -> Just gl_CURRENT_INDEX - GetCurrentNormal -> Just gl_CURRENT_NORMAL - GetCurrentTextureCoords -> Just gl_CURRENT_TEXTURE_COORDS - GetCurrentRasterColor -> Just gl_CURRENT_RASTER_COLOR - GetCurrentRasterSecondaryColor -> Just gl_CURRENT_RASTER_SECONDARY_COLOR - GetCurrentRasterIndex -> Just gl_CURRENT_RASTER_INDEX - GetCurrentRasterTextureCoords -> Just gl_CURRENT_RASTER_TEXTURE_COORDS - GetCurrentRasterPosition -> Just gl_CURRENT_RASTER_POSITION - GetCurrentRasterPositionValid -> Just gl_CURRENT_RASTER_POSITION_VALID - GetCurrentRasterDistance -> Just gl_CURRENT_RASTER_DISTANCE - GetCurrentMatrixIndex -> Just gl_CURRENT_MATRIX_INDEX - GetPointSmooth -> Just gl_POINT_SMOOTH - GetPointSize -> Just gl_POINT_SIZE - GetPointSizeRange -> Just gl_POINT_SIZE_RANGE - GetPointSizeGranularity -> Just gl_POINT_SIZE_GRANULARITY - GetLineSmooth -> Just gl_LINE_SMOOTH - GetLineWidth -> Just gl_LINE_WIDTH - GetLineWidthRange -> Just gl_SMOOTH_LINE_WIDTH_RANGE - GetLineWidthGranularity -> Just gl_SMOOTH_LINE_WIDTH_GRANULARITY - GetLineStipple -> Just gl_LINE_STIPPLE - GetLineStipplePattern -> Just gl_LINE_STIPPLE_PATTERN - GetLineStippleRepeat -> Just gl_LINE_STIPPLE_REPEAT - GetSmoothPointSizeRange -> Just gl_POINT_SIZE_RANGE - GetSmoothPointSizeGranularity -> Just gl_POINT_SIZE_GRANULARITY - GetSmoothLineWidthRange -> Just gl_SMOOTH_LINE_WIDTH_RANGE - GetSmoothLineWidthGranularity -> Just gl_SMOOTH_LINE_WIDTH_GRANULARITY - GetAliasedPointSizeRange -> Just gl_ALIASED_POINT_SIZE_RANGE - GetAliasedLineWidthRange -> Just gl_ALIASED_LINE_WIDTH_RANGE - GetListMode -> Just gl_LIST_MODE - GetMaxListNesting -> Just gl_MAX_LIST_NESTING - GetListBase -> Just gl_LIST_BASE - GetListIndex -> Just gl_LIST_INDEX - GetPolygonMode -> Just gl_POLYGON_MODE - GetPolygonSmooth -> Just gl_POLYGON_SMOOTH - GetPolygonStipple -> Just gl_POLYGON_STIPPLE - GetEdgeFlag -> Just gl_EDGE_FLAG - GetCullFace -> Just gl_CULL_FACE - GetCullFaceMode -> Just gl_CULL_FACE_MODE - GetFrontFace -> Just gl_FRONT_FACE - GetLighting -> Just gl_LIGHTING - GetLightModelLocalViewer -> Just gl_LIGHT_MODEL_LOCAL_VIEWER - GetLightModelTwoSide -> Just gl_LIGHT_MODEL_TWO_SIDE - GetLightModelAmbient -> Just gl_LIGHT_MODEL_AMBIENT - GetShadeModel -> Just gl_SHADE_MODEL - GetColorMaterialFace -> Just gl_COLOR_MATERIAL_FACE - GetColorMaterialParameter -> Just gl_COLOR_MATERIAL_PARAMETER - GetColorMaterial -> Just gl_COLOR_MATERIAL - GetFog -> Just gl_FOG - GetFogIndex -> Just gl_FOG_INDEX - GetFogDensity -> Just gl_FOG_DENSITY - GetFogStart -> Just gl_FOG_START - GetFogEnd -> Just gl_FOG_END - GetFogMode -> Just gl_FOG_MODE - GetFogColor -> Just gl_FOG_COLOR - GetFogCoordSrc -> Just gl_FOG_COORD_SRC - GetCurrentFogCoord -> Just gl_CURRENT_FOG_COORD - GetDepthRange -> Just gl_DEPTH_RANGE - GetDepthTest -> Just gl_DEPTH_TEST - GetDepthWritemask -> Just gl_DEPTH_WRITEMASK - GetDepthClearValue -> Just gl_DEPTH_CLEAR_VALUE - GetDepthFunc -> Just gl_DEPTH_FUNC - GetAccumClearValue -> Just gl_ACCUM_CLEAR_VALUE - GetStencilTest -> Just gl_STENCIL_TEST - GetStencilClearValue -> Just gl_STENCIL_CLEAR_VALUE - GetStencilFunc -> Just gl_STENCIL_FUNC - GetStencilValueMask -> Just gl_STENCIL_VALUE_MASK - GetStencilFail -> Just gl_STENCIL_FAIL - GetStencilPassDepthFail -> Just gl_STENCIL_PASS_DEPTH_FAIL - GetStencilPassDepthPass -> Just gl_STENCIL_PASS_DEPTH_PASS - GetStencilRef -> Just gl_STENCIL_REF - GetStencilWritemask -> Just gl_STENCIL_WRITEMASK - GetMatrixMode -> Just gl_MATRIX_MODE - GetNormalize -> Just gl_NORMALIZE - GetViewport -> Just gl_VIEWPORT - GetModelviewStackDepth -> Just gl_MODELVIEW_STACK_DEPTH - GetProjectionStackDepth -> Just gl_PROJECTION_STACK_DEPTH - GetTextureStackDepth -> Just gl_TEXTURE_STACK_DEPTH - GetModelviewMatrix -> Just gl_MODELVIEW_MATRIX - GetProjectionMatrix -> Just gl_PROJECTION_MATRIX - GetTextureMatrix -> Just gl_TEXTURE_MATRIX - GetAttribStackDepth -> Just gl_ATTRIB_STACK_DEPTH - GetClientAttribStackDepth -> Just gl_CLIENT_ATTRIB_STACK_DEPTH - GetAlphaTest -> Just gl_ALPHA_TEST - GetAlphaTestFunc -> Just gl_ALPHA_TEST_FUNC - GetAlphaTestRef -> Just gl_ALPHA_TEST_REF - GetDither -> Just gl_DITHER - GetBlendDst -> Just gl_BLEND_DST - GetBlendSrc -> Just gl_BLEND_SRC - GetBlend -> Just gl_BLEND - GetLogicOpMode -> Just gl_LOGIC_OP_MODE - GetIndexLogicOp -> Just gl_INDEX_LOGIC_OP - GetLogicOp -> Just gl_INDEX_LOGIC_OP - GetColorLogicOp -> Just gl_COLOR_LOGIC_OP - GetAuxBuffers -> Just gl_AUX_BUFFERS - GetDrawBuffer -> Just gl_DRAW_BUFFER - GetReadBuffer -> Just gl_READ_BUFFER - GetScissorBox -> Just gl_SCISSOR_BOX - GetScissorTest -> Just gl_SCISSOR_TEST - GetIndexClearValue -> Just gl_INDEX_CLEAR_VALUE - GetIndexWritemask -> Just gl_INDEX_WRITEMASK - GetColorClearValue -> Just gl_COLOR_CLEAR_VALUE - GetColorWritemask -> Just gl_COLOR_WRITEMASK - GetIndexMode -> Just gl_INDEX_MODE - GetRGBAMode -> Just gl_RGBA_MODE - GetDoublebuffer -> Just gl_DOUBLEBUFFER - GetStereo -> Just gl_STEREO - GetRenderMode -> Just gl_RENDER_MODE - GetPerspectiveCorrectionHint -> Just gl_PERSPECTIVE_CORRECTION_HINT - GetPointSmoothHint -> Just gl_POINT_SMOOTH_HINT - GetLineSmoothHint -> Just gl_LINE_SMOOTH_HINT - GetPolygonSmoothHint -> Just gl_POLYGON_SMOOTH_HINT - GetFogHint -> Just gl_FOG_HINT - GetGenerateMipmapHint -> Just gl_GENERATE_MIPMAP_HINT - GetTextureCompressionHint -> Just gl_TEXTURE_COMPRESSION_HINT - GetTextureGenS -> Just gl_TEXTURE_GEN_S - GetTextureGenT -> Just gl_TEXTURE_GEN_T - GetTextureGenR -> Just gl_TEXTURE_GEN_R - GetTextureGenQ -> Just gl_TEXTURE_GEN_Q - GetPixelMapIToISize -> Just gl_PIXEL_MAP_I_TO_I_SIZE - GetPixelMapSToSSize -> Just gl_PIXEL_MAP_S_TO_S_SIZE - GetPixelMapIToRSize -> Just gl_PIXEL_MAP_I_TO_R_SIZE - GetPixelMapIToGSize -> Just gl_PIXEL_MAP_I_TO_G_SIZE - GetPixelMapIToBSize -> Just gl_PIXEL_MAP_I_TO_B_SIZE - GetPixelMapIToASize -> Just gl_PIXEL_MAP_I_TO_A_SIZE - GetPixelMapRToRSize -> Just gl_PIXEL_MAP_R_TO_R_SIZE - GetPixelMapGToGSize -> Just gl_PIXEL_MAP_G_TO_G_SIZE - GetPixelMapBToBSize -> Just gl_PIXEL_MAP_B_TO_B_SIZE - GetPixelMapAToASize -> Just gl_PIXEL_MAP_A_TO_A_SIZE - GetUnpackSwapBytes -> Just gl_UNPACK_SWAP_BYTES - GetUnpackLSBFirst -> Just gl_UNPACK_LSB_FIRST - GetUnpackRowLength -> Just gl_UNPACK_ROW_LENGTH - GetUnpackSkipRows -> Just gl_UNPACK_SKIP_ROWS - GetUnpackSkipPixels -> Just gl_UNPACK_SKIP_PIXELS - GetUnpackAlignment -> Just gl_UNPACK_ALIGNMENT - GetPackSwapBytes -> Just gl_PACK_SWAP_BYTES - GetPackLSBFirst -> Just gl_PACK_LSB_FIRST - GetPackRowLength -> Just gl_PACK_ROW_LENGTH - GetPackSkipRows -> Just gl_PACK_SKIP_ROWS - GetPackSkipPixels -> Just gl_PACK_SKIP_PIXELS - GetPackAlignment -> Just gl_PACK_ALIGNMENT - GetMapColor -> Just gl_MAP_COLOR - GetMapStencil -> Just gl_MAP_STENCIL - GetIndexShift -> Just gl_INDEX_SHIFT - GetIndexOffset -> Just gl_INDEX_OFFSET - GetRedScale -> Just gl_RED_SCALE - GetRedBias -> Just gl_RED_BIAS - GetZoomX -> Just gl_ZOOM_X - GetZoomY -> Just gl_ZOOM_Y - GetGreenScale -> Just gl_GREEN_SCALE - GetGreenBias -> Just gl_GREEN_BIAS - GetBlueScale -> Just gl_BLUE_SCALE - GetBlueBias -> Just gl_BLUE_BIAS - GetAlphaScale -> Just gl_ALPHA_SCALE - GetAlphaBias -> Just gl_ALPHA_BIAS - GetDepthScale -> Just gl_DEPTH_SCALE - GetDepthBias -> Just gl_DEPTH_BIAS - GetMaxEvalOrder -> Just gl_MAX_EVAL_ORDER - GetMaxLights -> Just gl_MAX_LIGHTS - GetMaxClipPlanes -> Just gl_MAX_CLIP_DISTANCES - GetMaxTextureSize -> Just gl_MAX_TEXTURE_SIZE - GetMaxPixelMapTable -> Just gl_MAX_PIXEL_MAP_TABLE - GetMaxAttribStackDepth -> Just gl_MAX_ATTRIB_STACK_DEPTH - GetMaxModelviewStackDepth -> Just gl_MAX_MODELVIEW_STACK_DEPTH - GetMaxNameStackDepth -> Just gl_MAX_NAME_STACK_DEPTH - GetMaxProjectionStackDepth -> Just gl_MAX_PROJECTION_STACK_DEPTH - GetMaxTextureStackDepth -> Just gl_MAX_TEXTURE_STACK_DEPTH - GetMaxViewportDims -> Just gl_MAX_VIEWPORT_DIMS - GetMaxClientAttribStackDepth -> Just gl_MAX_CLIENT_ATTRIB_STACK_DEPTH - GetSubpixelBits -> Just gl_SUBPIXEL_BITS - GetIndexBits -> Just gl_INDEX_BITS - GetRedBits -> Just gl_RED_BITS - GetGreenBits -> Just gl_GREEN_BITS - GetBlueBits -> Just gl_BLUE_BITS - GetAlphaBits -> Just gl_ALPHA_BITS - GetDepthBits -> Just gl_DEPTH_BITS - GetStencilBits -> Just gl_STENCIL_BITS - GetAccumRedBits -> Just gl_ACCUM_RED_BITS - GetAccumGreenBits -> Just gl_ACCUM_GREEN_BITS - GetAccumBlueBits -> Just gl_ACCUM_BLUE_BITS - GetAccumAlphaBits -> Just gl_ACCUM_ALPHA_BITS - GetNameStackDepth -> Just gl_NAME_STACK_DEPTH - GetAutoNormal -> Just gl_AUTO_NORMAL - GetMap1Color4 -> Just gl_MAP1_COLOR_4 - GetMap1Index -> Just gl_MAP1_INDEX - GetMap1Normal -> Just gl_MAP1_NORMAL - GetMap1TextureCoord1 -> Just gl_MAP1_TEXTURE_COORD_1 - GetMap1TextureCoord2 -> Just gl_MAP1_TEXTURE_COORD_2 - GetMap1TextureCoord3 -> Just gl_MAP1_TEXTURE_COORD_3 - GetMap1TextureCoord4 -> Just gl_MAP1_TEXTURE_COORD_4 - GetMap1Vertex3 -> Just gl_MAP1_VERTEX_3 - GetMap1Vertex4 -> Just gl_MAP1_VERTEX_4 - GetMap2Color4 -> Just gl_MAP2_COLOR_4 - GetMap2Index -> Just gl_MAP2_INDEX - GetMap2Normal -> Just gl_MAP2_NORMAL - GetMap2TextureCoord1 -> Just gl_MAP2_TEXTURE_COORD_1 - GetMap2TextureCoord2 -> Just gl_MAP2_TEXTURE_COORD_2 - GetMap2TextureCoord3 -> Just gl_MAP2_TEXTURE_COORD_3 - GetMap2TextureCoord4 -> Just gl_MAP2_TEXTURE_COORD_4 - GetMap2Vertex3 -> Just gl_MAP2_VERTEX_3 - GetMap2Vertex4 -> Just gl_MAP2_VERTEX_4 - GetMap1GridDomain -> Just gl_MAP1_GRID_DOMAIN - GetMap1GridSegments -> Just gl_MAP1_GRID_SEGMENTS - GetMap2GridDomain -> Just gl_MAP2_GRID_DOMAIN - GetMap2GridSegments -> Just gl_MAP2_GRID_SEGMENTS - GetTexture1D -> Just gl_TEXTURE_1D - GetTexture2D -> Just gl_TEXTURE_2D - GetFeedbackBufferSize -> Just gl_FEEDBACK_BUFFER_SIZE - GetFeedbackBufferType -> Just gl_FEEDBACK_BUFFER_TYPE - GetSelectionBufferSize -> Just gl_SELECTION_BUFFER_SIZE - GetPolygonOffsetUnits -> Just gl_POLYGON_OFFSET_UNITS - GetPolygonOffsetPoint -> Just gl_POLYGON_OFFSET_POINT - GetPolygonOffsetLine -> Just gl_POLYGON_OFFSET_LINE - GetPolygonOffsetFill -> Just gl_POLYGON_OFFSET_FILL - GetPolygonOffsetFactor -> Just gl_POLYGON_OFFSET_FACTOR - GetTextureBinding1D -> Just gl_TEXTURE_BINDING_1D - GetTextureBinding2D -> Just gl_TEXTURE_BINDING_2D - GetTextureBinding3D -> Just gl_TEXTURE_BINDING_3D - GetVertexArray -> Just gl_VERTEX_ARRAY - GetNormalArray -> Just gl_NORMAL_ARRAY - GetColorArray -> Just gl_COLOR_ARRAY - GetIndexArray -> Just gl_INDEX_ARRAY - GetTextureCoordArray -> Just gl_TEXTURE_COORD_ARRAY - GetEdgeFlagArray -> Just gl_EDGE_FLAG_ARRAY - GetFogCoordArray -> Just gl_FOG_COORD_ARRAY - GetSecondaryColorArray -> Just gl_SECONDARY_COLOR_ARRAY - GetMatrixIndexArray -> Just gl_MATRIX_INDEX_ARRAY - GetVertexArraySize -> Just gl_VERTEX_ARRAY_SIZE - GetVertexArrayType -> Just gl_VERTEX_ARRAY_TYPE - GetVertexArrayStride -> Just gl_VERTEX_ARRAY_STRIDE - GetNormalArrayType -> Just gl_NORMAL_ARRAY_TYPE - GetNormalArrayStride -> Just gl_NORMAL_ARRAY_STRIDE - GetColorArraySize -> Just gl_COLOR_ARRAY_SIZE - GetColorArrayType -> Just gl_COLOR_ARRAY_TYPE - GetColorArrayStride -> Just gl_COLOR_ARRAY_STRIDE - GetIndexArrayType -> Just gl_INDEX_ARRAY_TYPE - GetIndexArrayStride -> Just gl_INDEX_ARRAY_STRIDE - GetTextureCoordArraySize -> Just gl_TEXTURE_COORD_ARRAY_SIZE - GetTextureCoordArrayType -> Just gl_TEXTURE_COORD_ARRAY_TYPE - GetTextureCoordArrayStride -> Just gl_TEXTURE_COORD_ARRAY_STRIDE - GetEdgeFlagArrayStride -> Just gl_EDGE_FLAG_ARRAY_STRIDE - GetFogCoordArrayType -> Just gl_FOG_COORD_ARRAY_TYPE - GetFogCoordArrayStride -> Just gl_FOG_COORD_ARRAY_STRIDE - GetSecondaryColorArraySize -> Just gl_SECONDARY_COLOR_ARRAY_SIZE - GetSecondaryColorArrayType -> Just gl_SECONDARY_COLOR_ARRAY_TYPE - GetSecondaryColorArrayStride -> Just gl_SECONDARY_COLOR_ARRAY_STRIDE - GetMatrixIndexArraySize -> Just gl_MATRIX_INDEX_ARRAY_SIZE - GetMatrixIndexArrayType -> Just gl_MATRIX_INDEX_ARRAY_TYPE - GetMatrixIndexArrayStride -> Just gl_MATRIX_INDEX_ARRAY_STRIDE - GetClipPlane i -> clipPlaneIndexToEnum i - GetLight i -> lightIndexToEnum i - GetTransposeModelviewMatrix -> Just gl_TRANSPOSE_MODELVIEW_MATRIX - GetTransposeProjectionMatrix -> Just gl_TRANSPOSE_PROJECTION_MATRIX - GetTransposeTextureMatrix -> Just gl_TRANSPOSE_TEXTURE_MATRIX - GetTransposeColorMatrix -> Just gl_TRANSPOSE_COLOR_MATRIX - GetLightModelColorControl -> Just gl_LIGHT_MODEL_COLOR_CONTROL - GetBlendColor -> Just gl_BLEND_COLOR - GetBlendEquation -> Just gl_BLEND_EQUATION_RGB - GetBlendEquationAlpha -> Just gl_BLEND_EQUATION_ALPHA - GetColorTable -> Just gl_COLOR_TABLE - GetPostConvolutionColorTable -> Just gl_POST_CONVOLUTION_COLOR_TABLE - GetPostColorMatrixColorTable -> Just gl_POST_COLOR_MATRIX_COLOR_TABLE - GetConvolution1D -> Just gl_CONVOLUTION_1D - GetConvolution2D -> Just gl_CONVOLUTION_2D - GetSeparable2D -> Just gl_SEPARABLE_2D - GetMaxConvolutionWidth -> Just gl_MAX_CONVOLUTION_WIDTH - GetMaxConvolutionHeight -> Just gl_MAX_CONVOLUTION_HEIGHT - GetPostConvolutionRedScale -> Just gl_POST_CONVOLUTION_RED_SCALE - GetPostConvolutionGreenScale -> Just gl_POST_CONVOLUTION_GREEN_SCALE - GetPostConvolutionBlueScale -> Just gl_POST_CONVOLUTION_BLUE_SCALE - GetPostConvolutionAlphaScale -> Just gl_POST_CONVOLUTION_ALPHA_SCALE - GetPostConvolutionRedBias -> Just gl_POST_CONVOLUTION_RED_BIAS - GetPostConvolutionGreenBias -> Just gl_POST_CONVOLUTION_GREEN_BIAS - GetPostConvolutionBlueBias -> Just gl_POST_CONVOLUTION_BLUE_BIAS - GetPostConvolutionAlphaBias -> Just gl_POST_CONVOLUTION_ALPHA_BIAS - GetHistogram -> Just gl_HISTOGRAM - GetMinmax -> Just gl_MINMAX - GetColorSum -> Just gl_COLOR_SUM - GetCurrentSecondaryColor -> Just gl_CURRENT_SECONDARY_COLOR - GetRescaleNormal -> Just gl_RESCALE_NORMAL - GetSharedTexturePalette -> Just gl_SHARED_TEXTURE_PALETTE - GetTexture3DBinding -> Just gl_TEXTURE_BINDING_3D - GetPackSkipImages -> Just gl_PACK_SKIP_IMAGES - GetPackImageHeight -> Just gl_PACK_IMAGE_HEIGHT - GetUnpackSkipImages -> Just gl_UNPACK_SKIP_IMAGES - GetUnpackImageHeight -> Just gl_UNPACK_IMAGE_HEIGHT - GetTexture3D -> Just gl_TEXTURE_3D - GetMax3DTextureSize -> Just gl_MAX_3D_TEXTURE_SIZE - GetMaxTextureLODBias -> Just gl_MAX_TEXTURE_LOD_BIAS - GetMaxTextureMaxAnisotropy -> Just gl_MAX_TEXTURE_MAX_ANISOTROPY - GetMultisample -> Just gl_MULTISAMPLE - GetSampleAlphaToCoverage -> Just gl_SAMPLE_ALPHA_TO_COVERAGE - GetSampleAlphaToOne -> Just gl_SAMPLE_ALPHA_TO_ONE - GetSampleCoverage -> Just gl_SAMPLE_COVERAGE - GetSampleBuffers -> Just gl_SAMPLE_BUFFERS - GetSamples -> Just gl_SAMPLES - GetSampleCoverageValue -> Just gl_SAMPLE_COVERAGE_VALUE - GetSampleCoverageInvert -> Just gl_SAMPLE_COVERAGE_INVERT - GetPointSizeMin -> Just gl_POINT_SIZE_MIN - GetPointSizeMax -> Just gl_POINT_SIZE_MAX - GetPointFadeThresholdSize -> Just gl_POINT_FADE_THRESHOLD_SIZE - GetPointDistanceAttenuation -> Just gl_POINT_DISTANCE_ATTENUATION - GetColorMatrix -> Just gl_COLOR_MATRIX - GetColorMatrixStackDepth -> Just gl_COLOR_MATRIX_STACK_DEPTH - GetMaxColorMatrixStackDepth -> Just gl_MAX_COLOR_MATRIX_STACK_DEPTH - GetPostColorMatrixRedScale -> Just gl_POST_COLOR_MATRIX_RED_SCALE - GetPostColorMatrixGreenScale -> Just gl_POST_COLOR_MATRIX_GREEN_SCALE - GetPostColorMatrixBlueScale -> Just gl_POST_COLOR_MATRIX_BLUE_SCALE - GetPostColorMatrixAlphaScale -> Just gl_POST_COLOR_MATRIX_ALPHA_SCALE - GetPostColorMatrixRedBias -> Just gl_POST_COLOR_MATRIX_RED_BIAS - GetPostColorMatrixGreenBias -> Just gl_POST_COLOR_MATRIX_GREEN_BIAS - GetPostColorMatrixBlueBias -> Just gl_POST_COLOR_MATRIX_BLUE_BIAS - GetPostColorMatrixAlphaBias -> Just gl_POST_COLOR_MATRIX_ALPHA_BIAS - GetMaxElementsVertices -> Just gl_MAX_ELEMENTS_VERTICES - GetMaxElementsIndices -> Just gl_MAX_ELEMENTS_INDICES - GetActiveTexture -> Just gl_ACTIVE_TEXTURE - GetClientActiveTexture -> Just gl_CLIENT_ACTIVE_TEXTURE - GetMaxTextureUnits -> Just gl_MAX_TEXTURE_UNITS - GetTextureCubeMap -> Just gl_TEXTURE_CUBE_MAP - GetMaxCubeMapTextureSize -> Just gl_MAX_CUBE_MAP_TEXTURE_SIZE - GetMaxRectangleTextureSize -> Just gl_MAX_RECTANGLE_TEXTURE_SIZE - GetNumCompressedTextureFormats -> Just gl_NUM_COMPRESSED_TEXTURE_FORMATS - GetCompressedTextureFormats -> Just gl_COMPRESSED_TEXTURE_FORMATS - GetMaxVertexUnits -> Just gl_MAX_VERTEX_UNITS - GetActiveVertexUnits -> Just gl_ACTIVE_VERTEX_UNITS - GetWeightSumUnity -> Just gl_WEIGHT_SUM_UNITY - GetVertexBlend -> Just gl_VERTEX_BLEND - GetModelview i -> modelviewIndexToEnum i - GetCurrentWeight -> Just gl_CURRENT_WEIGHT - GetWeightArrayType -> Just gl_WEIGHT_ARRAY_TYPE - GetWeightArrayStride -> Just gl_WEIGHT_ARRAY_STRIDE - GetWeightArraySize -> Just gl_WEIGHT_ARRAY_SIZE - GetWeightArray -> Just gl_WEIGHT_ARRAY - GetMatrixPalette -> Just gl_MATRIX_PALETTE - GetMaxMatrixPaletteStackDepth -> Just gl_MAX_MATRIX_PALETTE_STACK_DEPTH - GetMaxPaletteMatrices -> Just gl_MAX_PALETTE_MATRICES - GetCurrentPaletteMatrix -> Just gl_CURRENT_PALETTE_MATRIX - GetBlendDstRGB -> Just gl_BLEND_DST_RGB - GetBlendSrcRGB -> Just gl_BLEND_SRC_RGB - GetBlendDstAlpha -> Just gl_BLEND_DST_ALPHA - GetBlendSrcAlpha -> Just gl_BLEND_SRC_ALPHA - GetPackCMYKHint -> Just gl_PACK_CMYK_HINT - GetUnpackCMYKHint -> Just gl_UNPACK_CMYK_HINT - GetArrayElementLockFirst -> Just gl_ARRAY_ELEMENT_LOCK_FIRST - GetArrayElementLockCount -> Just gl_ARRAY_ELEMENT_LOCK_COUNT - GetMaxShininess -> Just gl_MAX_SHININESS - GetMaxSpotExponent -> Just gl_MAX_SPOT_EXPONENT - GetFogDistanceMode -> Just gl_FOG_DISTANCE_MODE - GetDepthBounds -> Just gl_DEPTH_BOUNDS - GetPrimitiveRestartIndex -> Just gl_PRIMITIVE_RESTART_INDEX - GetPrimitiveRestartNV -> Just gl_PRIMITIVE_RESTART_NV - GetPrimitiveRestartIndexNV -> Just gl_PRIMITIVE_RESTART_INDEX_NV - GetActiveStencilFace -> Just gl_ACTIVE_STENCIL_FACE - GetArrayBufferBinding -> Just gl_ARRAY_BUFFER_BINDING - GetElementArrayBufferBinding -> Just gl_ELEMENT_ARRAY_BUFFER_BINDING - GetVertexArrayBufferBinding -> Just gl_VERTEX_ARRAY_BUFFER_BINDING - GetNormalArrayBufferBinding -> Just gl_NORMAL_ARRAY_BUFFER_BINDING - GetColorArrayBufferBinding -> Just gl_COLOR_ARRAY_BUFFER_BINDING - GetIndexArrayBufferBinding -> Just gl_INDEX_ARRAY_BUFFER_BINDING - GetTextureCoordArrayBufferBinding -> Just gl_TEXTURE_COORD_ARRAY_BUFFER_BINDING - GetEdgeFlagArrayBufferBinding -> Just gl_EDGE_FLAG_ARRAY_BUFFER_BINDING - GetSecondaryColorArrayBufferBinding -> Just gl_SECONDARY_COLOR_ARRAY_BUFFER_BINDING - GetFogCoordArrayBufferBinding -> Just gl_FOG_COORD_ARRAY_BUFFER_BINDING - GetTextureBindingCubeMap -> Just gl_TEXTURE_BINDING_CUBE_MAP - GetTextureBindingRectangle -> Just gl_TEXTURE_BINDING_RECTANGLE - GetCurrentMatrix -> Just gl_CURRENT_MATRIX - GetCurrentMatrixStackDepth -> Just gl_CURRENT_MATRIX_STACK_DEPTH - GetMaxCombinedTextureImageUnits -> Just gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS - GetMaxDrawBuffers -> Just gl_MAX_DRAW_BUFFERS - GetMaxFragmentUniformComponents -> Just gl_MAX_FRAGMENT_UNIFORM_COMPONENTS - GetMaxTextureCoords -> Just gl_MAX_TEXTURE_COORDS - GetMaxTextureImageUnits -> Just gl_MAX_TEXTURE_IMAGE_UNITS - GetMaxVaryingFloats -> Just gl_MAX_VARYING_COMPONENTS - GetMaxVertexAttribs -> Just gl_MAX_VERTEX_ATTRIBS - GetMaxVertexTextureImageUnits -> Just gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS - GetMaxVertexUniformComponents -> Just gl_MAX_VERTEX_UNIFORM_COMPONENTS - GetCurrentProgram -> Just gl_CURRENT_PROGRAM - GetPixelPackBufferBinding -> Just gl_PIXEL_PACK_BUFFER_BINDING - GetPixelUnpackBufferBinding -> Just gl_PIXEL_UNPACK_BUFFER_BINDING - GetDrawBufferN i -> drawBufferIndexToEnum i - GetRGBASignedComponents -> Just gl_RGBA_SIGNED_COMPONENTS - GetCopyReadBuffer -> Just gl_COPY_READ_BUFFER - GetCopyWriteBuffer -> Just gl_COPY_WRITE_BUFFER - -- GetWeightArrayBufferBinding -> Just gl_WEIGHT_ARRAY_BUFFER_BINDING - GetContextProfileMask -> Just gl_CONTEXT_PROFILE_MASK - --------------------------------------------------------------------------------- - --- 0x3000 through 0x3FFF are reserved for clip planes - -clipPlaneIndexToEnum :: GLsizei -> Maybe GLenum -clipPlaneIndexToEnum i - | 0 <= i && i <= maxClipPlaneIndex = Just (gl_CLIP_DISTANCE0 + fromIntegral i) - | otherwise = Nothing - -maxClipPlaneIndex :: GLsizei -maxClipPlaneIndex = 0xFFF - --------------------------------------------------------------------------------- - --- 0x4000 through 0x4FFF are reserved for light numbers - -lightIndexToEnum :: GLsizei -> Maybe GLenum -lightIndexToEnum i - | 0 <= i && i <= maxLightIndex = Just (gl_LIGHT0 + fromIntegral i) - | otherwise = Nothing - -maxLightIndex :: GLsizei -maxLightIndex = 0xFFF - --------------------------------------------------------------------------------- - --- 0x1700, 0x850a, and 0x8722 through 0x873f are reserved for modelview matrices - -modelviewIndexToEnum :: GLsizei -> Maybe GLenum -modelviewIndexToEnum 0 = Just gl_MODELVIEW -modelviewIndexToEnum 1 = Just gl_MODELVIEW1 -modelviewIndexToEnum i - | 2 <= i && i <= 31 = Just (gl_MODELVIEW2 - 2 + fromIntegral i) - | otherwise = Nothing - -modelviewEnumToIndex :: GLenum -> Maybe GLsizei -modelviewEnumToIndex x - | x == gl_MODELVIEW = Just 0 - | x == gl_MODELVIEW1 = Just 1 - | gl_MODELVIEW2 <= x && x <= gl_MODELVIEW31 = Just (fromIntegral (x - (gl_MODELVIEW2 - 2))) - | otherwise = Nothing - --------------------------------------------------------------------------------- - --- 0x8825 through 0x8834 are reserved for draw buffers - -drawBufferIndexToEnum :: GLsizei -> Maybe GLenum -drawBufferIndexToEnum i - | 0 <= i && i <= maxDrawBufferIndex = Just (gl_DRAW_BUFFER0 + fromIntegral i) - | otherwise = Nothing - -maxDrawBufferIndex :: GLsizei -maxDrawBufferIndex = fromIntegral (gl_DRAW_BUFFER15 - gl_DRAW_BUFFER0) - --------------------------------------------------------------------------------- - -getBoolean1 :: (GLboolean -> a) -> GetPName -> IO a -getBoolean1 f n = alloca $ \buf -> do - getBooleanv n buf - peek1 f buf - -getBoolean4 :: (GLboolean -> GLboolean -> GLboolean -> GLboolean -> a) - -> GetPName -> IO a -getBoolean4 f n = allocaArray 4 $ \buf -> do - getBooleanv n buf - peek4 f buf - -getBooleanv :: GetPName -> Ptr GLboolean -> IO () -getBooleanv = makeGetter glGetBooleanv - -{-# INLINE makeGetter #-} -makeGetter :: (GLenum -> Ptr a -> IO ()) -> GetPName -> Ptr a -> IO () -makeGetter f = maybe (const recordInvalidEnum) f . marshalGetPName - --------------------------------------------------------------------------------- - -getInteger1 :: (GLint -> a) -> GetPName -> IO a -getInteger1 f n = alloca $ \buf -> do - getIntegerv n buf - peek1 f buf - -getInteger2 :: (GLint -> GLint -> a) -> GetPName -> IO a -getInteger2 f n = allocaArray 2 $ \buf -> do - getIntegerv n buf - peek2 f buf - -getInteger4 :: (GLint -> GLint -> GLint -> GLint -> a) -> GetPName -> IO a -getInteger4 f n = allocaArray 4 $ \buf -> do - getIntegerv n buf - peek4 f buf - -getIntegerv :: GetPName -> Ptr GLint -> IO () -getIntegerv = maybe (const recordInvalidEnum) glGetIntegerv . marshalGetPName - --------------------------------------------------------------------------------- - -getEnum1 :: (GLenum -> a) -> GetPName -> IO a -getEnum1 f n = alloca $ \buf -> do - getIntegerv n buf - peek1 f (castPtr buf) - --------------------------------------------------------------------------------- - -getSizei1 :: (GLsizei -> a) -> GetPName -> IO a -getSizei1 f n = alloca $ \buf -> do - getIntegerv n buf - peek1 f (castPtr buf) - -getSizei2 :: (GLsizei -> GLsizei -> a) -> GetPName -> IO a -getSizei2 f n = allocaArray 2 $ \buf -> do - getIntegerv n buf - peek2 f (castPtr buf) - --------------------------------------------------------------------------------- - -getFloat1 :: (GLfloat -> a) -> GetPName -> IO a -getFloat1 f n = alloca $ \buf -> do - getFloatv n buf - peek1 f buf - -getFloat2 :: (GLfloat -> GLfloat -> a) -> GetPName -> IO a -getFloat2 f n = allocaArray 2 $ \buf -> do - getFloatv n buf - peek2 f buf - -getFloat3 :: (GLfloat -> GLfloat -> GLfloat -> a) -> GetPName -> IO a -getFloat3 f n = allocaArray 3 $ \buf -> do - getFloatv n buf - peek3 f buf - -getFloat4 :: - (GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> GetPName -> IO a -getFloat4 f n = allocaArray 4 $ \buf -> do - getFloatv n buf - peek4 f buf - -getFloatv :: GetPName -> Ptr GLfloat -> IO () -getFloatv = maybe (const recordInvalidEnum) glGetFloatv . marshalGetPName - --------------------------------------------------------------------------------- - -getClampf1 :: (GLclampf -> a) -> GetPName -> IO a -getClampf1 f n = alloca $ \buf -> do - getFloatv n buf - peek1 f (castPtr buf) - -getClampf4 :: - (GLclampf -> GLclampf -> GLclampf -> GLclampf -> a) -> GetPName -> IO a -getClampf4 f n = allocaArray 4 $ \buf -> do - getFloatv n buf - peek4 f (castPtr buf) - --------------------------------------------------------------------------------- - -getDouble1 :: (GLdouble -> a) -> GetPName -> IO a -getDouble1 f n = alloca $ \buf -> do - getDoublev n buf - peek1 f buf - -getDouble2 :: (GLdouble -> GLdouble -> a) -> GetPName -> IO a -getDouble2 f n = allocaArray 2 $ \buf -> do - getDoublev n buf - peek2 f buf - -getDouble4 :: - (GLdouble -> GLdouble -> GLdouble -> GLdouble -> a) -> GetPName -> IO a -getDouble4 f n = allocaArray 4 $ \buf -> do - getDoublev n buf - peek4 f buf - -getDoublev :: GetPName -> Ptr GLdouble -> IO () -getDoublev = maybe (const recordInvalidEnum) glGetDoublev . marshalGetPName - --------------------------------------------------------------------------------- - -getClampd1 :: (GLclampd -> a) -> GetPName -> IO a -getClampd1 f n = alloca $ \buf -> do - getDoublev n buf - peek1 f (castPtr buf) - -getClampd2 :: (GLclampd -> GLclampd -> a) -> GetPName -> IO a -getClampd2 f n = allocaArray 2 $ \buf -> do - getDoublev n buf - peek2 f (castPtr buf) - --------------------------------------------------------------------------------- - -maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b -maybeNullPtr n f ptr | ptr == nullPtr = n - | otherwise = f ptr --------------------------------------------------------------------------------- - -newtype AttribLocation = AttribLocation GLuint - deriving ( Eq, Ord, Show ) - --------------------------------------------------------------------------------- - -data GetVertexAttribPName = - GetVertexAttribArrayEnabled - | GetVertexAttribArraySize - | GetVertexAttribArrayStride - | GetVertexAttribArrayType - | GetVertexAttribArrayNormalized - | GetCurrentVertexAttrib - | GetVertexAttribArrayBufferBinding - | GetVertexAttribArrayInteger - -marshalGetVertexAttribPName :: GetVertexAttribPName -> GLenum -marshalGetVertexAttribPName x = case x of - GetVertexAttribArrayEnabled -> gl_VERTEX_ATTRIB_ARRAY_ENABLED - GetVertexAttribArraySize -> gl_VERTEX_ATTRIB_ARRAY_SIZE - GetVertexAttribArrayStride -> gl_VERTEX_ATTRIB_ARRAY_STRIDE - GetVertexAttribArrayType -> gl_VERTEX_ATTRIB_ARRAY_TYPE - GetVertexAttribArrayNormalized -> gl_VERTEX_ATTRIB_ARRAY_NORMALIZED - GetCurrentVertexAttrib -> gl_CURRENT_VERTEX_ATTRIB - GetVertexAttribArrayBufferBinding -> gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING - GetVertexAttribArrayInteger -> gl_VERTEX_ATTRIB_ARRAY_INTEGER - --------------------------------------------------------------------------------- - -getVertexAttribInteger1 :: (GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b -getVertexAttribInteger1 f (AttribLocation location) n = alloca $ \buf -> do - glGetVertexAttribiv location (marshalGetVertexAttribPName n) buf - peek1 f buf - -getVertexAttribEnum1 :: (GLenum -> b) -> AttribLocation -> GetVertexAttribPName -> IO b -getVertexAttribEnum1 f = getVertexAttribInteger1 (f . fromIntegral) - -getVertexAttribBoolean1 :: (GLboolean -> b) -> AttribLocation -> GetVertexAttribPName -> IO b -getVertexAttribBoolean1 f = getVertexAttribInteger1 (f . fromIntegral) - -getVertexAttribFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> b) -> AttribLocation -> GetVertexAttribPName -> IO b -getVertexAttribFloat4 f (AttribLocation location) n = alloca $ \buf -> do - glGetVertexAttribfv location (marshalGetVertexAttribPName n) buf - peek4 f buf - -getVertexAttribIInteger4 :: (GLint -> GLint -> GLint -> GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b -getVertexAttribIInteger4 f (AttribLocation location) n = alloca $ \buf -> do - glGetVertexAttribIiv location (marshalGetVertexAttribPName n) buf - peek4 f buf - -getVertexAttribIuInteger4 :: (GLuint -> GLuint -> GLuint -> GLuint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b -getVertexAttribIuInteger4 f (AttribLocation location) n = alloca $ \buf -> do - glGetVertexAttribIuiv location (marshalGetVertexAttribPName n) buf - peek4 f buf - --------------------------------------------------------------------------------- - -data GetVertexAttribPointerPName = - VertexAttribArrayPointer - -marshalGetVertexAttribPointerPName :: GetVertexAttribPointerPName -> GLenum -marshalGetVertexAttribPointerPName x = case x of - VertexAttribArrayPointer -> gl_VERTEX_ATTRIB_ARRAY_POINTER - --------------------------------------------------------------------------------- - -getVertexAttribPointer :: AttribLocation -> GetVertexAttribPointerPName -> IO (Ptr a) -getVertexAttribPointer (AttribLocation location) n = alloca $ \buf -> do - glGetVertexAttribPointerv location (marshalGetVertexAttribPointerPName n) buf - peek buf +-- +-- Maintainer : sven.panne@aedion.de +-- Stability : stable +-- Portability : portable +-- +-- This is a purely internal module with utilities to query OpenGL state. +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.QueryUtils ( + module Graphics.Rendering.OpenGL.GL.QueryUtils.PName, + module Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib, + + lightIndexToEnum, + modelviewIndexToEnum, modelviewEnumToIndex, + + maybeNullPtr, +) where + +import Foreign.Ptr +import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( + gl_LIGHT0, gl_MODELVIEW) +import Graphics.Rendering.OpenGL.Raw.ARB.VertexBlend ( + gl_MODELVIEW1, gl_MODELVIEW2, gl_MODELVIEW31 ) +import Graphics.Rendering.OpenGL.Raw.Core32 + +import Graphics.Rendering.OpenGL.GL.QueryUtils.PName +import Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib + +-------------------------------------------------------------------------------- + +--data GetPNameO = +-- GetCurrentMatrixIndex +-- | GetPointSmooth +-- | GetPointSizeRange +-- | GetPointSizeGranularity +-- | GetLineSmooth +-- | GetLineWidthRange +-- | GetLineWidthGranularity +-- | GetLineStipple +-- | GetPolygonSmooth +-- | GetPolygonStipple +-- | GetCullFace +-- | GetLighting +-- | GetFog +-- | GetDepthTest +-- | GetStencilTest +-- | GetNormalize +-- | GetAttribStackDepth +-- | GetClientAttribStackDepth +-- | GetAlphaTest +-- | GetDither +-- | GetBlend +-- | GetIndexLogicOp +-- | GetLogicOp +-- | GetColorLogicOp +-- | GetScissorTest +-- | GetIndexMode +-- | GetTextureGenS +-- | GetTextureGenT +-- | GetTextureGenR +-- | GetTextureGenQ +-- | GetMaxClipDistances +-- | GetMaxAttribStackDepth +-- | GetMaxClientAttribStackDepth +-- | GetIndexBits +-- | GetAutoNormal +-- | GetMap1Color4 +-- | GetMap1Index +-- | GetMap1Normal +-- | GetMap1TextureCoord1 +-- | GetMap1TextureCoord2 +-- | GetMap1TextureCoord3 +-- | GetMap1TextureCoord4 +-- | GetMap1Vertex3 +-- | GetMap1Vertex4 +-- | GetMap2Color4 +-- | GetMap2Index +-- | GetMap2Normal +-- | GetMap2TextureCoord1 +-- | GetMap2TextureCoord2 +-- | GetMap2TextureCoord3 +-- | GetMap2TextureCoord4 +-- | GetMap2Vertex3 +-- | GetMap2Vertex4 +-- | GetTexture1D +-- | GetTexture2D +-- | GetFeedbackBufferSize +-- | GetFeedbackBufferType +-- | GetSelectionBufferSize +-- | GetPolygonOffsetPoint +-- | GetPolygonOffsetLine +-- | GetPolygonOffsetFill +-- | GetVertexArray +-- | GetNormalArray +-- | GetColorArray +-- | GetIndexArray +-- | GetTextureCoordArray +-- | GetEdgeFlagArray +-- | GetFogCoordArray +-- | GetSecondaryColorArray +-- | GetMatrixIndexArray +-- | GetMatrixIndexArraySize +-- | GetMatrixIndexArrayType +-- | GetMatrixIndexArrayStride +-- | GetClipDistance GLsizei +-- | GetLight GLsizei +-- | GetTransposeModelviewMatrix +-- | GetTransposeProjectionMatrix +-- | GetTransposeTextureMatrix +-- | GetTransposeColorMatrix +-- | GetColorTable +-- | GetPostConvolutionColorTable +-- | GetPostColorMatrixColorTable +-- | GetConvolution1D +-- | GetConvolution2D +-- | GetSeparable2D +-- | GetMaxConvolutionWidth +-- | GetMaxConvolutionHeight +-- | GetHistogram +-- | GetMinmax +-- | GetColorSum +-- | GetRescaleNormal +-- | GetSharedTexturePalette +-- | GetTexture3DBinding +-- | GetTexture3D +-- | GetMultisample +-- | GetSampleAlphaToCoverage +-- | GetSampleAlphaToOne +-- | GetSampleCoverage +-- | GetTextureCubeMap +-- | GetMaxVertexUnits +-- | GetActiveVertexUnits +-- | GetWeightSumUnity +-- | GetVertexBlend +-- | GetModelview GLsizei +-- | GetCurrentWeight +-- | GetWeightArrayType +-- | GetWeightArrayStride +-- | GetWeightArraySize +-- | GetWeightArray +-- | GetMaxPaletteMatrices +-- | GetCurrentPaletteMatrix +-- | GetCurrentMatrix +-- | GetMaxVaryingComponents +-- | GetColorMaterial +-- -- GetWeightArrayBufferBinding +-- -- transform feedback stuff +-- -- FramebufferObject +-- -- RenderbufferObject +-- -- Color clamping +-- -- VertexArrayObject +-- +--_marshalGetPNameO :: GetPNameO -> Maybe GLenum +--_marshalGetPNameO x = case x of +-- GetCurrentMatrixIndex -> Just gl_CURRENT_MATRIX_INDEX +-- GetPointSmooth -> Just gl_POINT_SMOOTH +-- GetPointSizeRange -> Just gl_POINT_SIZE_RANGE +-- GetPointSizeGranularity -> Just gl_POINT_SIZE_GRANULARITY +-- GetLineSmooth -> Just gl_LINE_SMOOTH +-- GetLineWidthRange -> Just gl_SMOOTH_LINE_WIDTH_RANGE +-- GetLineWidthGranularity -> Just gl_SMOOTH_LINE_WIDTH_GRANULARITY +-- GetLineStipple -> Just gl_LINE_STIPPLE +-- GetPolygonSmooth -> Just gl_POLYGON_SMOOTH +-- GetPolygonStipple -> Just gl_POLYGON_STIPPLE +-- GetCullFace -> Just gl_CULL_FACE +-- GetLighting -> Just gl_LIGHTING +-- GetFog -> Just gl_FOG +-- GetDepthTest -> Just gl_DEPTH_TEST +-- GetStencilTest -> Just gl_STENCIL_TEST +-- GetPolygonOffsetPoint -> Just gl_POLYGON_OFFSET_POINT +-- GetNormalize -> Just gl_NORMALIZE +-- GetAttribStackDepth -> Just gl_ATTRIB_STACK_DEPTH +-- GetClientAttribStackDepth -> Just gl_CLIENT_ATTRIB_STACK_DEPTH +-- GetAlphaTest -> Just gl_ALPHA_TEST +-- GetDither -> Just gl_DITHER +-- GetBlend -> Just gl_BLEND +-- GetIndexLogicOp -> Just gl_INDEX_LOGIC_OP +-- GetLogicOp -> Just gl_INDEX_LOGIC_OP +-- GetColorLogicOp -> Just gl_COLOR_LOGIC_OP +-- GetScissorTest -> Just gl_SCISSOR_TEST +-- GetIndexMode -> Just gl_INDEX_MODE +-- GetTextureGenS -> Just gl_TEXTURE_GEN_S +-- GetTextureGenT -> Just gl_TEXTURE_GEN_T +-- GetTextureGenR -> Just gl_TEXTURE_GEN_R +-- GetTextureGenQ -> Just gl_TEXTURE_GEN_Q +-- GetMaxClipDistances -> Just gl_MAX_CLIP_DISTANCES +-- GetMaxAttribStackDepth -> Just gl_MAX_ATTRIB_STACK_DEPTH +-- GetMaxClientAttribStackDepth -> Just gl_MAX_CLIENT_ATTRIB_STACK_DEPTH +-- GetIndexBits -> Just gl_INDEX_BITS +-- GetAutoNormal -> Just gl_AUTO_NORMAL +-- GetMap1Color4 -> Just gl_MAP1_COLOR_4 +-- GetMap1Index -> Just gl_MAP1_INDEX +-- GetMap1Normal -> Just gl_MAP1_NORMAL +-- GetMap1TextureCoord1 -> Just gl_MAP1_TEXTURE_COORD_1 +-- GetMap1TextureCoord2 -> Just gl_MAP1_TEXTURE_COORD_2 +-- GetMap1TextureCoord3 -> Just gl_MAP1_TEXTURE_COORD_3 +-- GetMap1TextureCoord4 -> Just gl_MAP1_TEXTURE_COORD_4 +-- GetMap1Vertex3 -> Just gl_MAP1_VERTEX_3 +-- GetMap1Vertex4 -> Just gl_MAP1_VERTEX_4 +-- GetMap2Color4 -> Just gl_MAP2_COLOR_4 +-- GetMap2Index -> Just gl_MAP2_INDEX +-- GetMap2Normal -> Just gl_MAP2_NORMAL +-- GetMap2TextureCoord1 -> Just gl_MAP2_TEXTURE_COORD_1 +-- GetMap2TextureCoord2 -> Just gl_MAP2_TEXTURE_COORD_2 +-- GetMap2TextureCoord3 -> Just gl_MAP2_TEXTURE_COORD_3 +-- GetMap2TextureCoord4 -> Just gl_MAP2_TEXTURE_COORD_4 +-- GetMap2Vertex3 -> Just gl_MAP2_VERTEX_3 +-- GetMap2Vertex4 -> Just gl_MAP2_VERTEX_4 +-- GetTexture1D -> Just gl_TEXTURE_1D +-- GetTexture2D -> Just gl_TEXTURE_2D +-- GetFeedbackBufferSize -> Just gl_FEEDBACK_BUFFER_SIZE +-- GetFeedbackBufferType -> Just gl_FEEDBACK_BUFFER_TYPE +-- GetSelectionBufferSize -> Just gl_SELECTION_BUFFER_SIZE +-- GetPolygonOffsetLine -> Just gl_POLYGON_OFFSET_LINE +-- GetPolygonOffsetFill -> Just gl_POLYGON_OFFSET_FILL +-- GetVertexArray -> Just gl_VERTEX_ARRAY +-- GetNormalArray -> Just gl_NORMAL_ARRAY +-- GetColorArray -> Just gl_COLOR_ARRAY +-- GetIndexArray -> Just gl_INDEX_ARRAY +-- GetTextureCoordArray -> Just gl_TEXTURE_COORD_ARRAY +-- GetEdgeFlagArray -> Just gl_EDGE_FLAG_ARRAY +-- GetFogCoordArray -> Just gl_FOG_COORD_ARRAY +-- GetSecondaryColorArray -> Just gl_SECONDARY_COLOR_ARRAY +-- GetMatrixIndexArray -> Just gl_MATRIX_INDEX_ARRAY +-- GetMatrixIndexArraySize -> Just gl_MATRIX_INDEX_ARRAY_SIZE +-- GetMatrixIndexArrayType -> Just gl_MATRIX_INDEX_ARRAY_TYPE +-- GetMatrixIndexArrayStride -> Just gl_MATRIX_INDEX_ARRAY_STRIDE +-- GetClipDistance i -> clipPlaneIndexToEnum i +-- GetLight i -> lightIndexToEnum i +-- GetTransposeModelviewMatrix -> Just gl_TRANSPOSE_MODELVIEW_MATRIX +-- GetTransposeProjectionMatrix -> Just gl_TRANSPOSE_PROJECTION_MATRIX +-- GetTransposeTextureMatrix -> Just gl_TRANSPOSE_TEXTURE_MATRIX +-- GetTransposeColorMatrix -> Just gl_TRANSPOSE_COLOR_MATRIX +-- GetColorTable -> Just gl_COLOR_TABLE +-- GetPostConvolutionColorTable -> Just gl_POST_CONVOLUTION_COLOR_TABLE +-- GetPostColorMatrixColorTable -> Just gl_POST_COLOR_MATRIX_COLOR_TABLE +-- GetConvolution1D -> Just gl_CONVOLUTION_1D +-- GetConvolution2D -> Just gl_CONVOLUTION_2D +-- GetSeparable2D -> Just gl_SEPARABLE_2D +-- GetMaxConvolutionWidth -> Just gl_MAX_CONVOLUTION_WIDTH +-- GetMaxConvolutionHeight -> Just gl_MAX_CONVOLUTION_HEIGHT +-- GetHistogram -> Just gl_HISTOGRAM +-- GetMinmax -> Just gl_MINMAX +-- GetColorSum -> Just gl_COLOR_SUM +-- GetRescaleNormal -> Just gl_RESCALE_NORMAL +-- GetSharedTexturePalette -> Just gl_SHARED_TEXTURE_PALETTE +-- GetTexture3DBinding -> Just gl_TEXTURE_BINDING_3D +-- GetTexture3D -> Just gl_TEXTURE_3D +-- GetMultisample -> Just gl_MULTISAMPLE +-- GetSampleAlphaToCoverage -> Just gl_SAMPLE_ALPHA_TO_COVERAGE +-- GetSampleAlphaToOne -> Just gl_SAMPLE_ALPHA_TO_ONE +-- GetSampleCoverage -> Just gl_SAMPLE_COVERAGE +-- GetColorMaterial -> Just gl_COLOR_MATERIAL +-- GetTextureCubeMap -> Just gl_TEXTURE_CUBE_MAP +-- +-- GetMaxVertexUnits -> Just gl_MAX_VERTEX_UNITS +-- GetActiveVertexUnits -> Just gl_ACTIVE_VERTEX_UNITS +-- GetWeightSumUnity -> Just gl_WEIGHT_SUM_UNITY +-- GetVertexBlend -> Just gl_VERTEX_BLEND +-- GetModelview i -> modelviewIndexToEnum i +-- GetCurrentWeight -> Just gl_CURRENT_WEIGHT +-- GetWeightArrayType -> Just gl_WEIGHT_ARRAY_TYPE +-- GetWeightArrayStride -> Just gl_WEIGHT_ARRAY_STRIDE +-- GetWeightArraySize -> Just gl_WEIGHT_ARRAY_SIZE +-- GetWeightArray -> Just gl_WEIGHT_ARRAY +-- GetMaxPaletteMatrices -> Just gl_MAX_PALETTE_MATRICES +-- GetCurrentPaletteMatrix -> Just gl_CURRENT_PALETTE_MATRIX +-- GetCurrentMatrix -> Just gl_CURRENT_MATRIX +-- GetMaxVaryingComponents -> Just gl_MAX_VARYING_COMPONENTS + + -- GetWeightArrayBufferBinding -> Just gl_WEIGHT_ARRAY_BUFFER_BINDING + -- transform feedback + -- FramebufferObject + -- RenderbufferObject + -- Color clamping + -- VertexArrayObject + +-------------------------------------------------------------------------------- + +--data GetIndexedPName = +-- GetTransformFeedbackBuffer +-- | GetTransformFeedbackBufferStart +-- | GetTransformFeedbackBufferSize +-- +--marshalGetIndexedPName :: GetIndexedPName -> GLenum +--marshalGetIndexedPName x = case x of +-- GetTransformFeedbackBuffer -> gl_TRANSFORM_FEEDBACK_BUFFER +-- GetTransformFeedbackBufferSize -> gl_TRANSFORM_FEEDBACK_BUFFER_SIZE +-- GetTransformFeedbackBufferStart -> gl_TRANSFORM_FEEDBACK_BUFFER_START + +-------------------------------------------------------------------------------- + +-- 0x4000 through 0x4FFF are reserved for light numbers + +lightIndexToEnum :: GLsizei -> Maybe GLenum +lightIndexToEnum i + | 0 <= i && i <= maxLightIndex = Just (gl_LIGHT0 + fromIntegral i) + | otherwise = Nothing + +maxLightIndex :: GLsizei +maxLightIndex = 0xFFF + +-------------------------------------------------------------------------------- + +-- 0x1700, 0x850a, and 0x8722 through 0x873f are reserved for modelview matrices + +modelviewIndexToEnum :: GLsizei -> Maybe GLenum +modelviewIndexToEnum 0 = Just gl_MODELVIEW +modelviewIndexToEnum 1 = Just gl_MODELVIEW1 +modelviewIndexToEnum i + | 2 <= i && i <= 31 = Just (gl_MODELVIEW2 - 2 + fromIntegral i) + | otherwise = Nothing + +modelviewEnumToIndex :: GLenum -> Maybe GLsizei +modelviewEnumToIndex x + | x == gl_MODELVIEW = Just 0 + | x == gl_MODELVIEW1 = Just 1 + | gl_MODELVIEW2 <= x && x <= gl_MODELVIEW31 = Just (fromIntegral (x - (gl_MODELVIEW2 - 2))) + | otherwise = Nothing + + + +-------------------------------------------------------------------------------- + +maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b +maybeNullPtr n f ptr | ptr == nullPtr = n + | otherwise = f ptr +-------------------------------------------------------------------------------- diff --git a/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs b/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs @@ -0,0 +1,1159 @@ +-- #hide +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.QueryUtils.PName +-- Copyright : (c) Sven Panne 2002-2009, Lars Corbijn 2012 +-- License : BSD3 +-- +-- Maintainer : Jason Dagit , Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.QueryUtils.PName ( + GetPName(..), + GetPName1I(..), GetPName1F(..), GetIPName1I(..), + GetPName2I(..), GetPName2F(..), + GetPName3I(..), GetPName3F(..), + GetPName4I(..), GetPName4F(..), GetIPName4I(..), + GetPNameNI(..), + + PName1I(..), PName1F(..), IPName1I(..), + PName2I(..), PName2F(..), + PName3F(..), + PName4I(..), PName4F(..), PName4ISemiIndexed(..), + PNameNI(..), + + GetPNameMatrix(..), + PNameMatrix(..), + + clipPlaneIndexToEnum, +) where + +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable +import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.GLU.ErrorsInternal +import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( + gl_ACCUM_ALPHA_BITS, gl_ACCUM_BLUE_BITS, gl_ACCUM_CLEAR_VALUE, + gl_ACCUM_GREEN_BITS, gl_ACCUM_RED_BITS, gl_ALIASED_POINT_SIZE_RANGE, + gl_ALPHA_BIAS, gl_ALPHA_BITS, gl_ALPHA_SCALE, + gl_ALPHA_TEST_FUNC, gl_ALPHA_TEST_REF, + gl_AUX_BUFFERS, gl_BLUE_BIAS, gl_BLUE_BITS, gl_BLUE_SCALE, + gl_CLAMP_FRAGMENT_COLOR, gl_CLAMP_VERTEX_COLOR, + gl_CLIENT_ACTIVE_TEXTURE, + gl_COLOR_ARRAY_BUFFER_BINDING, gl_COLOR_ARRAY_SIZE, gl_COLOR_ARRAY_STRIDE, + gl_COLOR_ARRAY_TYPE, gl_COLOR_MATERIAL_FACE, + gl_COLOR_MATERIAL_PARAMETER, gl_COLOR_MATRIX, gl_COLOR_MATRIX_STACK_DEPTH, + gl_CURRENT_COLOR, gl_CURRENT_FOG_COORD, gl_CURRENT_INDEX, gl_CURRENT_NORMAL, + gl_CURRENT_RASTER_COLOR, gl_CURRENT_RASTER_DISTANCE, gl_CURRENT_RASTER_INDEX, + gl_CURRENT_RASTER_POSITION, gl_CURRENT_RASTER_POSITION_VALID, + gl_CURRENT_RASTER_SECONDARY_COLOR, gl_CURRENT_RASTER_TEXTURE_COORDS, + gl_CURRENT_SECONDARY_COLOR, gl_CURRENT_TEXTURE_COORDS, gl_DEPTH_BIAS, + gl_DEPTH_BITS, gl_DEPTH_SCALE, gl_EDGE_FLAG, + gl_EDGE_FLAG_ARRAY_BUFFER_BINDING, gl_EDGE_FLAG_ARRAY_STRIDE, + gl_FOG_COLOR, gl_FOG_COORD_ARRAY_BUFFER_BINDING, + gl_FOG_COORD_ARRAY_STRIDE, gl_FOG_COORD_ARRAY_TYPE, gl_FOG_COORD_SRC, + gl_FOG_DENSITY, gl_FOG_END, gl_FOG_HINT, gl_FOG_INDEX, gl_FOG_MODE, + gl_FOG_START, gl_GENERATE_MIPMAP_HINT, gl_GREEN_BIAS, gl_GREEN_BITS, + gl_GREEN_SCALE, gl_INDEX_ARRAY_BUFFER_BINDING, + gl_INDEX_ARRAY_STRIDE, gl_INDEX_ARRAY_TYPE, + gl_INDEX_CLEAR_VALUE, gl_INDEX_OFFSET, + gl_INDEX_SHIFT, gl_INDEX_WRITEMASK, + gl_LIGHT_MODEL_AMBIENT, gl_LIGHT_MODEL_COLOR_CONTROL, + gl_LIGHT_MODEL_LOCAL_VIEWER, gl_LIGHT_MODEL_TWO_SIDE, + gl_LINE_STIPPLE_PATTERN, gl_LINE_STIPPLE_REPEAT, gl_LIST_BASE, gl_LIST_INDEX, + gl_LIST_MODE, gl_MAP1_GRID_DOMAIN, gl_MAP1_GRID_SEGMENTS, + gl_MAP2_GRID_DOMAIN, gl_MAP2_GRID_SEGMENTS, gl_MAP_COLOR, + gl_MAP_STENCIL, gl_MATRIX_MODE, gl_MAX_COLOR_MATRIX_STACK_DEPTH, + gl_MAX_EVAL_ORDER, + gl_MAX_LIGHTS, gl_MAX_LIST_NESTING, gl_MAX_MODELVIEW_STACK_DEPTH, + gl_MAX_NAME_STACK_DEPTH, gl_MAX_PIXEL_MAP_TABLE, + gl_MAX_PROJECTION_STACK_DEPTH, gl_MAX_TEXTURE_COORDS, + gl_MAX_TEXTURE_STACK_DEPTH, gl_MAX_TEXTURE_UNITS, + gl_MODELVIEW_MATRIX, gl_MODELVIEW_STACK_DEPTH, gl_NAME_STACK_DEPTH, + gl_NORMAL_ARRAY_BUFFER_BINDING, + gl_NORMAL_ARRAY_STRIDE, gl_NORMAL_ARRAY_TYPE, gl_PERSPECTIVE_CORRECTION_HINT, + gl_PIXEL_MAP_A_TO_A_SIZE, gl_PIXEL_MAP_B_TO_B_SIZE, gl_PIXEL_MAP_G_TO_G_SIZE, + gl_PIXEL_MAP_I_TO_A_SIZE, gl_PIXEL_MAP_I_TO_B_SIZE, gl_PIXEL_MAP_I_TO_G_SIZE, + gl_PIXEL_MAP_I_TO_I_SIZE, gl_PIXEL_MAP_I_TO_R_SIZE, gl_PIXEL_MAP_R_TO_R_SIZE, + gl_PIXEL_MAP_S_TO_S_SIZE, gl_POINT_DISTANCE_ATTENUATION, gl_POINT_SIZE_MAX, + gl_POINT_SIZE_MIN, gl_POINT_SMOOTH_HINT, gl_POLYGON_MODE, + gl_POST_COLOR_MATRIX_ALPHA_BIAS, gl_POST_COLOR_MATRIX_ALPHA_SCALE, + gl_POST_COLOR_MATRIX_BLUE_BIAS, gl_POST_COLOR_MATRIX_BLUE_SCALE, + gl_POST_COLOR_MATRIX_GREEN_BIAS, gl_POST_COLOR_MATRIX_GREEN_SCALE, + gl_POST_COLOR_MATRIX_RED_BIAS, gl_POST_COLOR_MATRIX_RED_SCALE, + gl_POST_CONVOLUTION_ALPHA_BIAS, gl_POST_CONVOLUTION_ALPHA_SCALE, + gl_POST_CONVOLUTION_BLUE_BIAS, gl_POST_CONVOLUTION_BLUE_SCALE, + gl_POST_CONVOLUTION_GREEN_BIAS, + gl_POST_CONVOLUTION_GREEN_SCALE, gl_POST_CONVOLUTION_RED_BIAS, + gl_POST_CONVOLUTION_RED_SCALE, gl_PROJECTION_MATRIX, + gl_PROJECTION_STACK_DEPTH, gl_RED_BIAS, gl_RED_BITS, gl_RED_SCALE, + gl_RENDER_MODE, gl_RGBA_MODE, + gl_SECONDARY_COLOR_ARRAY_BUFFER_BINDING, gl_SECONDARY_COLOR_ARRAY_SIZE, + gl_SECONDARY_COLOR_ARRAY_STRIDE, gl_SECONDARY_COLOR_ARRAY_TYPE, + gl_SHADE_MODEL, gl_STENCIL_BITS, + gl_TEXTURE_COORD_ARRAY_BUFFER_BINDING, + gl_TEXTURE_COORD_ARRAY_SIZE, gl_TEXTURE_COORD_ARRAY_STRIDE, + gl_TEXTURE_COORD_ARRAY_TYPE, gl_TEXTURE_MATRIX, + gl_TEXTURE_STACK_DEPTH, gl_VERTEX_ARRAY_BUFFER_BINDING, + gl_VERTEX_ARRAY_SIZE, gl_VERTEX_ARRAY_STRIDE, gl_VERTEX_ARRAY_TYPE, + gl_ZOOM_X, gl_ZOOM_Y ) +import Graphics.Rendering.OpenGL.Raw.ARB.FragmentProgram ( + gl_CURRENT_MATRIX_STACK_DEPTH ) +import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette ( + gl_MATRIX_PALETTE, gl_MAX_MATRIX_PALETTE_STACK_DEPTH) +import Graphics.Rendering.OpenGL.Raw.Core32 +import Graphics.Rendering.OpenGL.Raw.EXT ( gl_RGBA_SIGNED_COMPONENTS ) +import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka ( gl_PACK_CMYK_HINT, gl_UNPACK_CMYK_HINT ) +import Graphics.Rendering.OpenGL.Raw.EXT.CompiledVertexArray ( gl_ARRAY_ELEMENT_LOCK_FIRST, gl_ARRAY_ELEMENT_LOCK_COUNT ) +import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( gl_DEPTH_BOUNDS, ) +import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( gl_ACTIVE_STENCIL_FACE ) +import Graphics.Rendering.OpenGL.Raw.EXT.TextureFilterAnisotropic ( gl_MAX_TEXTURE_MAX_ANISOTROPY ) +import Graphics.Rendering.OpenGL.Raw.NV.FogDistance ( gl_FOG_DISTANCE_MODE ) +import Graphics.Rendering.OpenGL.Raw.NV.LightMaxExponent ( gl_MAX_SHININESS, gl_MAX_SPOT_EXPONENT ) +import Graphics.Rendering.OpenGL.Raw.NV.PrimitiveRestart ( gl_PRIMITIVE_RESTART_INDEX_NV, gl_PRIMITIVE_RESTART_NV ) + +----------------------------------------------------------------------------- + +class GetPName p where + marshalGetPName :: p -> Maybe GLenum + +----------------------------------------------------------------------------- + +getIntegerv :: GetPName p => p -> Ptr GLint -> IO () +getIntegerv = maybe (const recordInvalidEnum) glGetIntegerv . marshalGetPName + +getFloatv :: GetPName p => p -> Ptr GLfloat -> IO () +getFloatv = maybe (const recordInvalidEnum) glGetFloatv . marshalGetPName + +getDoublev :: GetPName p => p -> Ptr GLdouble -> IO () +getDoublev = maybe (const recordInvalidEnum) glGetDoublev . marshalGetPName + +getBooleanv :: GetPName p => p-> Ptr GLboolean -> IO () +getBooleanv = makeGetter glGetBooleanv + +getBooleaniv :: GetPName p => p -> GLuint -> Ptr GLboolean -> IO () +getBooleaniv p i = makeGetter (\e -> glGetBooleani_v e i) p + +getIntegeriv :: GetPName p => p -> GLuint -> Ptr GLint -> IO () +getIntegeriv = maybe (\_ _ -> recordInvalidEnum) glGetIntegeri_v . marshalGetPName + +{-# INLINE makeGetter #-} +makeGetter :: GetPName p => (GLenum -> Ptr a -> IO ()) -> p -> Ptr a -> IO () +makeGetter f = maybe (const recordInvalidEnum) f . marshalGetPName + +----------------------------------------------------------------------------- + +class GetPName p => GetPName1I p where + getBoolean1 :: (GLboolean -> a) -> p -> IO a + getBoolean1 = get1 getBooleanv + getInteger1 :: (GLint -> a) -> p -> IO a + getInteger1 = get1 getIntegerv + + getEnum1 :: (GLenum -> a) -> p -> IO a + getEnum1 = get1 getIntegerv + getSizei1 :: (GLsizei -> a) -> p -> IO a + getSizei1 = get1 getIntegerv + +class GetPName p => GetPName1F p where + getFloat1 :: (GLfloat -> a) -> p -> IO a + getFloat1 = get1 getFloatv + + getClampf1 :: (GLclampf -> a) -> p -> IO a + getClampf1 = get1 getFloatv + + getDouble1 :: (GLdouble -> a) -> p -> IO a + getDouble1 = get1 getDoublev + getClampd1 :: (GLclampd -> a) -> p -> IO a + getClampd1 = get1 getDoublev + +-- | Helper function for the get*1 functions. +get1 :: (Storable b, Storable c, GetPName p) + => (p -> Ptr c -> IO ()) + -> (b -> a) -- ^ Conversion from the casted value to the return value + -> p -> IO a +get1 g f n = alloca $ \buf -> do + g n buf + peek1 f (castPtr buf) + +class GetPName p => GetIPName1I p where + getBoolean1i :: (GLboolean -> a) -> p -> GLuint -> IO a + getBoolean1i = get1i getBooleaniv + getInteger1i :: (GLint -> a) -> p -> GLuint -> IO a + getInteger1i = get1i getIntegeriv + + getEnum1i :: (GLenum -> a) -> p -> GLuint -> IO a + getEnum1i = get1i getIntegeriv + getSizei1i :: (GLsizei -> a) -> p -> GLuint -> IO a + getSizei1i = get1i getIntegeriv + + +-- Indexed helper +get1i :: (Storable b, Storable c, GetPName p) + => (p -> GLuint -> Ptr c -> IO ()) + -> (b -> a) -- ^ Conversion from the casted value to the return value + -> p -> GLuint -> IO a +get1i g f n i = alloca $ \buf -> do + g n i buf + peek1 f (castPtr buf) + +----------------------------------------------------------------------------- + +class GetPName p => GetPName2I p where + getBoolean2 :: (GLboolean -> GLboolean -> a) -> p -> IO a + getBoolean2 = get2 getBooleanv + getInteger2 :: (GLint -> GLint -> a) -> p -> IO a + getInteger2 = get2 getIntegerv + + getEnum2 :: (GLenum -> GLenum -> a) -> p -> IO a + getEnum2 = get2 getIntegerv + getSizei2 :: (GLsizei -> GLsizei -> a) -> p -> IO a + getSizei2 = get2 getIntegerv + +class GetPName p => GetPName2F p where + getFloat2 :: (GLfloat -> GLfloat -> a) -> p -> IO a + getFloat2 = get2 getFloatv + + getClampf2 :: (GLclampf -> GLclampf -> a) -> p -> IO a + getClampf2 = get2 getFloatv + + getDouble2 :: (GLdouble -> GLdouble -> a) -> p -> IO a + getDouble2 = get2 getDoublev + getClampd2 :: (GLclampd -> GLclampd -> a) -> p -> IO a + getClampd2 = get2 getDoublev + +-- | Helper function for the get*2 functions. +get2 :: (Storable b, Storable c, GetPName p) + => (p -> Ptr c -> IO ()) + -> (b -> b -> a) -- ^ Conversion from the casted value to the return value + -> p -> IO a +get2 g f n = allocaArray 2 $ \buf -> do + g n buf + peek2 f (castPtr buf) + +----------------------------------------------------------------------------- + +class GetPName p => GetPName3I p where + getBoolean3 :: (GLboolean -> GLboolean -> GLboolean -> a) -> p -> IO a + getBoolean3 = get3 getBooleanv + getInteger3 :: (GLint -> GLint -> GLint -> a) -> p -> IO a + getInteger3 = get3 getIntegerv + + getEnum3 :: (GLenum -> GLenum -> GLenum -> a) -> p -> IO a + getEnum3 = get3 getIntegerv + getSizei3 :: (GLsizei -> GLsizei -> GLsizei -> a) -> p -> IO a + getSizei3 = get3 getIntegerv + +class GetPName p => GetPName3F p where + getFloat3 :: (GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a + getFloat3 = get3 getFloatv + + getClampf3 :: (GLclampf -> GLclampf -> GLclampf -> a) -> p -> IO a + getClampf3 = get3 getFloatv + + getDouble3 :: (GLdouble -> GLdouble -> GLdouble -> a) -> p -> IO a + getDouble3 = get3 getDoublev + getClampd3 :: (GLclampd -> GLclampd -> GLclampd -> a) -> p -> IO a + getClampd3 = get3 getDoublev + +-- | Helper function for the get*3 functions. +get3 :: (Storable b, Storable c, GetPName p) + => (p -> Ptr c -> IO ()) + -> (b -> b -> b -> a) -- | Conversion from the casted value to the return value + -> p -> IO a +get3 g f n = allocaArray 3 $ \buf -> do + g n buf + peek3 f (castPtr buf) + +----------------------------------------------------------------------------- + +class GetPName p => GetPName4I p where + getBoolean4 :: (GLboolean -> GLboolean -> GLboolean -> GLboolean -> a) -> p -> IO a + getBoolean4 = get4 getBooleanv + getInteger4 :: (GLint -> GLint -> GLint -> GLint -> a) -> p -> IO a + getInteger4 = get4 getIntegerv + + getEnum4 :: (GLenum -> GLenum -> GLenum -> GLenum -> a) -> p -> IO a + getEnum4 = get4 getIntegerv + getSizei4 :: (GLsizei -> GLsizei -> GLsizei -> GLsizei -> a) -> p -> IO a + getSizei4 = get4 getIntegerv + +class GetPName p => GetPName4F p where + getFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a + getFloat4 = get4 getFloatv + + getClampf4 :: (GLclampf -> GLclampf -> GLclampf -> GLclampf -> a) -> p -> IO a + getClampf4 = get4 getFloatv + + getDouble4 :: (GLdouble -> GLdouble -> GLdouble -> GLdouble -> a) -> p -> IO a + getDouble4 = get4 getDoublev + getClampd4 :: (GLclampd -> GLclampd -> GLclampd -> GLclampd -> a) -> p -> IO a + getClampd4 = get4 getDoublev + +-- | Helper function for the get*4 functions. +get4 :: (Storable b, Storable c, GetPName p) + => (p -> Ptr c -> IO ()) + -> (b -> b -> b -> b -> a) -- | Conversion from the casted value to the return value + -> p -> IO a +get4 g f n = allocaArray 4 $ \buf -> do + g n buf + peek4 f (castPtr buf) + +class GetPName p => GetIPName4I p where + getBoolean4i :: (GLboolean -> GLboolean -> GLboolean -> GLboolean -> a) -> p -> GLuint -> IO a + getBoolean4i = get4i getBooleaniv + getInteger4i :: (GLint -> GLint -> GLint -> GLint -> a) -> p -> GLuint -> IO a + getInteger4i = get4i getIntegeriv + + getEnum4i :: (GLenum -> GLenum -> GLenum -> GLenum -> a) -> p -> GLuint -> IO a + getEnum4i = get4i getIntegeriv + getSizei4i :: (GLsizei -> GLsizei -> GLsizei -> GLsizei -> a) -> p -> GLuint -> IO a + getSizei4i = get4i getIntegeriv + +-- | Helper function for the get*4 functions. +get4i :: (Storable b, Storable c, GetPName p) + => (p -> GLuint -> Ptr c -> IO ()) + -> (b -> b -> b -> b -> a) -- | Conversion from the casted value to the return value + -> p -> GLuint -> IO a +get4i g f n i = allocaArray 4 $ \buf -> do + g n i buf + peek4 f (castPtr buf) + +class GetPName p => GetPNameNI p where + getIntegerN :: (GLint -> a) -> p -> Int -> IO [a] + getIntegerN f p n = allocaArray n $ \buf -> do + getIntegerv p buf + (map f) `fmap` peekArray n buf + +----------------------------------------------------------------------------- + +class GetPName p => GetPNameMatrix p where + getMatrixf :: p -> Ptr GLfloat -> IO () + getMatrixf = getFloatv + getMatrixd :: p -> Ptr GLdouble -> IO () + getMatrixd = getDoublev + +----------------------------------------------------------------------------- + +data PName1I + = GetEdgeFlag -- | bool + | GetRGBAMode -- | enum + | GetCurrentIndex -- | int + | GetMaxTextureUnits -- | enum + -- displaylist + | GetListIndex -- | enum + | GetListMode -- | enum + | GetMaxListNesting -- | sizei + | GetListBase -- | enum + -- rendermode + | GetRenderMode -- | enum + -- framebufferbinding + | GetDrawFramebufferBinding -- | int + | GetReadFramebufferBinding -- | int + | GetFramebufferBinding -- | int + -- renderbufferbinding + | GetRenderbufferBinding -- | int + -- hint + | GetPerspectiveCorrectionHint -- | enum + | GetPointSmoothHint -- | enum + | GetLineSmoothHint -- | enum + | GetPolygonSmoothHint -- | enum + | GetFogHint -- | enum + | GetGenerateMipmapHint -- | enum + | GetTextureCompressionHint -- | enum + | GetPackCMYKHint -- | enum + | GetUnpackCMYKHint -- | enum + -- vertexarray + | GetVertexArrayBinding -- | int + -- Selction? + | GetMaxNameStackDepth -- | int + | GetNameStackDepth -- | int + -- ContextProfile + | GetContextProfileMask -- | enum + -- pixelStorage + | GetPackSwapBytes -- | bool + | GetUnpackSwapBytes -- | bool + | GetPackLSBFirst -- | bool + | GetUnpackLSBFirst -- | bool + | GetPackRowLength -- | int + | GetUnpackRowLength -- | int + | GetPackSkipRows -- | int + | GetUnpackSkipRows -- | int + | GetPackSkipPixels -- | int + | GetUnpackSkipPixels -- | int + | GetPackAlignment -- | int + | GetUnpackAlignment -- | int + | GetPackImageHeight -- | int + | GetUnpackImageHeight -- | int + | GetPackSkipImages -- | int + | GetUnpackSkipImages -- | int + -- pixel map + | GetPixelMapIToISize -- | int + | GetPixelMapSToSSize -- | int + | GetPixelMapIToRSize -- | int + | GetPixelMapIToGSize -- | int + | GetPixelMapIToBSize -- | int + | GetPixelMapIToASize -- | int + | GetPixelMapRToRSize -- | int + | GetPixelMapGToGSize -- | int + | GetPixelMapBToBSize -- | int + | GetPixelMapAToASize -- | int + | GetMaxPixelMapTable -- | sizei + -- shader limits + | GetMaxVertexTextureImageUnits -- | sizei + | GetMaxTextureImageUnits -- | sizei + | GetMaxCombinedTextureImageUnits -- | sizei + | GetMaxTextureCoords -- | sizei + | GetMaxVertexUniformComponents -- | sizei + | GetMaxFragmentUniformComponents -- | sizei + | GetMaxVertexAttribs -- | sizei + | GetMaxVaryingFloats -- | sizei + -- coordtrans + | GetMatrixMode -- | enum + | GetModelviewStackDepth -- | sizei + | GetProjectionStackDepth -- | sizei + | GetTextureStackDepth -- | sizei + | GetColorMatrixStackDepth -- | sizei + | GetMaxModelviewStackDepth -- | sizei + | GetMaxProjectionStackDepth -- | sizei + | GetMaxTextureStackDepth -- | sizei + | GetMaxColorMatrixStackDepth -- | sizei + | GetMaxMatrixPaletteStackDepth -- | sizei + | GetCurrentMatrixStackDepth -- | sizei + | GetActiveTexture -- | enum + -- VertexArrays + | GetVertexArraySize -- | int + | GetVertexArrayType -- | enum + | GetVertexArrayStride -- | int + | GetNormalArrayType -- | enum + | GetNormalArrayStride -- | int + | GetColorArraySize -- | int + | GetColorArrayType -- | enum + | GetColorArrayStride -- | int + | GetIndexArrayType -- | enum + | GetIndexArrayStride -- | int + | GetTextureCoordArraySize -- | int + | GetTextureCoordArrayType -- | enum + | GetTextureCoordArrayStride -- | int + | GetEdgeFlagArrayStride -- | int + | GetFogCoordArrayType -- | enum + | GetFogCoordArrayStride -- | int + | GetSecondaryColorArraySize -- | int + | GetSecondaryColorArrayType -- | enum + | GetSecondaryColorArrayStride -- | int + | GetArrayElementLockCount -- | int + | GetArrayElementLockFirst -- | int + | GetClientActiveTexture -- | enum + | GetMaxElementsVertices -- | sizei + | GetMaxElementsIndices -- | sizei + | GetPrimitiveRestartIndex -- | int + | GetPrimitiveRestartNV -- | bool + | GetPrimitiveRestartIndexNV -- | int + -- bufferObjects + | GetArrayBufferBinding -- | int + | GetElementArrayBufferBinding -- | int + | GetCopyReadBuffer -- | int + | GetCopyWriteBuffer -- | int + | GetPixelPackBufferBinding -- | int + | GetPixelUnpackBufferBinding -- | int + | GetTransformFeedbackBufferBinding -- | int + | GetVertexArrayBufferBinding -- | int + | GetNormalArrayBufferBinding -- | int + | GetColorArrayBufferBinding -- | int + | GetIndexArrayBufferBinding -- | int + | GetTextureCoordArrayBufferBinding -- | int + | GetEdgeFlagArrayBufferBinding -- | int + | GetSecondaryColorArrayBufferBinding -- | int + | GetFogCoordArrayBufferBinding -- | int + -- clipping + | GetMaxClipPlanes -- | sizei + -- Colors + | GetMaxLights -- | sizei + | GetFrontFace -- | enum + | GetLightModelLocalViewer -- | bool + | GetLightModelTwoSide -- | bool + | GetLightModelColorControl -- | enum + | GetColorMaterialFace -- | enum + | GetColorMaterialParameter -- | enum + | GetShadeModel -- | enum + | GetFragmentColorClamp -- | enum + | GetVertexColorClamp -- | enum + | GetReadColorClamp -- | enum + -- Evaluators + | GetMaxEvalOrder -- | int + | GetMap1GridSegments -- | int + -- Fog + | GetFogMode -- | int => enum + | GetFogIndex -- | int + | GetFogCoordSrc -- | int + | GetFogDistanceMode -- | int => enum + -- Framebuffer + | GetAuxBuffers -- | sizei + | GetDoublebuffer -- | bool + | GetStereo -- | bool + | GetRedBits -- | sizei + | GetGreenBits -- | sizei + | GetBlueBits -- | sizei + | GetAlphaBits -- | sizei + | GetStencilBits -- | sizei + | GetDepthBits -- | sizei + | GetAccumRedBits -- | sizei + | GetAccumGreenBits -- | sizei + | GetAccumBlueBits -- | sizei + | GetAccumAlphaBits -- | sizei + | GetDrawBuffer -- | enum + | GetDrawBufferN GLsizei -- enum + | GetMaxDrawBuffers -- | sizei + | GetIndexWritemask -- | int + | GetDepthWritemask -- | bool + | GetStencilWritemask -- | bool + | GetStencilClearValue -- | int + -- Program + | GetCurrentProgram -- | int + -- Transformfeedback + | GetMaxTransformFeedbackSeparateAttribs -- | int + | GetMaxTransformFeedbackInterleavedComponents -- | int + | GetMaxTransformFeedbackSeparateComponents -- | int + | GetCurrentRasterIndex -- | int + | GetCurrentRasterPositionValid -- | bool + -- LineSegment + | GetLineStippleRepeat -- | int + | GetLineStipplePattern -- | int + -- PerFragment + | GetSampleCoverageInvert -- | bool + | GetAlphaTestFunc -- | enum + | GetStencilFunc -- | enum + | GetStencilValueMask -- | int + | GetStencilRef -- | int + | GetStencilFail -- | enum + | GetStencilPassDepthFail -- | enum + | GetStencilPassDepthPass -- | enum + | GetActiveStencilFace -- | enum + | GetLogicOpMode -- | enum + | GetBlendDst -- | enum + | GetBlendSrc -- | enum + | GetBlendSrcRGB -- | enum + | GetBlendSrcAlpha -- | enum + | GetBlendDstRGB -- | enum + | GetBlendDstAlpha -- | enum + | GetBlendEquation -- | enum + | GetBlendEquationAlpha -- | enum + | GetDepthFunc -- | enum + | GetMapColor -- | bool + | GetMapStencil -- | bool + | GetIndexShift -- | int + | GetIndexOffset -- | int + -- Polygons -- | enum + | GetCullFaceMode + -- TextureSpecification + | GetNumCompressedTextureFormats -- | int + | GetMaxTextureSize -- | int + | GetMax3DTextureSize -- | int + | GetMaxCubeMapTextureSize -- | int + | GetMaxRectangleTextureSize -- | int + -- ReadCopyPixels + | GetReadBuffer -- | enum + -- Texture Objects + | GetTextureBinding1D -- | int\/enum + | GetTextureBinding2D -- | int\/enum + | GetTextureBinding3D -- | int\/enum + | GetTextureBindingCubeMap -- | int\/enum + | GetTextureBindingRectangle -- | int\/enum + -- Antialiasing + | GetSubpixelBits -- | sizei + | GetSamples -- | sizei + | GetSampleBuffers -- | sizei + +instance GetPName1I PName1I where + +instance GetPName PName1I where + marshalGetPName pn = case pn of + GetEdgeFlag -> Just gl_EDGE_FLAG + GetRGBAMode -> Just gl_RGBA_MODE + GetCurrentIndex -> Just gl_CURRENT_INDEX + GetMaxTextureUnits -> Just gl_MAX_TEXTURE_UNITS + -- displaylist + GetListIndex -> Just gl_LIST_INDEX + GetListMode -> Just gl_LIST_MODE + GetMaxListNesting -> Just gl_MAX_LIST_NESTING + GetListBase -> Just gl_LIST_BASE + -- rendermode + GetRenderMode -> Just gl_RENDER_MODE + -- framebufferbinding + GetDrawFramebufferBinding -> Just gl_DRAW_FRAMEBUFFER_BINDING + GetReadFramebufferBinding -> Just gl_READ_FRAMEBUFFER_BINDING + GetFramebufferBinding -> Just gl_FRAMEBUFFER_BINDING + -- renderbufferbinding + GetRenderbufferBinding -> Just gl_RENDERBUFFER_BINDING + -- hint + GetPerspectiveCorrectionHint -> Just gl_PERSPECTIVE_CORRECTION_HINT + GetPointSmoothHint -> Just gl_POINT_SMOOTH_HINT + GetLineSmoothHint -> Just gl_LINE_SMOOTH_HINT + GetPolygonSmoothHint -> Just gl_POLYGON_SMOOTH_HINT + GetFogHint -> Just gl_FOG_HINT + GetGenerateMipmapHint -> Just gl_GENERATE_MIPMAP_HINT + GetTextureCompressionHint -> Just gl_TEXTURE_COMPRESSION_HINT + GetPackCMYKHint -> Just gl_PACK_CMYK_HINT + GetUnpackCMYKHint -> Just gl_UNPACK_CMYK_HINT + GetVertexArrayBinding -> Just gl_VERTEX_ARRAY_BINDING + -- Selection ? + GetMaxNameStackDepth -> Just gl_MAX_NAME_STACK_DEPTH + GetNameStackDepth -> Just gl_NAME_STACK_DEPTH + -- ContextProfile + GetContextProfileMask -> Just gl_CONTEXT_PROFILE_MASK + --pixel storage + GetPackSwapBytes -> Just gl_PACK_SWAP_BYTES + GetUnpackSwapBytes -> Just gl_UNPACK_SWAP_BYTES + GetPackLSBFirst -> Just gl_PACK_LSB_FIRST + GetUnpackLSBFirst -> Just gl_UNPACK_LSB_FIRST + GetPackRowLength -> Just gl_PACK_ROW_LENGTH + GetUnpackRowLength -> Just gl_UNPACK_ROW_LENGTH + GetPackSkipRows -> Just gl_PACK_SKIP_ROWS + GetUnpackSkipRows -> Just gl_UNPACK_SKIP_ROWS + GetPackSkipPixels -> Just gl_PACK_SKIP_PIXELS + GetUnpackSkipPixels -> Just gl_UNPACK_SKIP_PIXELS + GetPackAlignment -> Just gl_PACK_ALIGNMENT + GetUnpackAlignment -> Just gl_UNPACK_ALIGNMENT + GetPackSkipImages -> Just gl_PACK_SKIP_IMAGES + GetUnpackSkipImages -> Just gl_UNPACK_SKIP_IMAGES + GetPackImageHeight -> Just gl_PACK_IMAGE_HEIGHT + GetUnpackImageHeight -> Just gl_UNPACK_IMAGE_HEIGHT + -- pixelmap + GetPixelMapIToISize -> Just gl_PIXEL_MAP_I_TO_I_SIZE + GetPixelMapSToSSize -> Just gl_PIXEL_MAP_S_TO_S_SIZE + GetPixelMapIToRSize -> Just gl_PIXEL_MAP_I_TO_R_SIZE + GetPixelMapIToGSize -> Just gl_PIXEL_MAP_I_TO_G_SIZE + GetPixelMapIToBSize -> Just gl_PIXEL_MAP_I_TO_B_SIZE + GetPixelMapIToASize -> Just gl_PIXEL_MAP_I_TO_A_SIZE + GetPixelMapRToRSize -> Just gl_PIXEL_MAP_R_TO_R_SIZE + GetPixelMapGToGSize -> Just gl_PIXEL_MAP_G_TO_G_SIZE + GetPixelMapBToBSize -> Just gl_PIXEL_MAP_B_TO_B_SIZE + GetPixelMapAToASize -> Just gl_PIXEL_MAP_A_TO_A_SIZE + GetMaxPixelMapTable -> Just gl_MAX_PIXEL_MAP_TABLE + -- shader limits + GetMaxVertexTextureImageUnits -> Just gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS + GetMaxTextureImageUnits -> Just gl_MAX_TEXTURE_IMAGE_UNITS + GetMaxCombinedTextureImageUnits -> Just gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS + GetMaxTextureCoords -> Just gl_MAX_TEXTURE_COORDS + GetMaxVertexUniformComponents -> Just gl_MAX_VERTEX_UNIFORM_COMPONENTS + GetMaxFragmentUniformComponents -> Just gl_MAX_FRAGMENT_UNIFORM_COMPONENTS + GetMaxVaryingFloats -> Just gl_MAX_VARYING_COMPONENTS + GetMaxVertexAttribs -> Just gl_MAX_VERTEX_ATTRIBS + -- coordtrans + GetMatrixMode -> Just gl_MATRIX_MODE + GetModelviewStackDepth -> Just gl_MODELVIEW_STACK_DEPTH + GetProjectionStackDepth -> Just gl_PROJECTION_STACK_DEPTH + GetTextureStackDepth -> Just gl_TEXTURE_STACK_DEPTH + GetColorMatrixStackDepth -> Just gl_COLOR_MATRIX_STACK_DEPTH + GetMaxModelviewStackDepth -> Just gl_MAX_MODELVIEW_STACK_DEPTH + GetMaxProjectionStackDepth -> Just gl_MAX_PROJECTION_STACK_DEPTH + GetMaxTextureStackDepth -> Just gl_MAX_TEXTURE_STACK_DEPTH + GetMaxColorMatrixStackDepth -> Just gl_MAX_COLOR_MATRIX_STACK_DEPTH + GetMaxMatrixPaletteStackDepth -> Just gl_MAX_MATRIX_PALETTE_STACK_DEPTH + GetCurrentMatrixStackDepth -> Just gl_CURRENT_MATRIX_STACK_DEPTH + GetActiveTexture -> Just gl_ACTIVE_TEXTURE + -- vertexarrays + GetVertexArraySize -> Just gl_VERTEX_ARRAY_SIZE + GetVertexArrayType -> Just gl_VERTEX_ARRAY_TYPE + GetVertexArrayStride -> Just gl_VERTEX_ARRAY_STRIDE + GetNormalArrayType -> Just gl_NORMAL_ARRAY_TYPE + GetNormalArrayStride -> Just gl_NORMAL_ARRAY_STRIDE + GetColorArraySize -> Just gl_COLOR_ARRAY_SIZE + GetColorArrayType -> Just gl_COLOR_ARRAY_TYPE + GetColorArrayStride -> Just gl_COLOR_ARRAY_STRIDE + GetIndexArrayType -> Just gl_INDEX_ARRAY_TYPE + GetIndexArrayStride -> Just gl_INDEX_ARRAY_STRIDE + GetTextureCoordArraySize -> Just gl_TEXTURE_COORD_ARRAY_SIZE + GetTextureCoordArrayType -> Just gl_TEXTURE_COORD_ARRAY_TYPE + GetTextureCoordArrayStride -> Just gl_TEXTURE_COORD_ARRAY_STRIDE + GetEdgeFlagArrayStride -> Just gl_EDGE_FLAG_ARRAY_STRIDE + GetFogCoordArrayType -> Just gl_FOG_COORD_ARRAY_TYPE + GetFogCoordArrayStride -> Just gl_FOG_COORD_ARRAY_STRIDE + GetSecondaryColorArraySize -> Just gl_SECONDARY_COLOR_ARRAY_SIZE + GetSecondaryColorArrayType -> Just gl_SECONDARY_COLOR_ARRAY_TYPE + GetSecondaryColorArrayStride -> Just gl_SECONDARY_COLOR_ARRAY_STRIDE + GetArrayElementLockCount -> Just gl_ARRAY_ELEMENT_LOCK_COUNT + GetArrayElementLockFirst -> Just gl_ARRAY_ELEMENT_LOCK_FIRST + GetClientActiveTexture -> Just gl_CLIENT_ACTIVE_TEXTURE + GetMaxElementsVertices -> Just gl_MAX_ELEMENTS_VERTICES + GetMaxElementsIndices -> Just gl_MAX_ELEMENTS_INDICES + GetPrimitiveRestartIndex -> Just gl_PRIMITIVE_RESTART_INDEX + GetPrimitiveRestartNV -> Just gl_PRIMITIVE_RESTART_NV + GetPrimitiveRestartIndexNV -> Just gl_PRIMITIVE_RESTART_INDEX_NV + -- bufferobjects + GetArrayBufferBinding -> Just gl_ARRAY_BUFFER_BINDING + GetElementArrayBufferBinding -> Just gl_ELEMENT_ARRAY_BUFFER_BINDING + GetCopyReadBuffer -> Just gl_COPY_READ_BUFFER + GetCopyWriteBuffer -> Just gl_COPY_WRITE_BUFFER + GetPixelPackBufferBinding -> Just gl_PIXEL_PACK_BUFFER_BINDING + GetPixelUnpackBufferBinding -> Just gl_PIXEL_UNPACK_BUFFER_BINDING + GetTransformFeedbackBufferBinding -> Just gl_TRANSFORM_FEEDBACK_BUFFER_BINDING + GetVertexArrayBufferBinding -> Just gl_VERTEX_ARRAY_BUFFER_BINDING + GetNormalArrayBufferBinding -> Just gl_NORMAL_ARRAY_BUFFER_BINDING + GetColorArrayBufferBinding -> Just gl_COLOR_ARRAY_BUFFER_BINDING + GetIndexArrayBufferBinding -> Just gl_INDEX_ARRAY_BUFFER_BINDING + GetTextureCoordArrayBufferBinding -> Just gl_TEXTURE_COORD_ARRAY_BUFFER_BINDING + GetEdgeFlagArrayBufferBinding -> Just gl_EDGE_FLAG_ARRAY_BUFFER_BINDING + GetSecondaryColorArrayBufferBinding -> Just gl_SECONDARY_COLOR_ARRAY_BUFFER_BINDING + GetFogCoordArrayBufferBinding -> Just gl_FOG_COORD_ARRAY_BUFFER_BINDING + -- clipping + GetMaxClipPlanes -> Just gl_MAX_CLIP_DISTANCES + -- Colors + GetMaxLights -> Just gl_MAX_LIGHTS + GetFrontFace -> Just gl_FRONT_FACE + GetLightModelLocalViewer -> Just gl_LIGHT_MODEL_LOCAL_VIEWER + GetLightModelTwoSide -> Just gl_LIGHT_MODEL_TWO_SIDE + GetLightModelColorControl -> Just gl_LIGHT_MODEL_COLOR_CONTROL + GetColorMaterialFace -> Just gl_COLOR_MATERIAL_FACE + GetColorMaterialParameter -> Just gl_COLOR_MATERIAL_PARAMETER + GetShadeModel -> Just gl_SHADE_MODEL + GetVertexColorClamp -> Just gl_CLAMP_VERTEX_COLOR + GetFragmentColorClamp -> Just gl_CLAMP_FRAGMENT_COLOR + GetReadColorClamp -> Just gl_CLAMP_READ_COLOR + -- Evaluators + GetMaxEvalOrder -> Just gl_MAX_EVAL_ORDER + GetMap1GridSegments -> Just gl_MAP1_GRID_SEGMENTS + -- Fog + GetFogMode -> Just gl_FOG_MODE + GetFogIndex -> Just gl_FOG_INDEX + GetFogCoordSrc -> Just gl_FOG_COORD_SRC + GetFogDistanceMode -> Just gl_FOG_DISTANCE_MODE + -- Framebuffer + GetAuxBuffers -> Just gl_AUX_BUFFERS + GetDoublebuffer -> Just gl_DOUBLEBUFFER + GetStereo -> Just gl_STEREO + GetRedBits -> Just gl_RED_BITS + GetGreenBits -> Just gl_GREEN_BITS + GetBlueBits -> Just gl_BLUE_BITS + GetAlphaBits -> Just gl_ALPHA_BITS + GetDepthBits -> Just gl_DEPTH_BITS + GetStencilBits -> Just gl_STENCIL_BITS + GetAccumRedBits -> Just gl_ACCUM_RED_BITS + GetAccumGreenBits -> Just gl_ACCUM_GREEN_BITS + GetAccumBlueBits -> Just gl_ACCUM_BLUE_BITS + GetAccumAlphaBits -> Just gl_ACCUM_ALPHA_BITS + GetDrawBuffer -> Just gl_DRAW_BUFFER + GetDrawBufferN i -> drawBufferIndexToEnum i + GetMaxDrawBuffers -> Just gl_MAX_DRAW_BUFFERS + GetIndexWritemask -> Just gl_INDEX_WRITEMASK + GetDepthWritemask -> Just gl_DEPTH_WRITEMASK + GetStencilWritemask -> Just gl_STENCIL_WRITEMASK + GetStencilClearValue -> Just gl_STENCIL_CLEAR_VALUE + -- Program + GetCurrentProgram -> Just gl_CURRENT_PROGRAM + -- Transformfeedback + GetMaxTransformFeedbackSeparateAttribs -> Just gl_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS + GetMaxTransformFeedbackSeparateComponents -> Just gl_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS + GetMaxTransformFeedbackInterleavedComponents -> Just gl_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS + -- RasterPos + GetCurrentRasterIndex -> Just gl_CURRENT_RASTER_INDEX + GetCurrentRasterPositionValid -> Just gl_CURRENT_RASTER_POSITION_VALID + -- LineSegment + GetLineStipplePattern -> Just gl_LINE_STIPPLE_PATTERN + GetLineStippleRepeat -> Just gl_LINE_STIPPLE_REPEAT + -- PerFragment + GetSampleCoverageInvert -> Just gl_SAMPLE_COVERAGE_INVERT + GetAlphaTestFunc -> Just gl_ALPHA_TEST_FUNC + GetStencilFunc -> Just gl_STENCIL_FUNC + GetStencilValueMask -> Just gl_STENCIL_VALUE_MASK + GetStencilRef -> Just gl_STENCIL_REF + GetStencilFail -> Just gl_STENCIL_FAIL + GetStencilPassDepthFail -> Just gl_STENCIL_PASS_DEPTH_FAIL + GetStencilPassDepthPass -> Just gl_STENCIL_PASS_DEPTH_PASS + GetActiveStencilFace -> Just gl_ACTIVE_STENCIL_FACE + GetLogicOpMode -> Just gl_LOGIC_OP_MODE + GetBlendDst -> Just gl_BLEND_DST + GetBlendSrc -> Just gl_BLEND_SRC + GetBlendDstRGB -> Just gl_BLEND_DST_RGB + GetBlendSrcRGB -> Just gl_BLEND_SRC_RGB + GetBlendDstAlpha -> Just gl_BLEND_DST_ALPHA + GetBlendSrcAlpha -> Just gl_BLEND_SRC_ALPHA + GetBlendEquation -> Just gl_BLEND_EQUATION_RGB + GetBlendEquationAlpha -> Just gl_BLEND_EQUATION_ALPHA + GetDepthFunc -> Just gl_DEPTH_FUNC + GetMapColor -> Just gl_MAP_COLOR + GetMapStencil -> Just gl_MAP_STENCIL + GetIndexShift -> Just gl_INDEX_SHIFT + GetIndexOffset -> Just gl_INDEX_OFFSET + -- Polygons + GetCullFaceMode -> Just gl_CULL_FACE_MODE + -- Texture specification + GetNumCompressedTextureFormats -> Just gl_NUM_COMPRESSED_TEXTURE_FORMATS + GetMaxTextureSize -> Just gl_MAX_TEXTURE_SIZE + GetMax3DTextureSize -> Just gl_MAX_3D_TEXTURE_SIZE + GetMaxCubeMapTextureSize -> Just gl_MAX_CUBE_MAP_TEXTURE_SIZE + GetMaxRectangleTextureSize -> Just gl_MAX_RECTANGLE_TEXTURE_SIZE + -- ReadCopyPixels + GetReadBuffer -> Just gl_READ_BUFFER + -- Texture Objects + GetTextureBinding1D -> Just gl_TEXTURE_BINDING_1D + GetTextureBinding2D -> Just gl_TEXTURE_BINDING_2D + GetTextureBinding3D -> Just gl_TEXTURE_BINDING_3D + GetTextureBindingCubeMap -> Just gl_TEXTURE_BINDING_CUBE_MAP + GetTextureBindingRectangle -> Just gl_TEXTURE_BINDING_RECTANGLE + -- Antialiasing + GetSubpixelBits -> Just gl_SUBPIXEL_BITS + GetSampleBuffers -> Just gl_SAMPLE_BUFFERS + GetSamples -> Just gl_SAMPLES + + +-- 0x8825 through 0x8834 are reserved for draw buffers + +drawBufferIndexToEnum :: GLsizei -> Maybe GLenum +drawBufferIndexToEnum i + | 0 <= i && i <= maxDrawBufferIndex = Just (gl_DRAW_BUFFER0 + fromIntegral i) + | otherwise = Nothing + +maxDrawBufferIndex :: GLsizei +maxDrawBufferIndex = fromIntegral (gl_DRAW_BUFFER15 - gl_DRAW_BUFFER0) + + +----------------------------------------------------------------------------- + +data PName1F + = GetCurrentFogCoord -- | Float1 + -- Rasterization + | GetZoomX -- | Float + | GetZoomY -- | Float + -- Colors + | GetMaxShininess -- | Float + | GetMaxSpotExponent -- | Float + -- Fog + | GetFogStart -- | float + | GetFogEnd -- | float + | GetFogDensity -- | float + -- Framebuffer + | GetDepthClearValue -- | clampf + | GetIndexClearValue -- | float + -- RasterPos + | GetCurrentRasterDistance -- | float + -- Point + | GetPointSizeMin -- | float + | GetPointSizeMax -- | float + | GetPointFadeThresholdSize -- | float + | GetSmoothPointSizeGranularity -- | float + | GetPointSize -- | float + -- LineSegment + | GetLineWidth -- | float + | GetSmoothLineWidthGranularity -- | float + -- PerFragment + | GetSampleCoverageValue -- | clampf + | GetAlphaTestRef -- | clampf + -- PixelTransfer + | GetRedScale -- | float + | GetGreenScale -- | float + | GetBlueScale -- | float + | GetAlphaScale -- | float + | GetPostConvolutionRedScale -- | float + | GetPostConvolutionGreenScale -- | float + | GetPostConvolutionBlueScale -- | float + | GetPostConvolutionAlphaScale -- | float + | GetPostColorMatrixRedScale -- | float + | GetPostColorMatrixGreenScale -- | float + | GetPostColorMatrixBlueScale -- | float + | GetPostColorMatrixAlphaScale -- | float + | GetRedBias -- | float + | GetGreenBias -- | float + | GetBlueBias -- | float + | GetAlphaBias -- | float + | GetPostConvolutionRedBias -- | float + | GetPostConvolutionGreenBias -- | float + | GetPostConvolutionBlueBias -- | float + | GetPostConvolutionAlphaBias -- | float + | GetPostColorMatrixRedBias -- | float + | GetPostColorMatrixGreenBias -- | float + | GetPostColorMatrixBlueBias -- | float + | GetPostColorMatrixAlphaBias -- | float + | GetDepthScale -- | float + | GetDepthBias -- | float + -- Polygons + | GetPolygonOffsetFactor -- | float + | GetPolygonOffsetUnits -- | float + -- Texture parameters + | GetMaxTextureMaxAnisotropy -- | float + | GetMaxTextureLODBias -- | float + +instance GetPName1F PName1F where + +instance GetPName PName1F where + marshalGetPName pn = case pn of + GetCurrentFogCoord -> Just gl_CURRENT_FOG_COORD + -- Rasterization + GetZoomX -> Just gl_ZOOM_X + GetZoomY -> Just gl_ZOOM_Y + -- Colors + GetMaxShininess -> Just gl_MAX_SHININESS + GetMaxSpotExponent -> Just gl_MAX_SPOT_EXPONENT + -- Fog + GetFogStart -> Just gl_FOG_START + GetFogEnd -> Just gl_FOG_END + GetFogDensity -> Just gl_FOG_DENSITY + -- Framebuffer + GetDepthClearValue -> Just gl_DEPTH_CLEAR_VALUE + GetIndexClearValue -> Just gl_INDEX_CLEAR_VALUE + -- RasterPos + GetCurrentRasterDistance -> Just gl_CURRENT_RASTER_DISTANCE + -- Point + GetPointSizeMin -> Just gl_POINT_SIZE_MIN + GetPointSizeMax -> Just gl_POINT_SIZE_MAX + GetPointFadeThresholdSize -> Just gl_POINT_FADE_THRESHOLD_SIZE + GetSmoothPointSizeGranularity -> Just gl_POINT_SIZE_GRANULARITY + GetPointSize -> Just gl_POINT_SIZE + -- LineSegment + GetSmoothLineWidthGranularity -> Just gl_SMOOTH_LINE_WIDTH_GRANULARITY + GetLineWidth -> Just gl_LINE_WIDTH + -- PerFragment + GetSampleCoverageValue -> Just gl_SAMPLE_COVERAGE_VALUE + GetAlphaTestRef -> Just gl_ALPHA_TEST_REF + -- PixelTransfer + GetRedScale -> Just gl_RED_SCALE + GetRedBias -> Just gl_RED_BIAS + GetGreenScale -> Just gl_GREEN_SCALE + GetGreenBias -> Just gl_GREEN_BIAS + GetBlueScale -> Just gl_BLUE_SCALE + GetBlueBias -> Just gl_BLUE_BIAS + GetAlphaScale -> Just gl_ALPHA_SCALE + GetAlphaBias -> Just gl_ALPHA_BIAS + GetPostConvolutionRedScale -> Just gl_POST_CONVOLUTION_RED_SCALE + GetPostConvolutionGreenScale -> Just gl_POST_CONVOLUTION_GREEN_SCALE + GetPostConvolutionBlueScale -> Just gl_POST_CONVOLUTION_BLUE_SCALE + GetPostConvolutionAlphaScale -> Just gl_POST_CONVOLUTION_ALPHA_SCALE + GetPostConvolutionRedBias -> Just gl_POST_CONVOLUTION_RED_BIAS + GetPostConvolutionGreenBias -> Just gl_POST_CONVOLUTION_GREEN_BIAS + GetPostConvolutionBlueBias -> Just gl_POST_CONVOLUTION_BLUE_BIAS + GetPostConvolutionAlphaBias -> Just gl_POST_CONVOLUTION_ALPHA_BIAS + GetPostColorMatrixRedScale -> Just gl_POST_COLOR_MATRIX_RED_SCALE + GetPostColorMatrixGreenScale -> Just gl_POST_COLOR_MATRIX_GREEN_SCALE + GetPostColorMatrixBlueScale -> Just gl_POST_COLOR_MATRIX_BLUE_SCALE + GetPostColorMatrixAlphaScale -> Just gl_POST_COLOR_MATRIX_ALPHA_SCALE + GetPostColorMatrixRedBias -> Just gl_POST_COLOR_MATRIX_RED_BIAS + GetPostColorMatrixGreenBias -> Just gl_POST_COLOR_MATRIX_GREEN_BIAS + GetPostColorMatrixBlueBias -> Just gl_POST_COLOR_MATRIX_BLUE_BIAS + GetPostColorMatrixAlphaBias -> Just gl_POST_COLOR_MATRIX_ALPHA_BIAS + GetDepthScale -> Just gl_DEPTH_SCALE + GetDepthBias -> Just gl_DEPTH_BIAS + -- Polygons + GetPolygonOffsetFactor -> Just gl_POLYGON_OFFSET_FACTOR + GetPolygonOffsetUnits -> Just gl_POLYGON_OFFSET_UNITS + -- Texture parameters + GetMaxTextureMaxAnisotropy -> Just gl_MAX_TEXTURE_MAX_ANISOTROPY + GetMaxTextureLODBias -> Just gl_MAX_TEXTURE_LOD_BIAS + +----------------------------------------------------------------------------- + +data IPName1I + = GetTransformFeedbackBuffer + | GetTransformFeedbackBufferStart + | GetTransformFeedbackBufferSize + +instance GetIPName1I IPName1I where + +instance GetPName IPName1I where + marshalGetPName pn = case pn of + GetTransformFeedbackBuffer -> Just gl_TRANSFORM_FEEDBACK_BUFFER + GetTransformFeedbackBufferSize -> Just gl_TRANSFORM_FEEDBACK_BUFFER_SIZE + GetTransformFeedbackBufferStart -> Just gl_TRANSFORM_FEEDBACK_BUFFER_START + +----------------------------------------------------------------------------- + +data PName2I + -- coordtrans + = GetMaxViewportDims -- | sizei + -- Evaluators + | GetMap2GridSegments + -- Polygons + | GetPolygonMode + +instance GetPName2I PName2I where + +instance GetPName PName2I where + marshalGetPName pn = case pn of + -- coordtrans + GetMaxViewportDims -> Just gl_MAX_VIEWPORT_DIMS + -- Evaluators + GetMap2GridSegments -> Just gl_MAP2_GRID_SEGMENTS + -- Polygons + GetPolygonMode -> Just gl_POLYGON_MODE + +----------------------------------------------------------------------------- + +data PName2F + -- coordtrans + = GetDepthRange -- | clamp + -- Evaluators + | GetMap1GridDomain -- | float2? + -- Point + | GetAliasedPointSizeRange -- | float + | GetSmoothPointSizeRange -- | float + -- LineSegments + | GetAliasedLineWidthRange -- | float + | GetSmoothLineWidthRange -- | float + -- PerFragment + | GetDepthBounds -- | clampd + +instance GetPName2F PName2F where + +instance GetPName PName2F where + marshalGetPName pn = case pn of + -- coord trans + GetDepthRange -> Just gl_DEPTH_RANGE + -- Evaluators + GetMap1GridDomain -> Just gl_MAP1_GRID_DOMAIN + -- Point + GetAliasedPointSizeRange -> Just gl_ALIASED_POINT_SIZE_RANGE + GetSmoothPointSizeRange -> Just gl_POINT_SIZE_RANGE + -- LineSegments + GetAliasedLineWidthRange -> Just gl_ALIASED_LINE_WIDTH_RANGE + GetSmoothLineWidthRange -> Just gl_SMOOTH_LINE_WIDTH_RANGE + -- PerFragment + GetDepthBounds -> Just gl_DEPTH_BOUNDS + +----------------------------------------------------------------------------- + +data PName3F + = GetCurrentNormal -- | Float3 + -- Point + | GetPointDistanceAttenuation -- | float + +instance GetPName3F PName3F where + +instance GetPName PName3F where + marshalGetPName pn = case pn of + GetCurrentNormal -> Just gl_CURRENT_NORMAL + -- Point + GetPointDistanceAttenuation -> Just gl_POINT_DISTANCE_ATTENUATION + +----------------------------------------------------------------------------- + +data PName4I + -- coordtrans + = GetViewport -- | int + -- Framebuffer + | GetRGBASignedComponents -- | int + -- PerFragment + | GetScissorBox -- | int + + +instance GetPName4I PName4I where + +instance GetPName PName4I where + marshalGetPName pn = case pn of + -- coordtrans + GetViewport -> Just gl_VIEWPORT + -- Framebuffer + GetRGBASignedComponents -> Just gl_RGBA_SIGNED_COMPONENTS + -- PerFragement + GetScissorBox -> Just gl_SCISSOR_BOX + + +-- | Both indexed and unindexed +data PName4ISemiIndexed + = GetColorWritemask -- | bool + +instance GetPName4I PName4ISemiIndexed where +instance GetIPName4I PName4ISemiIndexed where + +instance GetPName PName4ISemiIndexed where + marshalGetPName pn = case pn of + GetColorWritemask -> Just gl_COLOR_WRITEMASK + +----------------------------------------------------------------------------- + +data PName4F + = GetCurrentColor -- | ? + | GetCurrentTextureCoords -- | Float + | GetCurrentSecondaryColor -- | Float + -- clipping + | GetClipPlane GLsizei -- | double + -- Colors + | GetLightModelAmbient -- | float + -- Evaluators + | GetMap2GridDomain -- | float? + -- Fog + | GetFogColor -- | clampf + -- Framebuffer + | GetColorClearValue -- | clampf + | GetAccumClearValue -- | float + -- RasterPos + | GetCurrentRasterColor -- | float + | GetCurrentRasterSecondaryColor -- | float + | GetCurrentRasterTextureCoords -- | float + | GetCurrentRasterPosition -- | float + | GetBlendColor -- | clampf + +instance GetPName4F PName4F where + +instance GetPName PName4F where + marshalGetPName pn = case pn of + GetCurrentColor -> Just gl_CURRENT_COLOR + GetCurrentTextureCoords -> Just gl_CURRENT_TEXTURE_COORDS + GetCurrentSecondaryColor -> Just gl_CURRENT_SECONDARY_COLOR + -- clipping + GetClipPlane i -> clipPlaneIndexToEnum i + -- Colors + GetLightModelAmbient -> Just gl_LIGHT_MODEL_AMBIENT + -- Evaluators + GetMap2GridDomain -> Just gl_MAP2_GRID_DOMAIN + -- Fog + GetFogColor -> Just gl_FOG_COLOR + -- Framebuffer + GetColorClearValue -> Just gl_COLOR_CLEAR_VALUE + GetAccumClearValue -> Just gl_ACCUM_CLEAR_VALUE + -- 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 + + + +-- 0x3000 through 0x3FFF are reserved for clip planes +clipPlaneIndexToEnum :: GLsizei -> Maybe GLenum +clipPlaneIndexToEnum i + | 0 <= i && i <= maxClipPlaneIndex = Just (gl_CLIP_DISTANCE0 + fromIntegral i) + | otherwise = Nothing + +maxClipPlaneIndex :: GLsizei +maxClipPlaneIndex = 0xFFF + +----------------------------------------------------------------------------- + +data PNameNI + = GetCompressedTextureFormats + +instance GetPNameNI PNameNI where +instance GetPName PNameNI where + marshalGetPName pn = case pn of + GetCompressedTextureFormats -> Just gl_COMPRESSED_TEXTURE_FORMATS + + +----------------------------------------------------------------------------- + +data PNameMatrix + -- coordtrans + = GetModelviewMatrix + | GetProjectionMatrix + | GetTextureMatrix + | GetColorMatrix + | GetMatrixPalette + +instance GetPNameMatrix PNameMatrix where + +instance GetPName PNameMatrix where + marshalGetPName pn = case pn of + -- coordtrans + GetModelviewMatrix -> Just gl_MODELVIEW_MATRIX + GetProjectionMatrix -> Just gl_PROJECTION_MATRIX + GetTextureMatrix -> Just gl_TEXTURE_MATRIX + GetColorMatrix -> Just gl_COLOR_MATRIX + GetMatrixPalette -> Just gl_MATRIX_PALETTE + +----------------------------------------------------------------------------- diff --git a/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs b/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs @@ -0,0 +1,97 @@ +-- #hide +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Jason Dagit , Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib ( + AttribLocation(..), GetVertexAttribPName(..), + getVertexAttribInteger1, getVertexAttribEnum1, getVertexAttribBoolean1, + getVertexAttribFloat4, getVertexAttribIInteger4, getVertexAttribIuInteger4, + GetVertexAttribPointerPName(..), getVertexAttribPointer +) where + +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.Raw.Core32 + +newtype AttribLocation = AttribLocation GLuint + deriving ( Eq, Ord, Show ) + +-------------------------------------------------------------------------------- + +data GetVertexAttribPName = + GetVertexAttribArrayEnabled + | GetVertexAttribArraySize + | GetVertexAttribArrayStride + | GetVertexAttribArrayType + | GetVertexAttribArrayNormalized + | GetCurrentVertexAttrib + | GetVertexAttribArrayBufferBinding + | GetVertexAttribArrayInteger + +marshalGetVertexAttribPName :: GetVertexAttribPName -> GLenum +marshalGetVertexAttribPName x = case x of + GetVertexAttribArrayEnabled -> gl_VERTEX_ATTRIB_ARRAY_ENABLED + GetVertexAttribArraySize -> gl_VERTEX_ATTRIB_ARRAY_SIZE + GetVertexAttribArrayStride -> gl_VERTEX_ATTRIB_ARRAY_STRIDE + GetVertexAttribArrayType -> gl_VERTEX_ATTRIB_ARRAY_TYPE + GetVertexAttribArrayNormalized -> gl_VERTEX_ATTRIB_ARRAY_NORMALIZED + GetCurrentVertexAttrib -> gl_CURRENT_VERTEX_ATTRIB + GetVertexAttribArrayBufferBinding -> gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING + GetVertexAttribArrayInteger -> gl_VERTEX_ATTRIB_ARRAY_INTEGER + +-------------------------------------------------------------------------------- + +getVertexAttribInteger1 :: (GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b +getVertexAttribInteger1 f (AttribLocation location) n = alloca $ \buf -> do + glGetVertexAttribiv location (marshalGetVertexAttribPName n) buf + peek1 f buf + +getVertexAttribEnum1 :: (GLenum -> b) -> AttribLocation -> GetVertexAttribPName -> IO b +getVertexAttribEnum1 f = getVertexAttribInteger1 (f . fromIntegral) + +getVertexAttribBoolean1 :: (GLboolean -> b) -> AttribLocation -> GetVertexAttribPName -> IO b +getVertexAttribBoolean1 f = getVertexAttribInteger1 (f . fromIntegral) + +getVertexAttribFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> b) -> AttribLocation -> GetVertexAttribPName -> IO b +getVertexAttribFloat4 f (AttribLocation location) n = alloca $ \buf -> do + glGetVertexAttribfv location (marshalGetVertexAttribPName n) buf + peek4 f buf + +getVertexAttribIInteger4 :: (GLint -> GLint -> GLint -> GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b +getVertexAttribIInteger4 f (AttribLocation location) n = alloca $ \buf -> do + glGetVertexAttribIiv location (marshalGetVertexAttribPName n) buf + peek4 f buf + +getVertexAttribIuInteger4 :: (GLuint -> GLuint -> GLuint -> GLuint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b +getVertexAttribIuInteger4 f (AttribLocation location) n = alloca $ \buf -> do + glGetVertexAttribIuiv location (marshalGetVertexAttribPName n) buf + peek4 f buf + +-------------------------------------------------------------------------------- + +data GetVertexAttribPointerPName = + VertexAttribArrayPointer + +marshalGetVertexAttribPointerPName :: GetVertexAttribPointerPName -> GLenum +marshalGetVertexAttribPointerPName x = case x of + VertexAttribArrayPointer -> gl_VERTEX_ATTRIB_ARRAY_POINTER + +-------------------------------------------------------------------------------- + +getVertexAttribPointer :: AttribLocation -> GetVertexAttribPointerPName -> IO (Ptr a) +getVertexAttribPointer (AttribLocation location) n = alloca $ \buf -> do + glGetVertexAttribPointerv location (marshalGetVertexAttribPointerPName n) buf + peek buf diff --git a/Graphics/Rendering/OpenGL/GL/RasterPos.hs b/Graphics/Rendering/OpenGL/GL/RasterPos.hs --- a/Graphics/Rendering/OpenGL/GL/RasterPos.hs +++ b/Graphics/Rendering/OpenGL/GL/RasterPos.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.RasterPos -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -12,6 +12,8 @@ -- OpenGL 2.1 specs. -- -------------------------------------------------------------------------------- + +{-# LANGUAGE TypeSynonymInstances #-} module Graphics.Rendering.OpenGL.GL.RasterPos ( currentRasterPosition, RasterPosComponent, RasterPos(..), diff --git a/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs b/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs --- a/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs +++ b/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs @@ -18,7 +18,10 @@ readPixels, readBuffer, -- * Copying Pixels - PixelCopyType(..), copyPixels + PixelCopyType(..), copyPixels, + + -- * Copying Pixels for framebuffers + BlitFramebufferMask(..), blitFramebuffer ) where import Data.StateVar @@ -26,6 +29,7 @@ import Graphics.Rendering.OpenGL.GL.CoordTrans import Graphics.Rendering.OpenGL.GL.PixelData import Graphics.Rendering.OpenGL.GL.QueryUtils +import Graphics.Rendering.OpenGL.GL.Texturing.Parameters import Graphics.Rendering.OpenGL.GLU.ErrorsInternal import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glCopyPixels ) import Graphics.Rendering.OpenGL.Raw.Core31 @@ -63,3 +67,26 @@ copyPixels :: Position -> Size -> PixelCopyType -> IO () copyPixels (Position x y) (Size w h) t = glCopyPixels x y w h (marshalPixelCopyType t) + +-------------------------------------------------------------------------------- + +data BlitFramebufferMask + = BlitColorBuffer + | BlitStencilBuffer + | BlitDepthBuffer + +marshalBlitFramebufferMask :: [BlitFramebufferMask] -> GLbitfield +marshalBlitFramebufferMask = fromIntegral . sum . map marshal + where marshal x = case x of + BlitColorBuffer -> gl_COLOR_BUFFER_BIT + BlitStencilBuffer -> gl_STENCIL_BUFFER_BIT + BlitDepthBuffer -> gl_DEPTH_BUFFER_BIT + +blitFramebuffer :: Position -> Position -> Position -> Position -> [BlitFramebufferMask] + -> TextureFilter -> IO () +blitFramebuffer (Position sx0 sy0) (Position sx1 sy1) (Position dx0 dy0) (Position dx1 dy1) + bfbm filt = glBlitFramebuffer sx0 sy0 sx1 sy1 dx0 dy0 dx1 dy1 + (marshalBlitFramebufferMask bfbm) (marshalTextureFilter filt) + where marshalTextureFilter x = case x of + Nearest -> gl_NEAREST + Linear' -> gl_LINEAR diff --git a/Graphics/Rendering/OpenGL/GL/Rectangles.hs b/Graphics/Rendering/OpenGL/GL/Rectangles.hs --- a/Graphics/Rendering/OpenGL/GL/Rectangles.hs +++ b/Graphics/Rendering/OpenGL/GL/Rectangles.hs @@ -12,6 +12,8 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE TypeSynonymInstances #-} + module Graphics.Rendering.OpenGL.GL.Rectangles ( Rect(..) ) where diff --git a/Graphics/Rendering/OpenGL/GL/Shaders.hs b/Graphics/Rendering/OpenGL/GL/Shaders.hs --- a/Graphics/Rendering/OpenGL/GL/Shaders.hs +++ b/Graphics/Rendering/OpenGL/GL/Shaders.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Shaders -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -22,6 +22,11 @@ Program, programDeleteStatus, attachedShaders, linkProgram, linkStatus, programInfoLog, validateProgram, validateStatus, currentProgram, + + -- * FragmentData + bindFragDataLocation, + getFragDataLocation, + -- * Vertex attributes attribLocation, VariableType(..), activeAttribs, @@ -35,669 +40,10 @@ maxFragmentUniformComponents, maxVertexAttribs, maxVaryingFloats ) where -import Control.Monad -import Control.Monad.Fix -import Data.List -import Data.ObjectName -import Data.StateVar -import Data.Tensor -import Foreign.C.String -import Foreign.Marshal.Alloc -import Foreign.Marshal.Array -import Foreign.Marshal.Utils -import Foreign.Ptr -import Foreign.Storable -import Graphics.Rendering.OpenGL.GL.GLboolean -import Graphics.Rendering.OpenGL.GL.PeekPoke -import Graphics.Rendering.OpenGL.GL.QueryUtils -import Graphics.Rendering.OpenGL.GL.VertexSpec -import Graphics.Rendering.OpenGL.Raw.Core31 - --------------------------------------------------------------------------------- - -type GLStringLen = (Ptr GLchar, GLsizei) - -peekGLstringLen :: GLStringLen -> IO String -peekGLstringLen (p,l) = peekCAStringLen (castPtr p, fromIntegral l) - -withGLStringLen :: String -> (GLStringLen -> IO a) -> IO a -withGLStringLen s act = - withCAStringLen s $ \(p,len) -> - act (castPtr p, fromIntegral len) - -withGLString :: String -> (Ptr GLchar -> IO a) -> IO a -withGLString s act = withCAString s $ act . castPtr - --------------------------------------------------------------------------------- - -newtype VertexShader = VertexShader { vertexShaderID :: GLuint } - deriving ( Eq, Ord, Show ) - -newtype FragmentShader = FragmentShader { fragmentShaderID :: GLuint } - deriving ( Eq, Ord, Show ) - --------------------------------------------------------------------------------- - -class (Eq s, Ord s, Show s, ObjectName s) => Shader s where - shaderID :: s -> GLuint - makeShader :: GLuint -> s - shaderType :: s -> GLenum - -instance Shader VertexShader where - makeShader = VertexShader - shaderID = vertexShaderID - shaderType = const gl_VERTEX_SHADER - -instance Shader FragmentShader where - makeShader = FragmentShader - shaderID = fragmentShaderID - shaderType = const gl_FRAGMENT_SHADER - --------------------------------------------------------------------------------- - -instance ObjectName VertexShader where - genObjectNames = genShaderNames - deleteObjectNames = deleteShaderNames - isObjectName = isShaderName - -instance ObjectName FragmentShader where - genObjectNames = genShaderNames - deleteObjectNames = deleteShaderNames - isObjectName = isShaderName - -genShaderNames :: Shader s => Int -> IO [s] -genShaderNames n = replicateM n createShader - -createShader :: Shader s => IO s -createShader = mfix (fmap makeShader . glCreateShader . shaderType) - -deleteShaderNames :: Shader s => [s] -> IO () -deleteShaderNames = mapM_ (glDeleteShader . shaderID) - -isShaderName :: Shader s => s -> IO Bool -isShaderName = fmap unmarshalGLboolean . glIsShader . shaderID - --------------------------------------------------------------------------------- - -compileShader :: Shader s => s -> IO () -compileShader = glCompileShader . shaderID - --------------------------------------------------------------------------------- - -shaderSource :: Shader s => s -> StateVar [String] -shaderSource shader = - makeStateVar (getShaderSource shader) (setShaderSource shader) - -setShaderSource :: Shader s => s -> [String] -> IO () -setShaderSource shader srcs = do - let len = genericLength srcs - withMany withGLStringLen srcs $ \charBufsAndLengths -> do - let (charBufs, lengths) = unzip charBufsAndLengths - withArray charBufs $ \charBufsBuf -> - withArray (map fromIntegral lengths) $ \lengthsBuf -> - glShaderSource (shaderID shader) len charBufsBuf lengthsBuf - -getShaderSource :: Shader s => s -> IO [String] -getShaderSource shader = do - src <- get (stringQuery (shaderSourceLength shader) - (glGetShaderSource (shaderID shader))) - return [src] - -stringQuery :: GettableStateVar GLsizei -> (GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()) -> GettableStateVar String -stringQuery lengthVar getStr = - makeGettableStateVar $ do - len <- get lengthVar -- Note: This includes the NUL character! - if len == 0 - then return "" - else allocaArray (fromIntegral len) $ \buf -> do - getStr len nullPtr buf - peekGLstringLen (buf, len-1) - --------------------------------------------------------------------------------- - -shaderInfoLog :: Shader s => s -> GettableStateVar String -shaderInfoLog shader = - stringQuery (shaderInfoLogLength shader) (glGetShaderInfoLog (shaderID shader)) - --------------------------------------------------------------------------------- - -shaderDeleteStatus :: Shader s => s -> GettableStateVar Bool -shaderDeleteStatus = shaderVar unmarshalGLboolean ShaderDeleteStatus - -compileStatus :: Shader s => s -> GettableStateVar Bool -compileStatus = shaderVar unmarshalGLboolean CompileStatus - -shaderInfoLogLength :: Shader s => s -> GettableStateVar GLsizei -shaderInfoLogLength = shaderVar fromIntegral ShaderInfoLogLength - -shaderSourceLength :: Shader s => s -> GettableStateVar GLsizei -shaderSourceLength = shaderVar fromIntegral ShaderSourceLength - -shaderTypeEnum :: Shader s => s -> GettableStateVar GLenum -shaderTypeEnum = shaderVar fromIntegral ShaderType - --------------------------------------------------------------------------------- - -data GetShaderPName = - ShaderDeleteStatus - | CompileStatus - | ShaderInfoLogLength - | ShaderSourceLength - | ShaderType - -marshalGetShaderPName :: GetShaderPName -> GLenum -marshalGetShaderPName x = case x of - ShaderDeleteStatus -> gl_DELETE_STATUS - CompileStatus -> gl_COMPILE_STATUS - ShaderInfoLogLength -> gl_INFO_LOG_LENGTH - ShaderSourceLength -> gl_SHADER_SOURCE_LENGTH - ShaderType -> gl_SHADER_TYPE - -shaderVar :: Shader s => (GLint -> a) -> GetShaderPName -> s -> GettableStateVar a -shaderVar f p shader = - makeGettableStateVar $ - alloca $ \buf -> do - glGetShaderiv (shaderID shader) (marshalGetShaderPName p) buf - peek1 f buf - --------------------------------------------------------------------------------- - -newtype Program = Program { programID :: GLuint } - deriving ( Eq, Ord, Show ) - -instance ObjectName Program where - genObjectNames n = replicateM n $ fmap Program glCreateProgram - deleteObjectNames = mapM_ (glDeleteProgram . programID) - isObjectName = fmap unmarshalGLboolean . glIsProgram . programID - --------------------------------------------------------------------------------- - -attachedShaders :: Program -> StateVar ([VertexShader],[FragmentShader]) -attachedShaders program = - makeStateVar (getAttachedShaders program) (setAttachedShaders program) - -getAttachedShaders :: Program -> IO ([VertexShader],[FragmentShader]) -getAttachedShaders program = getAttachedShaderIDs program >>= splitShaderIDs - -getAttachedShaderIDs :: Program -> IO [GLuint] -getAttachedShaderIDs program = do - numShaders <- get (numAttachedShaders program) - allocaArray (fromIntegral numShaders) $ \buf -> do - glGetAttachedShaders (programID program) numShaders nullPtr buf - peekArray (fromIntegral numShaders) buf - -splitShaderIDs :: [GLuint] -> IO ([VertexShader],[FragmentShader]) -splitShaderIDs ids = do - (vs, fs) <- partitionM isVertexShaderID ids - return (map VertexShader vs, map FragmentShader fs) - -isVertexShaderID :: GLuint -> IO Bool -isVertexShaderID x = do - t <- get (shaderTypeEnum (VertexShader x)) - return $ t == shaderType (undefined :: VertexShader) - -partitionM :: (a -> IO Bool) -> [a] -> IO ([a],[a]) -partitionM p = foldM select ([],[]) - where select (ts, fs) x = do - b <- p x - return $ if b then (x:ts, fs) else (ts, x:fs) - -setAttachedShaders :: Program -> ([VertexShader],[FragmentShader]) -> IO () -setAttachedShaders p@(Program program) (vs, fs) = do - currentIDs <- getAttachedShaderIDs p - let newIDs = map shaderID vs ++ map shaderID fs - mapM_ (glAttachShader program) (newIDs \\ currentIDs) - mapM_ (glDetachShader program) (currentIDs \\ newIDs) - --------------------------------------------------------------------------------- - -linkProgram :: Program -> IO () -linkProgram (Program program) = glLinkProgram program - -currentProgram :: StateVar (Maybe Program) -currentProgram = - makeStateVar - (do p <- getCurrentProgram - return $ if p == noProgram then Nothing else Just p) - ((\(Program p) -> glUseProgram p) . maybe noProgram id) - -getCurrentProgram :: IO Program -getCurrentProgram = fmap Program $ getInteger1 fromIntegral GetCurrentProgram - -noProgram :: Program -noProgram = Program 0 - -validateProgram :: Program -> IO () -validateProgram (Program program) = glValidateProgram program - -programInfoLog :: Program -> GettableStateVar String -programInfoLog p = - stringQuery (programInfoLogLength p) (glGetProgramInfoLog (programID p)) - --------------------------------------------------------------------------------- - -programDeleteStatus :: Program -> GettableStateVar Bool -programDeleteStatus = programVar unmarshalGLboolean ProgramDeleteStatus - -linkStatus :: Program -> GettableStateVar Bool -linkStatus = programVar unmarshalGLboolean LinkStatus - -validateStatus :: Program -> GettableStateVar Bool -validateStatus = programVar unmarshalGLboolean ValidateStatus - -programInfoLogLength :: Program -> GettableStateVar GLsizei -programInfoLogLength = programVar fromIntegral ProgramInfoLogLength - -numAttachedShaders :: Program -> GettableStateVar GLsizei -numAttachedShaders = programVar fromIntegral AttachedShaders - -activeAttributes :: Program -> GettableStateVar GLuint -activeAttributes = programVar fromIntegral ActiveAttributes - -activeAttributeMaxLength :: Program -> GettableStateVar GLsizei -activeAttributeMaxLength = programVar fromIntegral ActiveAttributeMaxLength - -numActiveUniforms :: Program -> GettableStateVar GLuint -numActiveUniforms = programVar fromIntegral ActiveUniforms - -activeUniformMaxLength :: Program -> GettableStateVar GLsizei -activeUniformMaxLength = programVar fromIntegral ActiveUniformMaxLength - --------------------------------------------------------------------------------- - -data GetProgramPName = - ProgramDeleteStatus - | LinkStatus - | ValidateStatus - | ProgramInfoLogLength - | AttachedShaders - | ActiveAttributes - | ActiveAttributeMaxLength - | ActiveUniforms - | ActiveUniformMaxLength - -marshalGetProgramPName :: GetProgramPName -> GLenum -marshalGetProgramPName x = case x of - ProgramDeleteStatus -> gl_DELETE_STATUS - LinkStatus -> gl_LINK_STATUS - ValidateStatus -> gl_VALIDATE_STATUS - ProgramInfoLogLength -> gl_INFO_LOG_LENGTH - AttachedShaders -> gl_ATTACHED_SHADERS - ActiveAttributes -> gl_ACTIVE_ATTRIBUTES - ActiveAttributeMaxLength -> gl_ACTIVE_ATTRIBUTE_MAX_LENGTH - ActiveUniforms -> gl_ACTIVE_UNIFORMS - ActiveUniformMaxLength -> gl_ACTIVE_UNIFORM_MAX_LENGTH - -programVar :: (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a -programVar f p program = - makeGettableStateVar $ - alloca $ \buf -> do - glGetProgramiv (programID program) (marshalGetProgramPName p) buf - peek1 f buf - --------------------------------------------------------------------------------- - -attribLocation :: Program -> String -> StateVar AttribLocation -attribLocation program name = - makeStateVar (getAttribLocation program name) - (\location -> bindAttribLocation program location name) - -getAttribLocation :: Program -> String -> IO AttribLocation -getAttribLocation (Program program) name = - fmap (AttribLocation . fromIntegral) $ - withGLString name $ - glGetAttribLocation program - -bindAttribLocation :: Program -> AttribLocation -> String -> IO () -bindAttribLocation (Program program) (AttribLocation location) name = - withGLString name $ - glBindAttribLocation program location - --------------------------------------------------------------------------------- - --- Table 2.9 of the OpenGL 3.1 spec: OpenGL Shading Language type tokens -data VariableType = - Float' - | FloatVec2 - | FloatVec3 - | FloatVec4 - | Int' - | IntVec2 - | IntVec3 - | IntVec4 - | UnsignedInt' - | UnsignedIntVec2 - | UnsignedIntVec3 - | UnsignedIntVec4 - | Bool - | BoolVec2 - | BoolVec3 - | BoolVec4 - | FloatMat2 - | FloatMat3 - | FloatMat4 - | FloatMat2x3 - | FloatMat2x4 - | FloatMat3x2 - | FloatMat3x4 - | FloatMat4x2 - | FloatMat4x3 - | Sampler1D - | Sampler2D - | Sampler3D - | SamplerCube - | Sampler1DShadow - | Sampler2DShadow - | Sampler1DArray - | Sampler2DArray - | Sampler1DArrayShadow - | Sampler2DArrayShadow - | SamplerCubeShadow - | Sampler2DRect - | Sampler2DRectShadow - | IntSampler1D - | IntSampler2D - | IntSampler3D - | IntSamplerCube - | IntSampler1DArray - | IntSampler2DArray - | UnsignedIntSampler1D - | UnsignedIntSampler2D - | UnsignedIntSampler3D - | UnsignedIntSamplerCube - | UnsignedIntSampler1DArray - | UnsignedIntSampler2DArray - deriving ( Eq, Ord, Show ) - -unmarshalVariableType :: GLenum -> VariableType -unmarshalVariableType x - | x == gl_FLOAT = Float' - | x == gl_FLOAT_VEC2 = FloatVec2 - | x == gl_FLOAT_VEC3 = FloatVec3 - | x == gl_FLOAT_VEC4 = FloatVec4 - | x == gl_INT = Int' - | x == gl_INT_VEC2 = IntVec2 - | x == gl_INT_VEC3 = IntVec3 - | x == gl_INT_VEC4 = IntVec4 - | x == gl_UNSIGNED_INT = UnsignedInt' - | x == gl_UNSIGNED_INT_VEC2 = UnsignedIntVec2 - | x == gl_UNSIGNED_INT_VEC3 = UnsignedIntVec3 - | x == gl_UNSIGNED_INT_VEC4 = UnsignedIntVec4 - | x == gl_BOOL = Bool - | x == gl_BOOL_VEC2 = BoolVec2 - | x == gl_BOOL_VEC3 = BoolVec3 - | x == gl_BOOL_VEC4 = BoolVec4 - | x == gl_FLOAT_MAT2 = FloatMat2 - | x == gl_FLOAT_MAT3 = FloatMat3 - | x == gl_FLOAT_MAT4 = FloatMat4 - | x == gl_FLOAT_MAT2x3 = FloatMat2x3 - | x == gl_FLOAT_MAT2x4 = FloatMat2x4 - | x == gl_FLOAT_MAT3x2 = FloatMat3x2 - | x == gl_FLOAT_MAT3x4 = FloatMat3x4 - | x == gl_FLOAT_MAT4x2 = FloatMat4x2 - | x == gl_FLOAT_MAT4x3 = FloatMat4x3 - | x == gl_SAMPLER_1D = Sampler1D - | x == gl_SAMPLER_2D = Sampler2D - | x == gl_SAMPLER_3D = Sampler3D - | x == gl_SAMPLER_CUBE = SamplerCube - | x == gl_SAMPLER_1D_SHADOW = Sampler1DShadow - | x == gl_SAMPLER_2D_SHADOW = Sampler2DShadow - | x == gl_SAMPLER_1D_ARRAY = Sampler1DArray - | x == gl_SAMPLER_2D_ARRAY = Sampler2DArray - | x == gl_SAMPLER_1D_ARRAY_SHADOW = Sampler1DArrayShadow - | x == gl_SAMPLER_2D_ARRAY_SHADOW = Sampler2DArrayShadow - | x == gl_SAMPLER_CUBE_SHADOW = SamplerCubeShadow - | x == gl_SAMPLER_2D_RECT = Sampler2DRect - | x == gl_SAMPLER_2D_RECT_SHADOW = Sampler2DRectShadow - | x == gl_INT_SAMPLER_1D = IntSampler1D - | x == gl_INT_SAMPLER_2D = IntSampler2D - | x == gl_INT_SAMPLER_3D = IntSampler3D - | x == gl_INT_SAMPLER_CUBE = IntSamplerCube - | x == gl_INT_SAMPLER_1D_ARRAY = IntSampler1DArray - | x == gl_INT_SAMPLER_2D_ARRAY = IntSampler2DArray - | x == gl_UNSIGNED_INT_SAMPLER_1D = UnsignedIntSampler1D - | x == gl_UNSIGNED_INT_SAMPLER_2D = UnsignedIntSampler2D - | x == gl_UNSIGNED_INT_SAMPLER_3D = UnsignedIntSampler3D - | x == gl_UNSIGNED_INT_SAMPLER_CUBE = UnsignedIntSamplerCube - | x == gl_UNSIGNED_INT_SAMPLER_1D_ARRAY = UnsignedIntSampler1DArray - | x == gl_UNSIGNED_INT_SAMPLER_2D_ARRAY = UnsignedIntSampler2DArray - | otherwise = error ("unmarshalVariableType: illegal value " ++ show x) - --------------------------------------------------------------------------------- - -activeVars :: (Program -> GettableStateVar GLuint) - -> (Program -> GettableStateVar GLsizei) - -> (GLuint -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ()) - -> Program -> GettableStateVar [(GLint,VariableType,String)] -activeVars numVars maxLength getter p@(Program program) = - makeGettableStateVar $ do - numActiveVars <- get (numVars p) - maxLen <- get (maxLength p) - allocaArray (fromIntegral maxLen) $ \nameBuf -> - alloca $ \nameLengthBuf -> - alloca $ \sizeBuf -> - alloca $ \typeBuf -> - flip mapM [0 .. numActiveVars - 1] $ \i -> do - getter program i maxLen nameLengthBuf sizeBuf typeBuf nameBuf - l <- peek nameLengthBuf - s <- peek sizeBuf - t <- peek typeBuf - n <- peekGLstringLen (nameBuf, l) - return (s, unmarshalVariableType t, n) - -activeAttribs :: Program -> GettableStateVar [(GLint,VariableType,String)] -activeAttribs = activeVars activeAttributes activeAttributeMaxLength glGetActiveAttrib - --------------------------------------------------------------------------------- - -newtype UniformLocation = UniformLocation GLint - deriving ( Eq, Ord, Show ) - -uniformLocation :: Program -> String -> GettableStateVar UniformLocation -uniformLocation (Program program) name = - makeGettableStateVar $ - fmap UniformLocation $ - withGLString name $ - glGetUniformLocation program - --------------------------------------------------------------------------------- - -activeUniforms :: Program -> GettableStateVar [(GLint,VariableType,String)] -activeUniforms = activeVars numActiveUniforms activeUniformMaxLength glGetActiveUniform - --------------------------------------------------------------------------------- - -class Storable a => UniformComponent a where - uniform1 :: UniformLocation -> a -> IO () - uniform2 :: UniformLocation -> a -> a -> IO () - uniform3 :: UniformLocation -> a -> a -> a -> IO () - uniform4 :: UniformLocation -> a -> a -> a -> a -> IO () - - getUniform :: Storable (b a) => Program -> UniformLocation -> Ptr (b a) -> IO () - - uniform1v :: UniformLocation -> GLsizei -> Ptr a -> IO () - uniform2v :: UniformLocation -> GLsizei -> Ptr a -> IO () - uniform3v :: UniformLocation -> GLsizei -> Ptr a -> IO () - uniform4v :: UniformLocation -> GLsizei -> Ptr a -> IO () - -instance UniformComponent GLint where - uniform1 (UniformLocation ul) = glUniform1i ul - uniform2 (UniformLocation ul) = glUniform2i ul - uniform3 (UniformLocation ul) = glUniform3i ul - uniform4 (UniformLocation ul) = glUniform4i ul - - getUniform (Program p) (UniformLocation ul) = glGetUniformiv p ul . castPtr - - uniform1v (UniformLocation ul) = glUniform1iv ul - uniform2v (UniformLocation ul) = glUniform2iv ul - uniform3v (UniformLocation ul) = glUniform3iv ul - uniform4v (UniformLocation ul) = glUniform4iv ul - -instance UniformComponent GLuint where - uniform1 (UniformLocation ul) = glUniform1ui ul - uniform2 (UniformLocation ul) = glUniform2ui ul - uniform3 (UniformLocation ul) = glUniform3ui ul - uniform4 (UniformLocation ul) = glUniform4ui ul - - getUniform (Program p) (UniformLocation ul) = glGetUniformuiv p ul . castPtr - - uniform1v (UniformLocation ul) = glUniform1uiv ul - uniform2v (UniformLocation ul) = glUniform2uiv ul - uniform3v (UniformLocation ul) = glUniform3uiv ul - uniform4v (UniformLocation ul) = glUniform4uiv ul - -instance UniformComponent GLfloat where - uniform1 (UniformLocation ul) = glUniform1f ul - uniform2 (UniformLocation ul) = glUniform2f ul - uniform3 (UniformLocation ul) = glUniform3f ul - uniform4 (UniformLocation ul) = glUniform4f ul - - getUniform (Program p) (UniformLocation ul) = glGetUniformfv p ul . castPtr - - uniform1v (UniformLocation ul) = glUniform1fv ul - uniform2v (UniformLocation ul) = glUniform2fv ul - uniform3v (UniformLocation ul) = glUniform3fv ul - uniform4v (UniformLocation ul) = glUniform4fv ul - -instance UniformComponent GLclampf where - uniform1 (UniformLocation ul) x = glUniform1f ul (realToFrac x) - uniform2 (UniformLocation ul) x y = glUniform2f ul (realToFrac x) (realToFrac y) - uniform3 (UniformLocation ul) x y z = glUniform3f ul (realToFrac x) (realToFrac y) (realToFrac z) - uniform4 (UniformLocation ul) x y z w = glUniform4f ul (realToFrac x) (realToFrac y) (realToFrac z) (realToFrac w) - - getUniform (Program p) (UniformLocation ul) = glGetUniformfv p ul . castPtr - - uniform1v (UniformLocation ul) n = glUniform1fv ul n . castPtr - uniform2v (UniformLocation ul) n = glUniform2fv ul n . castPtr - uniform3v (UniformLocation ul) n = glUniform3fv ul n . castPtr - uniform4v (UniformLocation ul) n = glUniform4fv ul n . castPtr - --------------------------------------------------------------------------------- - -class Uniform a where - uniform :: UniformLocation -> StateVar a - uniformv :: UniformLocation -> GLsizei -> Ptr a -> IO () - -maxComponentSize :: Int -maxComponentSize = sizeOf (undefined :: GLint) `max` sizeOf (undefined :: GLfloat) - -maxNumComponents :: Int -maxNumComponents = 16 - -maxUniformBufferSize :: Int -maxUniformBufferSize = maxComponentSize * maxNumComponents - -makeUniformVar :: (UniformComponent a, Storable (b a)) - => (UniformLocation -> b a -> IO ()) - -> UniformLocation -> StateVar (b a) -makeUniformVar setter location = makeStateVar getter (setter location) - where getter = do - program <- getCurrentProgram - allocaBytes maxUniformBufferSize $ \buf -> do - getUniform program location buf - peek buf - -instance UniformComponent a => Uniform (Vertex2 a) where - uniform = makeUniformVar $ \location (Vertex2 x y) -> uniform2 location x y - uniformv location count = uniform2v location count . (castPtr :: Ptr (Vertex2 b) -> Ptr b) - -instance UniformComponent a => Uniform (Vertex3 a) where - uniform = makeUniformVar $ \location (Vertex3 x y z) -> uniform3 location x y z - uniformv location count = uniform3v location count . (castPtr :: Ptr (Vertex3 b) -> Ptr b) - -instance UniformComponent a => Uniform (Vertex4 a) where - uniform = makeUniformVar $ \location (Vertex4 x y z w) -> uniform4 location x y z w - uniformv location count = uniform4v location count . (castPtr :: Ptr (Vertex4 b) -> Ptr b) - -instance UniformComponent a => Uniform (TexCoord1 a) where - uniform = makeUniformVar $ \location (TexCoord1 s) -> uniform1 location s - uniformv location count = uniform1v location count . (castPtr :: Ptr (TexCoord1 b) -> Ptr b) - -instance UniformComponent a => Uniform (TexCoord2 a) where - uniform = makeUniformVar $ \location (TexCoord2 s t) -> uniform2 location s t - uniformv location count = uniform2v location count . (castPtr :: Ptr (TexCoord2 b) -> Ptr b) - -instance UniformComponent a => Uniform (TexCoord3 a) where - uniform = makeUniformVar $ \location (TexCoord3 s t r) -> uniform3 location s t r - uniformv location count = uniform3v location count . (castPtr :: Ptr (TexCoord3 b) -> Ptr b) - -instance UniformComponent a => Uniform (TexCoord4 a) where - uniform = makeUniformVar $ \location (TexCoord4 s t r q) -> uniform4 location s t r q - uniformv location count = uniform4v location count . (castPtr :: Ptr (TexCoord4 b) -> Ptr b) - -instance UniformComponent a => Uniform (Normal3 a) where - uniform = makeUniformVar $ \location (Normal3 x y z) -> uniform3 location x y z - uniformv location count = uniform3v location count . (castPtr :: Ptr (Normal3 b) -> Ptr b) - -instance UniformComponent a => Uniform (FogCoord1 a) where - uniform = makeUniformVar $ \location (FogCoord1 c) -> uniform1 location c - uniformv location count = uniform1v location count . (castPtr :: Ptr (FogCoord1 b) -> Ptr b) - -instance UniformComponent a => Uniform (Color3 a) where - uniform = makeUniformVar $ \location (Color3 r g b) -> uniform3 location r g b - uniformv location count = uniform3v location count . (castPtr :: Ptr (Color3 b) -> Ptr b) - -instance UniformComponent a => Uniform (Color4 a) where - uniform = makeUniformVar $ \location (Color4 r g b a) -> uniform4 location r g b a - uniformv location count = uniform4v location count . (castPtr :: Ptr (Color4 b) -> Ptr b) - -instance UniformComponent a => Uniform (Index1 a) where - uniform = makeUniformVar $ \location (Index1 i) -> uniform1 location i - uniformv location count = uniform1v location count . (castPtr :: Ptr (Index1 b) -> Ptr b) - --------------------------------------------------------------------------------- - --- | Contains the number of hardware units that can be used to access texture --- maps from the vertex processor. The minimum legal value is 0. - -maxVertexTextureImageUnits :: GettableStateVar GLsizei -maxVertexTextureImageUnits = getLimit GetMaxVertexTextureImageUnits - --- | Contains the total number of hardware units that can be used to access --- texture maps from the fragment processor. The minimum legal value is 2. - -maxTextureImageUnits :: GettableStateVar GLsizei -maxTextureImageUnits = getLimit GetMaxTextureImageUnits - --- | Contains the total number of hardware units that can be used to access --- texture maps from the vertex processor and the fragment processor combined. --- Note: If the vertex shader and the fragment processing stage access the same --- texture image unit, then that counts as using two texture image units. The --- minimum legal value is 2. - -maxCombinedTextureImageUnits :: GettableStateVar GLsizei -maxCombinedTextureImageUnits = getLimit GetMaxCombinedTextureImageUnits - --- | Contains the number of texture coordinate sets that are available. The --- minimum legal value is 2. - -maxTextureCoords :: GettableStateVar GLsizei -maxTextureCoords = getLimit GetMaxTextureCoords - --- | Contains the number of individual components (i.e., floating-point, integer --- or boolean values) that are available for vertex shader uniform variables. --- The minimum legal value is 512. -maxVertexUniformComponents :: GettableStateVar GLsizei -maxVertexUniformComponents = getLimit GetMaxVertexUniformComponents - --- | Contains the number of individual components (i.e., floating-point, integer --- or boolean values) that are available for fragment shader uniform variables. --- The minimum legal value is 64. - -maxFragmentUniformComponents :: GettableStateVar GLsizei -maxFragmentUniformComponents = getLimit GetMaxFragmentUniformComponents - --- | Contains the number of active vertex attributes that are available. The --- minimum legal value is 16. - -maxVertexAttribs :: GettableStateVar GLsizei -maxVertexAttribs = getLimit GetMaxVertexAttribs - --- | Contains the number of individual floating-point values available for --- varying variables. The minimum legal value is 32. - -maxVaryingFloats :: GettableStateVar GLsizei -maxVaryingFloats = getLimit GetMaxVaryingFloats +import Graphics.Rendering.OpenGL.GL.Shaders.Shaders +import Graphics.Rendering.OpenGL.GL.Shaders.Attribs +import Graphics.Rendering.OpenGL.GL.Shaders.Limits +import Graphics.Rendering.OpenGL.GL.Shaders.Program +import Graphics.Rendering.OpenGL.GL.Shaders.Uniform +import Graphics.Rendering.OpenGL.GL.Shaders.Variables -getLimit :: GetPName -> GettableStateVar GLsizei -getLimit = makeGettableStateVar . getSizei1 id diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs @@ -0,0 +1,58 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Attribs +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- This module contains functions related to shader attributes, this corresponds +-- to section 2.20.3 of the OpenGL 3.1 spec (Shader Variables). +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.Shaders.Attribs ( + attribLocation, activeAttribs, +) where + +import Graphics.Rendering.OpenGL.GL.GLstring + + +import Data.StateVar +import Graphics.Rendering.OpenGL.GL.QueryUtils +import Graphics.Rendering.OpenGL.Raw.Core31 + +import Graphics.Rendering.OpenGL.GL.Shaders.Program +import Graphics.Rendering.OpenGL.GL.Shaders.Variables + +-------------------------------------------------------------------------------- + +activeAttributes :: Program -> GettableStateVar GLuint +activeAttributes = programVar fromIntegral ActiveAttributes + +activeAttributeMaxLength :: Program -> GettableStateVar GLsizei +activeAttributeMaxLength = programVar fromIntegral ActiveAttributeMaxLength + +-------------------------------------------------------------------------------- + +attribLocation :: Program -> String -> StateVar AttribLocation +attribLocation program name = + makeStateVar (getAttribLocation program name) + (\location -> bindAttribLocation program location name) + +getAttribLocation :: Program -> String -> IO AttribLocation +getAttribLocation (Program program) name = + fmap (AttribLocation . fromIntegral) $ + withGLString name $ + glGetAttribLocation program + +bindAttribLocation :: Program -> AttribLocation -> String -> IO () +bindAttribLocation (Program program) (AttribLocation location) name = + withGLString name $ + glBindAttribLocation program location + +-------------------------------------------------------------------------------- + +activeAttribs :: Program -> GettableStateVar [(GLint,VariableType,String)] +activeAttribs = activeVars activeAttributes activeAttributeMaxLength glGetActiveAttrib diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs @@ -0,0 +1,79 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Limits +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.Shaders.Limits ( + maxVertexTextureImageUnits, maxTextureImageUnits, + maxCombinedTextureImageUnits, maxTextureCoords, maxVertexUniformComponents, + maxFragmentUniformComponents, maxVertexAttribs, maxVaryingFloats +) where + +import Data.StateVar +import Graphics.Rendering.OpenGL.GL.QueryUtils +import Graphics.Rendering.OpenGL.Raw.Core31 + + +-- | Contains the number of hardware units that can be used to access texture +-- maps from the vertex processor. The minimum legal value is 0. + +maxVertexTextureImageUnits :: GettableStateVar GLsizei +maxVertexTextureImageUnits = getLimit GetMaxVertexTextureImageUnits + +-- | Contains the total number of hardware units that can be used to access +-- texture maps from the fragment processor. The minimum legal value is 2. + +maxTextureImageUnits :: GettableStateVar GLsizei +maxTextureImageUnits = getLimit GetMaxTextureImageUnits + +-- | Contains the total number of hardware units that can be used to access +-- texture maps from the vertex processor and the fragment processor combined. +-- Note: If the vertex shader and the fragment processing stage access the same +-- texture image unit, then that counts as using two texture image units. The +-- minimum legal value is 2. + +maxCombinedTextureImageUnits :: GettableStateVar GLsizei +maxCombinedTextureImageUnits = getLimit GetMaxCombinedTextureImageUnits + +-- | Contains the number of texture coordinate sets that are available. The +-- minimum legal value is 2. + +maxTextureCoords :: GettableStateVar GLsizei +maxTextureCoords = getLimit GetMaxTextureCoords + +-- | Contains the number of individual components (i.e., floating-point, integer +-- or boolean values) that are available for vertex shader uniform variables. +-- The minimum legal value is 512. +maxVertexUniformComponents :: GettableStateVar GLsizei +maxVertexUniformComponents = getLimit GetMaxVertexUniformComponents + +-- | Contains the number of individual components (i.e., floating-point, integer +-- or boolean values) that are available for fragment shader uniform variables. +-- The minimum legal value is 64. + +maxFragmentUniformComponents :: GettableStateVar GLsizei +maxFragmentUniformComponents = getLimit GetMaxFragmentUniformComponents + +-- | Contains the number of active vertex attributes that are available. The +-- minimum legal value is 16. + +maxVertexAttribs :: GettableStateVar GLsizei +maxVertexAttribs = getLimit GetMaxVertexAttribs + +-- | Contains the number of individual floating-point values available for +-- varying variables. The minimum legal value is 32. + +maxVaryingFloats :: GettableStateVar GLsizei +maxVaryingFloats = getLimit GetMaxVaryingFloats + +getLimit :: PName1I -> GettableStateVar GLsizei +getLimit = makeGettableStateVar . getSizei1 id diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs @@ -0,0 +1,197 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Program +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- This module correspons with section 2.20.2 (Program Objects) of the OpenGL +-- 3.1 spec. +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.Shaders.Program ( + + -- * Program Objects + Program(..), programDeleteStatus, attachedShaders, linkProgram, linkStatus, + programInfoLog, validateProgram, validateStatus, currentProgram, + + bindFragDataLocation, getFragDataLocation, + + -- * internals + GetProgramPName(..), programVar, getCurrentProgram +) where + +import Control.Monad +import Data.List +import Data.Maybe (fromMaybe) +import Data.ObjectName +import Data.StateVar +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr +import Graphics.Rendering.OpenGL.GL.Framebuffer +import Graphics.Rendering.OpenGL.GL.GLboolean +import Graphics.Rendering.OpenGL.GL.GLstring +import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.GL.QueryUtils +import Graphics.Rendering.OpenGL.Raw.Core31 + +import Graphics.Rendering.OpenGL.GL.Shaders.Shaders + +-------------------------------------------------------------------------------- + +newtype Program = Program { programID :: GLuint } + deriving ( Eq, Ord, Show ) + +instance ObjectName Program where + genObjectNames n = replicateM n $ fmap Program glCreateProgram + deleteObjectNames = mapM_ (glDeleteProgram . programID) + isObjectName = fmap unmarshalGLboolean . glIsProgram . programID + +-------------------------------------------------------------------------------- + +attachedShaders :: Program -> StateVar ([VertexShader],[FragmentShader]) +attachedShaders program = + makeStateVar (getAttachedShaders program) (setAttachedShaders program) + +getAttachedShaders :: Program -> IO ([VertexShader],[FragmentShader]) +getAttachedShaders program = getAttachedShaderIDs program >>= splitShaderIDs + +getAttachedShaderIDs :: Program -> IO [GLuint] +getAttachedShaderIDs program = do + numShaders <- get (numAttachedShaders program) + allocaArray (fromIntegral numShaders) $ \buf -> do + glGetAttachedShaders (programID program) numShaders nullPtr buf + peekArray (fromIntegral numShaders) buf + +splitShaderIDs :: [GLuint] -> IO ([VertexShader],[FragmentShader]) +splitShaderIDs ids = do + (vs, fs) <- partitionM isVertexShaderID ids + return (map VertexShader vs, map FragmentShader fs) + +isVertexShaderID :: GLuint -> IO Bool +isVertexShaderID x = do + t <- get (shaderTypeEnum (VertexShader x)) + return $ t == shaderType (undefined :: VertexShader) + +partitionM :: (a -> IO Bool) -> [a] -> IO ([a],[a]) +partitionM p = foldM select ([],[]) + where select (ts, fs) x = do + b <- p x + return $ if b then (x:ts, fs) else (ts, x:fs) + +setAttachedShaders :: Program -> ([VertexShader],[FragmentShader]) -> IO () +setAttachedShaders p@(Program program) (vs, fs) = do + currentIDs <- getAttachedShaderIDs p + let newIDs = map shaderID vs ++ map shaderID fs + mapM_ (glAttachShader program) (newIDs \\ currentIDs) + mapM_ (glDetachShader program) (currentIDs \\ newIDs) + +-------------------------------------------------------------------------------- + +linkProgram :: Program -> IO () +linkProgram (Program program) = glLinkProgram program + +currentProgram :: StateVar (Maybe Program) +currentProgram = + makeStateVar + (do p <- getCurrentProgram + return $ if p == noProgram then Nothing else Just p) + ((\(Program p) -> glUseProgram p) . fromMaybe noProgram) + +getCurrentProgram :: IO Program +getCurrentProgram = fmap Program $ getInteger1 fromIntegral GetCurrentProgram + +noProgram :: Program +noProgram = Program 0 + +validateProgram :: Program -> IO () +validateProgram (Program program) = glValidateProgram program + +programInfoLog :: Program -> GettableStateVar String +programInfoLog p = + stringQuery (programInfoLogLength p) (glGetProgramInfoLog (programID p)) + +-------------------------------------------------------------------------------- + +programDeleteStatus :: Program -> GettableStateVar Bool +programDeleteStatus = programVar unmarshalGLboolean ProgramDeleteStatus + +linkStatus :: Program -> GettableStateVar Bool +linkStatus = programVar unmarshalGLboolean LinkStatus + +validateStatus :: Program -> GettableStateVar Bool +validateStatus = programVar unmarshalGLboolean ValidateStatus + +programInfoLogLength :: Program -> GettableStateVar GLsizei +programInfoLogLength = programVar fromIntegral ProgramInfoLogLength + +numAttachedShaders :: Program -> GettableStateVar GLsizei +numAttachedShaders = programVar fromIntegral AttachedShaders + +-------------------------------------------------------------------------------- + +data GetProgramPName = + ProgramDeleteStatus + | LinkStatus + | ValidateStatus + | ProgramInfoLogLength + | AttachedShaders + | ActiveAttributes + | ActiveAttributeMaxLength + | ActiveUniforms + | ActiveUniformMaxLength + | TransformFeedbackBufferMode + | TransformFeedbackVaryings + | TransformFeedbackVaryingMaxLength + +marshalGetProgramPName :: GetProgramPName -> GLenum +marshalGetProgramPName x = case x of + ProgramDeleteStatus -> gl_DELETE_STATUS + LinkStatus -> gl_LINK_STATUS + ValidateStatus -> gl_VALIDATE_STATUS + ProgramInfoLogLength -> gl_INFO_LOG_LENGTH + AttachedShaders -> gl_ATTACHED_SHADERS + ActiveAttributes -> gl_ACTIVE_ATTRIBUTES + ActiveAttributeMaxLength -> gl_ACTIVE_ATTRIBUTE_MAX_LENGTH + ActiveUniforms -> gl_ACTIVE_UNIFORMS + ActiveUniformMaxLength -> gl_ACTIVE_UNIFORM_MAX_LENGTH + TransformFeedbackBufferMode -> gl_TRANSFORM_FEEDBACK_BUFFER_MODE + TransformFeedbackVaryings -> gl_TRANSFORM_FEEDBACK_VARYINGS + TransformFeedbackVaryingMaxLength -> gl_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH + +programVar :: (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a +programVar f p program = + makeGettableStateVar $ + alloca $ \buf -> do + glGetProgramiv (programID program) (marshalGetProgramPName p) buf + peek1 f buf + +-------------------------------------------------------------------------------- + +-- | 'bindFragDataLocation' binds a varying variable, specified by program and name, to a +-- drawbuffer. The effects only take place after succesfull linking of the program. +-- invalid arguments and conditions are +-- - an index larger than maxDrawBufferIndex +-- - names starting with 'gl_' +-- linking failure will ocure when +-- - one of the arguments was invalid +-- - more than one varying varuable name is bound to the same index +-- It's not an error to specify unused variables, those will be ingored. +bindFragDataLocation :: Program -> String -> SettableStateVar DrawBufferIndex +bindFragDataLocation (Program program) varName = makeSettableStateVar $ \ind -> + withGLString varName $ glBindFragDataLocation program ind + +-- | query the binding of a given variable, specified by program and name. The program has to be +-- linked. The result is Nothing if an error occures or the name is not a name of a varying +-- variable. If the program hasn't been linked an 'InvalidOperation' error is generated. +getFragDataLocation :: Program -> String -> IO (Maybe DrawBufferIndex) +getFragDataLocation (Program program) varName = do + r <- withGLString varName $ glGetFragDataLocation program + if r < 0 + then return Nothing + else return . Just $ fromIntegral r diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Shaders.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Shaders.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/Shaders/Shaders.hs @@ -0,0 +1,157 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Shaders +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- This module correspons with section 2.20.1 (Shader Objects) of the OpenGL +-- 3.1 spec. +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.Shaders.Shaders ( + + Shader(..), VertexShader(..), FragmentShader(..), shaderDeleteStatus, shaderSource, + compileShader, compileStatus, shaderInfoLog, + + -- * internals + shaderTypeEnum + +) where + +import Control.Monad +import Control.Monad.Fix +import Data.List +import Data.ObjectName +import Data.StateVar +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Graphics.Rendering.OpenGL.GL.GLboolean +import Graphics.Rendering.OpenGL.GL.GLstring +import Graphics.Rendering.OpenGL.GL.PeekPoke +import Graphics.Rendering.OpenGL.Raw.Core31 + +newtype VertexShader = VertexShader { vertexShaderID :: GLuint } + deriving ( Eq, Ord, Show ) + +newtype FragmentShader = FragmentShader { fragmentShaderID :: GLuint } + deriving ( Eq, Ord, Show ) + +-------------------------------------------------------------------------------- + +class (Eq s, Ord s, Show s, ObjectName s) => Shader s where + shaderID :: s -> GLuint + makeShader :: GLuint -> s + shaderType :: s -> GLenum + +instance Shader VertexShader where + makeShader = VertexShader + shaderID = vertexShaderID + shaderType = const gl_VERTEX_SHADER + +instance Shader FragmentShader where + makeShader = FragmentShader + shaderID = fragmentShaderID + shaderType = const gl_FRAGMENT_SHADER + +-------------------------------------------------------------------------------- + +instance ObjectName VertexShader where + genObjectNames = genShaderNames + deleteObjectNames = deleteShaderNames + isObjectName = isShaderName + +instance ObjectName FragmentShader where + genObjectNames = genShaderNames + deleteObjectNames = deleteShaderNames + isObjectName = isShaderName + +genShaderNames :: Shader s => Int -> IO [s] +genShaderNames n = replicateM n createShader + +createShader :: Shader s => IO s +createShader = mfix (fmap makeShader . glCreateShader . shaderType) + +deleteShaderNames :: Shader s => [s] -> IO () +deleteShaderNames = mapM_ (glDeleteShader . shaderID) + +isShaderName :: Shader s => s -> IO Bool +isShaderName = fmap unmarshalGLboolean . glIsShader . shaderID + +-------------------------------------------------------------------------------- + +compileShader :: Shader s => s -> IO () +compileShader = glCompileShader . shaderID + +-------------------------------------------------------------------------------- + +shaderSource :: Shader s => s -> StateVar [String] +shaderSource shader = + makeStateVar (getShaderSource shader) (setShaderSource shader) + +setShaderSource :: Shader s => s -> [String] -> IO () +setShaderSource shader srcs = do + let len = genericLength srcs + withMany withGLStringLen srcs $ \charBufsAndLengths -> do + let (charBufs, lengths) = unzip charBufsAndLengths + withArray charBufs $ \charBufsBuf -> + withArray (map fromIntegral lengths) $ \lengthsBuf -> + glShaderSource (shaderID shader) len charBufsBuf lengthsBuf + +getShaderSource :: Shader s => s -> IO [String] +getShaderSource shader = do + src <- get (stringQuery (shaderSourceLength shader) + (glGetShaderSource (shaderID shader))) + return [src] + +-------------------------------------------------------------------------------- + +shaderInfoLog :: Shader s => s -> GettableStateVar String +shaderInfoLog shader = + stringQuery (shaderInfoLogLength shader) (glGetShaderInfoLog (shaderID shader)) + +-------------------------------------------------------------------------------- + +shaderDeleteStatus :: Shader s => s -> GettableStateVar Bool +shaderDeleteStatus = shaderVar unmarshalGLboolean ShaderDeleteStatus + +compileStatus :: Shader s => s -> GettableStateVar Bool +compileStatus = shaderVar unmarshalGLboolean CompileStatus + +shaderInfoLogLength :: Shader s => s -> GettableStateVar GLsizei +shaderInfoLogLength = shaderVar fromIntegral ShaderInfoLogLength + +shaderSourceLength :: Shader s => s -> GettableStateVar GLsizei +shaderSourceLength = shaderVar fromIntegral ShaderSourceLength + +shaderTypeEnum :: Shader s => s -> GettableStateVar GLenum +shaderTypeEnum = shaderVar fromIntegral ShaderType + +-------------------------------------------------------------------------------- + +data GetShaderPName = + ShaderDeleteStatus + | CompileStatus + | ShaderInfoLogLength + | ShaderSourceLength + | ShaderType + +marshalGetShaderPName :: GetShaderPName -> GLenum +marshalGetShaderPName x = case x of + ShaderDeleteStatus -> gl_DELETE_STATUS + CompileStatus -> gl_COMPILE_STATUS + ShaderInfoLogLength -> gl_INFO_LOG_LENGTH + ShaderSourceLength -> gl_SHADER_SOURCE_LENGTH + ShaderType -> gl_SHADER_TYPE + +shaderVar :: Shader s => (GLint -> a) -> GetShaderPName -> s -> GettableStateVar a +shaderVar f p shader = + makeGettableStateVar $ + alloca $ \buf -> do + glGetShaderiv (shaderID shader) (marshalGetShaderPName p) buf + peek1 f buf diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs @@ -0,0 +1,201 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Uniform +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- This module contains functions related to shader uniforms, this corresponds +-- to section 2.20.3 of the OpenGL 3.1 spec (Shader Variables). +----------------------------------------------------------------------------- + +{-# LANGUAGE TypeSynonymInstances #-} + +module Graphics.Rendering.OpenGL.GL.Shaders.Uniform ( + -- * Uniform variables + UniformLocation, uniformLocation, activeUniforms, Uniform(..), + UniformComponent, +) where + +import Data.StateVar +import Data.Tensor +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import Graphics.Rendering.OpenGL.GL.GLstring +import Graphics.Rendering.OpenGL.GL.VertexSpec +import Graphics.Rendering.OpenGL.Raw.Core31 + +import Graphics.Rendering.OpenGL.GL.Shaders.Program +import Graphics.Rendering.OpenGL.GL.Shaders.Variables + +-------------------------------------------------------------------------------- + +numActiveUniforms :: Program -> GettableStateVar GLuint +numActiveUniforms = programVar fromIntegral ActiveUniforms + +activeUniformMaxLength :: Program -> GettableStateVar GLsizei +activeUniformMaxLength = programVar fromIntegral ActiveUniformMaxLength + +-------------------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +newtype UniformLocation = UniformLocation GLint + deriving ( Eq, Ord, Show ) + +uniformLocation :: Program -> String -> GettableStateVar UniformLocation +uniformLocation (Program program) name = + makeGettableStateVar $ + fmap UniformLocation $ + withGLString name $ + glGetUniformLocation program + +-------------------------------------------------------------------------------- + +activeUniforms :: Program -> GettableStateVar [(GLint,VariableType,String)] +activeUniforms = activeVars numActiveUniforms activeUniformMaxLength glGetActiveUniform + +-------------------------------------------------------------------------------- + +class Storable a => UniformComponent a where + uniform1 :: UniformLocation -> a -> IO () + uniform2 :: UniformLocation -> a -> a -> IO () + uniform3 :: UniformLocation -> a -> a -> a -> IO () + uniform4 :: UniformLocation -> a -> a -> a -> a -> IO () + + getUniform :: Storable (b a) => Program -> UniformLocation -> Ptr (b a) -> IO () + + uniform1v :: UniformLocation -> GLsizei -> Ptr a -> IO () + uniform2v :: UniformLocation -> GLsizei -> Ptr a -> IO () + uniform3v :: UniformLocation -> GLsizei -> Ptr a -> IO () + uniform4v :: UniformLocation -> GLsizei -> Ptr a -> IO () + +instance UniformComponent GLint where + uniform1 (UniformLocation ul) = glUniform1i ul + uniform2 (UniformLocation ul) = glUniform2i ul + uniform3 (UniformLocation ul) = glUniform3i ul + uniform4 (UniformLocation ul) = glUniform4i ul + + getUniform (Program p) (UniformLocation ul) = glGetUniformiv p ul . castPtr + + uniform1v (UniformLocation ul) = glUniform1iv ul + uniform2v (UniformLocation ul) = glUniform2iv ul + uniform3v (UniformLocation ul) = glUniform3iv ul + uniform4v (UniformLocation ul) = glUniform4iv ul + +instance UniformComponent GLuint where + uniform1 (UniformLocation ul) = glUniform1ui ul + uniform2 (UniformLocation ul) = glUniform2ui ul + uniform3 (UniformLocation ul) = glUniform3ui ul + uniform4 (UniformLocation ul) = glUniform4ui ul + + getUniform (Program p) (UniformLocation ul) = glGetUniformuiv p ul . castPtr + + uniform1v (UniformLocation ul) = glUniform1uiv ul + uniform2v (UniformLocation ul) = glUniform2uiv ul + uniform3v (UniformLocation ul) = glUniform3uiv ul + uniform4v (UniformLocation ul) = glUniform4uiv ul + +instance UniformComponent GLfloat where + uniform1 (UniformLocation ul) = glUniform1f ul + uniform2 (UniformLocation ul) = glUniform2f ul + uniform3 (UniformLocation ul) = glUniform3f ul + uniform4 (UniformLocation ul) = glUniform4f ul + + getUniform (Program p) (UniformLocation ul) = glGetUniformfv p ul . castPtr + + uniform1v (UniformLocation ul) = glUniform1fv ul + uniform2v (UniformLocation ul) = glUniform2fv ul + uniform3v (UniformLocation ul) = glUniform3fv ul + uniform4v (UniformLocation ul) = glUniform4fv ul + +-------------------------------------------------------------------------------- + +class Uniform a where + uniform :: UniformLocation -> StateVar a + uniformv :: UniformLocation -> GLsizei -> Ptr a -> IO () + +maxComponentSize :: Int +maxComponentSize = sizeOf (undefined :: GLint) `max` sizeOf (undefined :: GLfloat) + +maxNumComponents :: Int +maxNumComponents = 16 + +maxUniformBufferSize :: Int +maxUniformBufferSize = maxComponentSize * maxNumComponents + +makeUniformVar :: (UniformComponent a, Storable (b a)) + => (UniformLocation -> b a -> IO ()) + -> UniformLocation -> StateVar (b a) +makeUniformVar setter location = makeStateVar getter (setter location) + where getter = do + program <- getCurrentProgram + allocaBytes maxUniformBufferSize $ \buf -> do + getUniform program location buf + peek buf + +instance UniformComponent a => Uniform (Vertex2 a) where + uniform = makeUniformVar $ \location (Vertex2 x y) -> uniform2 location x y + uniformv location count = uniform2v location count . (castPtr :: Ptr (Vertex2 b) -> Ptr b) + +instance UniformComponent a => Uniform (Vertex3 a) where + uniform = makeUniformVar $ \location (Vertex3 x y z) -> uniform3 location x y z + uniformv location count = uniform3v location count . (castPtr :: Ptr (Vertex3 b) -> Ptr b) + +instance UniformComponent a => Uniform (Vertex4 a) where + uniform = makeUniformVar $ \location (Vertex4 x y z w) -> uniform4 location x y z w + uniformv location count = uniform4v location count . (castPtr :: Ptr (Vertex4 b) -> Ptr b) + +instance UniformComponent a => Uniform (TexCoord1 a) where + uniform = makeUniformVar $ \location (TexCoord1 s) -> uniform1 location s + uniformv location count = uniform1v location count . (castPtr :: Ptr (TexCoord1 b) -> Ptr b) + +instance UniformComponent a => Uniform (TexCoord2 a) where + uniform = makeUniformVar $ \location (TexCoord2 s t) -> uniform2 location s t + uniformv location count = uniform2v location count . (castPtr :: Ptr (TexCoord2 b) -> Ptr b) + +instance UniformComponent a => Uniform (TexCoord3 a) where + uniform = makeUniformVar $ \location (TexCoord3 s t r) -> uniform3 location s t r + uniformv location count = uniform3v location count . (castPtr :: Ptr (TexCoord3 b) -> Ptr b) + +instance UniformComponent a => Uniform (TexCoord4 a) where + uniform = makeUniformVar $ \location (TexCoord4 s t r q) -> uniform4 location s t r q + uniformv location count = uniform4v location count . (castPtr :: Ptr (TexCoord4 b) -> Ptr b) + +instance UniformComponent a => Uniform (Normal3 a) where + uniform = makeUniformVar $ \location (Normal3 x y z) -> uniform3 location x y z + uniformv location count = uniform3v location count . (castPtr :: Ptr (Normal3 b) -> Ptr b) + +instance UniformComponent a => Uniform (FogCoord1 a) where + uniform = makeUniformVar $ \location (FogCoord1 c) -> uniform1 location c + uniformv location count = uniform1v location count . (castPtr :: Ptr (FogCoord1 b) -> Ptr b) + +instance UniformComponent a => Uniform (Color3 a) where + uniform = makeUniformVar $ \location (Color3 r g b) -> uniform3 location r g b + uniformv location count = uniform3v location count . (castPtr :: Ptr (Color3 b) -> Ptr b) + +instance UniformComponent a => Uniform (Color4 a) where + uniform = makeUniformVar $ \location (Color4 r g b a) -> uniform4 location r g b a + uniformv location count = uniform4v location count . (castPtr :: Ptr (Color4 b) -> Ptr b) + +instance UniformComponent a => Uniform (Index1 a) where + uniform = makeUniformVar $ \location (Index1 i) -> uniform1 location i + uniformv location count = uniform1v location count . (castPtr :: Ptr (Index1 b) -> Ptr b) + +-- nasty instance declaration as TextureUnit is not of the form Storable (b a) as requiered for +-- getUniform +instance Uniform TextureUnit where + uniform loc@(UniformLocation ul) = makeStateVar getter setter + where setter (TextureUnit tu) = uniform1 loc tu + getter = do + program <- getCurrentProgram + allocaBytes (sizeOf (undefined :: GLuint)) $ \buf -> do + glGetUniformuiv (programID program) ul buf + tuID <- peek buf + return $ TextureUnit tuID + uniformv location count = uniform1v location count . (castPtr :: Ptr TextureUnit -> Ptr GLuint) + +-------------------------------------------------------------------------------- diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs @@ -0,0 +1,160 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Variables +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- This internal module contains the functions and datatypes used by the +-- Uniform and Attribs modules. +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.Shaders.Variables ( + VariableType(..), activeVars, +) where + +import Graphics.Rendering.OpenGL.GL.GLstring + +import Control.Monad +import Data.StateVar +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable +import Graphics.Rendering.OpenGL.Raw.Core31 + +import Graphics.Rendering.OpenGL.GL.Shaders.Program + +-- Table 2.9 of the OpenGL 3.1 spec: OpenGL Shading Language type tokens +data VariableType = + Float' + | FloatVec2 + | FloatVec3 + | FloatVec4 + | Int' + | IntVec2 + | IntVec3 + | IntVec4 + | UnsignedInt' + | UnsignedIntVec2 + | UnsignedIntVec3 + | UnsignedIntVec4 + | Bool + | BoolVec2 + | BoolVec3 + | BoolVec4 + | FloatMat2 + | FloatMat3 + | FloatMat4 + | FloatMat2x3 + | FloatMat2x4 + | FloatMat3x2 + | FloatMat3x4 + | FloatMat4x2 + | FloatMat4x3 + | Sampler1D + | Sampler2D + | Sampler3D + | SamplerCube + | Sampler1DShadow + | Sampler2DShadow + | Sampler1DArray + | Sampler2DArray + | Sampler1DArrayShadow + | Sampler2DArrayShadow + | SamplerCubeShadow + | Sampler2DRect + | Sampler2DRectShadow + | IntSampler1D + | IntSampler2D + | IntSampler3D + | IntSamplerCube + | IntSampler1DArray + | IntSampler2DArray + | UnsignedIntSampler1D + | UnsignedIntSampler2D + | UnsignedIntSampler3D + | UnsignedIntSamplerCube + | UnsignedIntSampler1DArray + | UnsignedIntSampler2DArray + deriving ( Eq, Ord, Show ) + +unmarshalVariableType :: GLenum -> VariableType +unmarshalVariableType x + | x == gl_FLOAT = Float' + | x == gl_FLOAT_VEC2 = FloatVec2 + | x == gl_FLOAT_VEC3 = FloatVec3 + | x == gl_FLOAT_VEC4 = FloatVec4 + | x == gl_INT = Int' + | x == gl_INT_VEC2 = IntVec2 + | x == gl_INT_VEC3 = IntVec3 + | x == gl_INT_VEC4 = IntVec4 + | x == gl_UNSIGNED_INT = UnsignedInt' + | x == gl_UNSIGNED_INT_VEC2 = UnsignedIntVec2 + | x == gl_UNSIGNED_INT_VEC3 = UnsignedIntVec3 + | x == gl_UNSIGNED_INT_VEC4 = UnsignedIntVec4 + | x == gl_BOOL = Bool + | x == gl_BOOL_VEC2 = BoolVec2 + | x == gl_BOOL_VEC3 = BoolVec3 + | x == gl_BOOL_VEC4 = BoolVec4 + | x == gl_FLOAT_MAT2 = FloatMat2 + | x == gl_FLOAT_MAT3 = FloatMat3 + | x == gl_FLOAT_MAT4 = FloatMat4 + | x == gl_FLOAT_MAT2x3 = FloatMat2x3 + | x == gl_FLOAT_MAT2x4 = FloatMat2x4 + | x == gl_FLOAT_MAT3x2 = FloatMat3x2 + | x == gl_FLOAT_MAT3x4 = FloatMat3x4 + | x == gl_FLOAT_MAT4x2 = FloatMat4x2 + | x == gl_FLOAT_MAT4x3 = FloatMat4x3 + | x == gl_SAMPLER_1D = Sampler1D + | x == gl_SAMPLER_2D = Sampler2D + | x == gl_SAMPLER_3D = Sampler3D + | x == gl_SAMPLER_CUBE = SamplerCube + | x == gl_SAMPLER_1D_SHADOW = Sampler1DShadow + | x == gl_SAMPLER_2D_SHADOW = Sampler2DShadow + | x == gl_SAMPLER_1D_ARRAY = Sampler1DArray + | x == gl_SAMPLER_2D_ARRAY = Sampler2DArray + | x == gl_SAMPLER_1D_ARRAY_SHADOW = Sampler1DArrayShadow + | x == gl_SAMPLER_2D_ARRAY_SHADOW = Sampler2DArrayShadow + | x == gl_SAMPLER_CUBE_SHADOW = SamplerCubeShadow + | x == gl_SAMPLER_2D_RECT = Sampler2DRect + | x == gl_SAMPLER_2D_RECT_SHADOW = Sampler2DRectShadow + | x == gl_INT_SAMPLER_1D = IntSampler1D + | x == gl_INT_SAMPLER_2D = IntSampler2D + | x == gl_INT_SAMPLER_3D = IntSampler3D + | x == gl_INT_SAMPLER_CUBE = IntSamplerCube + | x == gl_INT_SAMPLER_1D_ARRAY = IntSampler1DArray + | x == gl_INT_SAMPLER_2D_ARRAY = IntSampler2DArray + | x == gl_UNSIGNED_INT_SAMPLER_1D = UnsignedIntSampler1D + | x == gl_UNSIGNED_INT_SAMPLER_2D = UnsignedIntSampler2D + | x == gl_UNSIGNED_INT_SAMPLER_3D = UnsignedIntSampler3D + | x == gl_UNSIGNED_INT_SAMPLER_CUBE = UnsignedIntSamplerCube + | x == gl_UNSIGNED_INT_SAMPLER_1D_ARRAY = UnsignedIntSampler1DArray + | x == gl_UNSIGNED_INT_SAMPLER_2D_ARRAY = UnsignedIntSampler2DArray + | otherwise = error ("unmarshalVariableType: illegal value " ++ show x) + +-------------------------------------------------------------------------------- + +activeVars :: (Program -> GettableStateVar GLuint) + -> (Program -> GettableStateVar GLsizei) + -> (GLuint -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ()) + -> Program -> GettableStateVar [(GLint,VariableType,String)] +activeVars numVars maxLength getter p@(Program program) = + makeGettableStateVar $ do + numActiveVars <- get (numVars p) + maxLen <- get (maxLength p) + allocaArray (fromIntegral maxLen) $ \nameBuf -> + alloca $ \nameLengthBuf -> + alloca $ \sizeBuf -> + alloca $ \typeBuf -> + forM [0 .. numActiveVars - 1] $ \i -> do + getter program i maxLen nameLengthBuf sizeBuf typeBuf nameBuf + l <- peek nameLengthBuf + s <- peek sizeBuf + t <- peek typeBuf + n <- peekGLstringLen (nameBuf, l) + return (s, unmarshalVariableType t, n) diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs --- a/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs +++ b/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Texturing.Objects -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -20,6 +20,7 @@ ) where import Data.List +import Data.Maybe (fromMaybe) import Data.ObjectName import Data.StateVar import Foreign.Marshal.Array @@ -57,12 +58,12 @@ makeStateVar (do o <- getEnum1 (TextureObject . fromIntegral) (textureTargetToGetPName t) return $ if o == defaultTextureObject then Nothing else Just o) - (glBindTexture (marshalTextureTarget t) . textureID . (maybe defaultTextureObject id)) + (glBindTexture (marshalTextureTarget t) . textureID . (fromMaybe defaultTextureObject)) defaultTextureObject :: TextureObject defaultTextureObject = TextureObject 0 -textureTargetToGetPName :: TextureTarget -> GetPName +textureTargetToGetPName :: TextureTarget -> PName1I textureTargetToGetPName x = case x of Texture1D -> GetTextureBinding1D Texture2D -> GetTextureBinding2D diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs b/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs --- a/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs +++ b/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs @@ -4,7 +4,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -39,6 +39,10 @@ | Luminance' | LuminanceAlpha' | Intensity + | R8 + | R16 + | RG8 + | RG16 | RGB' | RGBA' | SRGB @@ -82,22 +86,64 @@ | RGBA16 | SRGB8 | SRGB8Alpha8 + | R16F + | RG16F + | RGB16F + | RGBA16F + | R32F + | RG32F + | RGB32F + | RGBA32F + | R8I + | R8UI + | R16I + | R16UI + | R32I + | R32UI + | RG8I + | RG8UI + | RG16I + | RG16UI + | RG32I + | RG32UI + | RGB8I + | RGB8UI + | RGB16I + | RGB16UI + | RGB32I + | RGB32UI + | RGBA8I + | RGBA8UI + | RGBA16I + | RGBA16UI + | RGBA32I + | RGBA32UI | SLuminance8 | SLuminance8Alpha8 | CompressedAlpha | CompressedLuminance | CompressedLuminanceAlpha | CompressedIntensity + | CompressedRed + | CompressedRG | CompressedRGB | CompressedRGBA | CompressedSRGB | CompressedSRGBAlpha | CompressedSLuminance | CompressedSLuminanceAlpha + | CompressedRedRGTC1 + | CompressedSignedRedRGTC1 + | CompressedRG_RGTC2 + | CompressedSignedRG_RGTC2 | DepthComponent32f | Depth32fStencil8 | RGB9E5 | R11fG11fB10f + | StencilIndex1 + | StencilIndex4 + | StencilIndex8 + | StencilIndex16 deriving ( Eq, Ord, Show ) marshalPixelInternalFormat :: PixelInternalFormat -> GLint @@ -106,6 +152,10 @@ DepthComponent' -> gl_DEPTH_COMPONENT Luminance' -> gl_LUMINANCE LuminanceAlpha' -> gl_LUMINANCE_ALPHA + R8 -> gl_R8 + R16 -> gl_R16 + RG8 -> gl_RG8 + RG16 -> gl_RG16 RGB' -> gl_RGB RGBA' -> gl_RGBA SRGB -> gl_SRGB @@ -150,22 +200,64 @@ RGBA16 -> gl_RGBA16 SRGB8 -> gl_SRGB8 SRGB8Alpha8 -> gl_SRGB8_ALPHA8 + R16F -> gl_R16F + RG16F -> gl_RG16F + RGB16F -> gl_RGB16F + RGBA16F -> gl_RGBA16F + R32F -> gl_R32F + RG32F -> gl_RG32F + RGB32F -> gl_RGB32F + RGBA32F -> gl_RGBA32F + R8I -> gl_R8I + R8UI -> gl_R8UI + R16I -> gl_R16I + R16UI -> gl_R16UI + R32I -> gl_R32I + R32UI -> gl_R32UI + RG8I -> gl_RG8I + RG8UI -> gl_RG8UI + RG16I -> gl_RG16I + RG16UI -> gl_RG16UI + RG32I -> gl_R32I + RG32UI -> gl_R32UI + RGB8I -> gl_RGB8I + RGB8UI -> gl_RGB8UI + RGB16I -> gl_RGB16I + RGB16UI -> gl_RGB16UI + RGB32I -> gl_RGB32I + RGB32UI -> gl_RGB32UI + RGBA8I -> gl_RGBA8I + RGBA8UI -> gl_RGBA8UI + RGBA16I -> gl_RGBA16I + RGBA16UI -> gl_RGBA16UI + RGBA32I -> gl_RGBA32I + RGBA32UI -> gl_RGBA32UI SLuminance8 -> gl_SLUMINANCE8 SLuminance8Alpha8 -> gl_SLUMINANCE8_ALPHA8 CompressedAlpha -> gl_COMPRESSED_ALPHA CompressedLuminance -> gl_COMPRESSED_LUMINANCE CompressedLuminanceAlpha -> gl_COMPRESSED_LUMINANCE_ALPHA CompressedIntensity -> gl_COMPRESSED_INTENSITY + CompressedRed -> gl_COMPRESSED_RED + CompressedRG -> gl_COMPRESSED_RG CompressedRGB -> gl_COMPRESSED_RGB CompressedRGBA -> gl_COMPRESSED_RGBA CompressedSRGB -> gl_COMPRESSED_SRGB CompressedSRGBAlpha -> gl_COMPRESSED_SRGB_ALPHA CompressedSLuminance -> gl_COMPRESSED_SLUMINANCE CompressedSLuminanceAlpha -> gl_COMPRESSED_SLUMINANCE_ALPHA + CompressedRedRGTC1 -> gl_COMPRESSED_RED_RGTC1 + CompressedSignedRedRGTC1 -> gl_COMPRESSED_SIGNED_RED_RGTC1 + CompressedRG_RGTC2 -> gl_COMPRESSED_RG_RGTC2 + CompressedSignedRG_RGTC2 -> gl_COMPRESSED_SIGNED_RG_RGTC2 DepthComponent32f -> gl_DEPTH_COMPONENT32F Depth32fStencil8 -> gl_DEPTH32F_STENCIL8 RGB9E5 -> gl_RGB9_E5 R11fG11fB10f -> gl_R11F_G11F_B10F + StencilIndex1 -> gl_STENCIL_INDEX1 + StencilIndex4 -> gl_STENCIL_INDEX4 + StencilIndex8 -> gl_STENCIL_INDEX8 + StencilIndex16 -> gl_STENCIL_INDEX16 -- *sigh* The OpenGL API is sometimes a bit creative in its usage of types... marshalPixelInternalFormat' :: PixelInternalFormat -> GLenum @@ -221,21 +313,63 @@ | y == gl_RGBA16 = RGBA16 | y == gl_SRGB8 = SRGB8 | y == gl_SRGB8_ALPHA8 = SRGB8Alpha8 + | y == gl_R16F = R16F + | y == gl_RG16F = RG16F + | y == gl_RGB16F = RGB16F + | y == gl_RGBA16F = RGBA16F + | y == gl_R32F = R32F + | y == gl_RG32F = RG32F + | y == gl_RGB32F = RGB32F + | y == gl_RGBA32F = RGBA32F + | y == gl_R8I = R8I + | y == gl_R8UI = R8UI + | y == gl_R16I = R16I + | y == gl_R16UI = R16UI + | y == gl_R32I = R32I + | y == gl_R32UI = R32UI + | y == gl_RG8I = RG8I + | y == gl_RG8UI = RG8UI + | y == gl_RG16I = RG16I + | y == gl_RG16UI = RG16UI + | y == gl_R32I = RG32I + | y == gl_R32UI = RG32UI + | y == gl_RGB8I = RGB8I + | y == gl_RGB8UI = RGB8UI + | y == gl_RGB16I = RGB16I + | y == gl_RGB16UI = RGB16UI + | y == gl_RGB32I = RGB32I + | y == gl_RGB32UI = RGB32UI + | y == gl_RGBA8I = RGBA8I + | y == gl_RGBA8UI = RGBA8UI + | y == gl_RGBA16I = RGBA16I + | y == gl_RGBA16UI = RGBA16UI + | y == gl_RGBA32I = RGBA32I + | y == gl_RGBA32UI = RGBA32UI | y == gl_SLUMINANCE8 = SLuminance8 | y == gl_SLUMINANCE8_ALPHA8 = SLuminance8Alpha8 | y == gl_COMPRESSED_ALPHA = CompressedAlpha | y == gl_COMPRESSED_LUMINANCE = CompressedLuminance | y == gl_COMPRESSED_LUMINANCE_ALPHA = CompressedLuminanceAlpha | y == gl_COMPRESSED_INTENSITY = CompressedIntensity + | y == gl_COMPRESSED_RED = CompressedRed + | y == gl_COMPRESSED_RG = CompressedRG | y == gl_COMPRESSED_RGB = CompressedRGB | y == gl_COMPRESSED_RGBA = CompressedRGBA | y == gl_COMPRESSED_SRGB = CompressedSRGB | y == gl_COMPRESSED_SRGB_ALPHA = CompressedSRGBAlpha | y == gl_COMPRESSED_SLUMINANCE = CompressedSLuminance | y == gl_COMPRESSED_SLUMINANCE_ALPHA = CompressedSLuminanceAlpha + | y == gl_COMPRESSED_RED_RGTC1 = CompressedRedRGTC1 + | y == gl_COMPRESSED_SIGNED_RED_RGTC1 = CompressedSignedRedRGTC1 + | y == gl_COMPRESSED_RG_RGTC2 = CompressedRG_RGTC2 + | y == gl_COMPRESSED_SIGNED_RG_RGTC2 = CompressedSignedRG_RGTC2 | y == gl_DEPTH_COMPONENT32F = DepthComponent32f | y == gl_DEPTH32F_STENCIL8 = Depth32fStencil8 | y == gl_RGB9_E5 = RGB9E5 + | y == gl_STENCIL_INDEX1 = StencilIndex1 + | y == gl_STENCIL_INDEX4 = StencilIndex4 + | y == gl_STENCIL_INDEX8 = StencilIndex8 + | y == gl_STENCIL_INDEX16 = StencilIndex16 -- legacy values | y == 1 = Luminance' | y == 2 = LuminanceAlpha' diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs --- a/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs +++ b/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Texturing.Queries -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs --- a/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs +++ b/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Texturing.Specification -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -41,7 +41,6 @@ ) where import Data.StateVar -import Foreign.Marshal.Array import Foreign.Ptr import Graphics.Rendering.OpenGL.GL.CoordTrans import Graphics.Rendering.OpenGL.GL.PixelData @@ -175,9 +174,10 @@ compressedTextureFormats = makeGettableStateVar $ do n <- getInteger1 fromIntegral GetNumCompressedTextureFormats - allocaArray n $ \buf -> do - getIntegerv GetCompressedTextureFormats buf - fmap (map (CompressedTextureFormat . fromIntegral)) $ peekArray n buf +-- allocaArray n $ \buf -> do +-- getIntegerv GetCompressedTextureFormats buf +-- fmap (map (CompressedTextureFormat . fromIntegral)) $ peekArray n buf + getIntegerN (CompressedTextureFormat . fromIntegral) GetCompressedTextureFormats n -------------------------------------------------------------------------------- @@ -249,7 +249,7 @@ maxTextureSize :: TextureTarget -> GettableStateVar GLsizei maxTextureSize = makeGettableStateVar . getInteger1 fromIntegral . textureTargetToMaxQuery -textureTargetToMaxQuery :: TextureTarget -> GetPName +textureTargetToMaxQuery :: TextureTarget -> PName1I textureTargetToMaxQuery x = case x of Texture1D -> GetMaxTextureSize Texture2D -> GetMaxTextureSize diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs b/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs --- a/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs +++ b/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs @@ -4,7 +4,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -15,7 +15,7 @@ module Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget ( TextureTarget(..), marshalTextureTarget, marshalProxyTextureTarget, - CubeMapTarget(..), marshalCubeMapTarget + CubeMapTarget(..), marshalCubeMapTarget, unmarshalCubeMapTarget, ) where import Graphics.Rendering.OpenGL.GL.PixelRectangles @@ -67,3 +67,14 @@ TextureCubeMapNegativeY -> gl_TEXTURE_CUBE_MAP_NEGATIVE_Y TextureCubeMapPositiveZ -> gl_TEXTURE_CUBE_MAP_POSITIVE_Z TextureCubeMapNegativeZ -> gl_TEXTURE_CUBE_MAP_NEGATIVE_Z + +unmarshalCubeMapTarget :: GLenum -> CubeMapTarget +unmarshalCubeMapTarget x + | x == gl_TEXTURE_CUBE_MAP_POSITIVE_X = TextureCubeMapPositiveX + | x == gl_TEXTURE_CUBE_MAP_NEGATIVE_X = TextureCubeMapNegativeX + | x == gl_TEXTURE_CUBE_MAP_POSITIVE_Y = TextureCubeMapPositiveY + | x == gl_TEXTURE_CUBE_MAP_NEGATIVE_Y = TextureCubeMapNegativeY + | x == gl_TEXTURE_CUBE_MAP_POSITIVE_Z = TextureCubeMapPositiveZ + | x == gl_TEXTURE_CUBE_MAP_NEGATIVE_Z = TextureCubeMapNegativeZ + | otherwise = error $ "unmarshalCubeMapTarget: unknown enum " ++ show x + diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs b/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs --- a/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs +++ b/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs @@ -4,7 +4,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -17,6 +17,8 @@ TextureUnit(..), marshalTextureUnit, unmarshalTextureUnit ) where +import Foreign.Ptr +import Foreign.Storable import Graphics.Rendering.OpenGL.Raw.Core31 -------------------------------------------------------------------------------- @@ -26,6 +28,17 @@ newtype TextureUnit = TextureUnit GLuint deriving ( Eq, Ord, Show ) + +instance Storable TextureUnit where + sizeOf _ = sizeOf (undefined :: GLuint) + alignment _ = alignment (undefined :: GLuint) + peek pt = peek (castPtr pt) >>= return . TextureUnit + poke pt (TextureUnit tu) = poke (castPtr pt) tu + peekByteOff pt off = peekByteOff pt off >>= return . TextureUnit + pokeByteOff pt off (TextureUnit tu) + = pokeByteOff pt off tu + + marshalTextureUnit :: TextureUnit -> GLenum marshalTextureUnit (TextureUnit x) = gl_TEXTURE0 + fromIntegral x diff --git a/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs b/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs @@ -0,0 +1,140 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.TransformFeedback +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.TransformFeedback ( + -- * starting and ending + beginTransformFeedback, endTransformFeedback, + + -- * TransformFeedbackBufferMode + TransformFeedbackBufferMode(..), marshalTransformFeedbackBufferMode, + unmarshalTransformFeedbackBufferMode, + + -- * Shader related + transformFeedbackBufferMode, getTransformFeedbackVaryings, + setTransformFeedbackVaryings, getTransformFeedbackVarying, + getTransformFeedbackVaryingMaxLength, + + -- * limits + maxTransformFeedbackSeparateAttribs, + maxTransformFeedbackInterleavedComponents, + maxTransformFeedbackSeparateComponents +) where + +import Data.StateVar +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Storable + +import Graphics.Rendering.OpenGL.Raw.Core32 +import Graphics.Rendering.OpenGL.GL.DataType +import Graphics.Rendering.OpenGL.GL.GLstring +import Graphics.Rendering.OpenGL.GL.PrimitiveMode +import Graphics.Rendering.OpenGL.GL.QueryUtils +import Graphics.Rendering.OpenGL.GL.Shaders.Program + +beginTransformFeedback :: PrimitiveMode -> IO () +beginTransformFeedback = glBeginTransformFeedback . marshalPrimitiveMode + +endTransformFeedback :: IO () +endTransformFeedback = glEndTransformFeedback + + +--TranformFeedbackBuffer mode +data TransformFeedbackBufferMode = InterleavedAttribs | SeperateAttribs + +marshalTransformFeedbackBufferMode :: TransformFeedbackBufferMode -> GLenum +marshalTransformFeedbackBufferMode x = case x of + InterleavedAttribs -> gl_INTERLEAVED_ATTRIBS + SeperateAttribs -> gl_SEPARATE_ATTRIBS + +unmarshalTransformFeedbackBufferMode :: GLenum -> TransformFeedbackBufferMode +unmarshalTransformFeedbackBufferMode x + | x == gl_INTERLEAVED_ATTRIBS = InterleavedAttribs + | x == gl_SEPARATE_ATTRIBS = SeperateAttribs + | otherwise = error $ "unmarshalTransformFeedbackBufferMode: illegal value " ++ show x + +-- limits +-- | Max number of seprate atributes or varyings than can be captured +-- in transformfeedback, initial value 4 +maxTransformFeedbackSeparateAttribs :: GettableStateVar GLint +maxTransformFeedbackSeparateAttribs = makeGettableStateVar $ + getInteger1 fromIntegral GetMaxTransformFeedbackSeparateAttribs + +-- | Max number of components to write to a single buffer in +-- interleaved mod, initial value 64 +maxTransformFeedbackInterleavedComponents :: GettableStateVar GLint +maxTransformFeedbackInterleavedComponents = makeGettableStateVar $ + getInteger1 fromIntegral GetMaxTransformFeedbackInterleavedComponents + +-- | Max number of components per attribute or varying in seperate mode +-- initial value 4 +maxTransformFeedbackSeparateComponents :: GettableStateVar GLint +maxTransformFeedbackSeparateComponents = makeGettableStateVar $ + getInteger1 fromIntegral GetMaxTransformFeedbackSeparateComponents + +----------------------------------------------------------------------------- + +type VaryingIndex = GLuint +type MaxLength = GLsizei + +-------------------------------------------------------------------------------- + +-- | Set all the transform feedbacks varyings for this program +-- it overwrites any previous call to this function +setTransformFeedbackVaryings :: Program -> [String] + -> TransformFeedbackBufferMode -> IO () +setTransformFeedbackVaryings (Program program) sts tfbm = do + ptSts <- mapM (\x -> withGLString x return) sts + stsPtrs <- newArray ptSts + glTransformFeedbackVaryings program (fromIntegral . length $ sts) stsPtrs + (marshalTransformFeedbackBufferMode tfbm) + +-- | Get the currently used transformFeedbackBufferMode +transformFeedbackBufferMode + :: Program -> GettableStateVar TransformFeedbackBufferMode +transformFeedbackBufferMode = programVar + (unmarshalTransformFeedbackBufferMode . fromIntegral) + TransformFeedbackBufferMode + +-- | The number of varyings that are currently recorded when in +-- transform feedback mode +getTransformFeedbackVaryings :: Program -> GettableStateVar GLuint +getTransformFeedbackVaryings + = programVar fromIntegral TransformFeedbackVaryings + +-- | The maximum length of a varying's name for transform feedback mode +getTransformFeedbackVaryingMaxLength :: Program -> GettableStateVar GLuint +getTransformFeedbackVaryingMaxLength + = programVar fromIntegral TransformFeedbackVaryingMaxLength + +-- | Get the name, datatype and size of a single transform feedback +-- varying. +getTransformFeedbackVarying :: Program + -> VaryingIndex -- ^ the index in a previous array of names of + -- setTransformFeedbackVaryings + -> MaxLength -- ^ the maximum length of the returned string + -> IO (String, DataType, GLsizei) -- ^ The name of the varying, it's type + -- and size +getTransformFeedbackVarying (Program program) vi ml = do + alloca $ \nlength -> do + alloca $ \size -> do + alloca $ \dtype -> do + allocaArray (fromIntegral ml) $ \name -> do + glGetTransformFeedbackVarying program vi ml nlength size + dtype name + l <- peek nlength + s <- peek size + d <- peek dtype + n <- peekGLstringLen (name, l) + return (n,unmarshalDataType d, s) diff --git a/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs b/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs @@ -0,0 +1,54 @@ +----------------------------------------------------------------------------- +-- +-- Module : Graphics.Rendering.OpenGL.GL.VertexArrayObjects +-- Copyright : +-- License : BSD3 +-- +-- Maintainer : Sven Panne +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.OpenGL.GL.VertexArrayObjects ( + VertexArrayObject, + bindVertexArrayObject +) where + +import Data.ObjectName +import Data.StateVar +import Foreign.Marshal.Array + +import Graphics.Rendering.OpenGL.GL.GLboolean +import Graphics.Rendering.OpenGL.GL.QueryUtils +import Graphics.Rendering.OpenGL.Raw.Core31 + +----------------------------------------------------------------------------- + +newtype VertexArrayObject = VertexArrayObject { vertexArrayID :: GLuint } + deriving( Eq, Ord, Show ) + +instance ObjectName VertexArrayObject where + genObjectNames n = allocaArray n $ \buf -> do + glGenVertexArrays (fromIntegral n) buf + fmap (map VertexArrayObject) $ peekArray n buf + deleteObjectNames bufferObjects = + withArrayLen (map vertexArrayID bufferObjects) $ + glDeleteBuffers . fromIntegral + isObjectName = fmap unmarshalGLboolean . glIsVertexArray . vertexArrayID + +bindVertexArrayObject :: StateVar (Maybe VertexArrayObject) +bindVertexArrayObject = makeStateVar getVAO bindVAO + +getVAO :: IO (Maybe VertexArrayObject) +getVAO = do + vao <- getInteger1 (VertexArrayObject . fromIntegral) GetVertexArrayBinding + return $ if vao == noVAO then Nothing else Just vao + +bindVAO :: Maybe VertexArrayObject -> IO () +bindVAO = glBindVertexArray . vertexArrayID . maybe noVAO id + +noVAO :: VertexArrayObject +noVAO = VertexArrayObject 0 diff --git a/Graphics/Rendering/OpenGL/GL/VertexArrays.hs b/Graphics/Rendering/OpenGL/GL/VertexArrays.hs --- a/Graphics/Rendering/OpenGL/GL/VertexArrays.hs +++ b/Graphics/Rendering/OpenGL/GL/VertexArrays.hs @@ -3,7 +3,7 @@ -- Module : Graphics.Rendering.OpenGL.GL.VertexArrays -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -32,7 +32,7 @@ primitiveRestartIndex, primitiveRestartIndexNV, -- * Generic Vertex Attribute Arrays - vertexAttribPointer, vertexAttribArray + vertexAttribPointer, vertexAttribArray, ) where import Data.StateVar diff --git a/Graphics/Rendering/OpenGL/GL/VertexSpec.hs b/Graphics/Rendering/OpenGL/GL/VertexSpec.hs --- a/Graphics/Rendering/OpenGL/GL/VertexSpec.hs +++ b/Graphics/Rendering/OpenGL/GL/VertexSpec.hs @@ -13,6 +13,8 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE TypeSynonymInstances #-} + module Graphics.Rendering.OpenGL.GL.VertexSpec ( -- * Vertex Coordinates Vertex(..), @@ -539,16 +541,6 @@ secondaryColor3 = glSecondaryColor3f secondaryColor3v = glSecondaryColor3fv -instance ColorComponent GLclampf where - color3 r g b = glColor3f (realToFrac r) (realToFrac g) (realToFrac b) - color4 r g b a = glColor4f (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a) - - color3v = glColor3fv . castPtr - color4v = glColor4fv . castPtr - - secondaryColor3 r g b = glSecondaryColor3f (realToFrac r) (realToFrac g) (realToFrac b) - secondaryColor3v = glSecondaryColor3fv . castPtr - instance ColorComponent GLdouble where color3 = glColor3d color4 = glColor4d @@ -559,16 +551,6 @@ secondaryColor3 = glSecondaryColor3d secondaryColor3v = glSecondaryColor3dv -instance ColorComponent GLclampd where - color3 r g b = glColor3d (realToFrac r) (realToFrac g) (realToFrac b) - color4 r g b a = glColor4d (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a) - - color3v = glColor3dv . castPtr - color4v = glColor4dv . castPtr - - secondaryColor3 r g b = glSecondaryColor3d (realToFrac r) (realToFrac g) (realToFrac b) - secondaryColor3v = glSecondaryColor3dv . castPtr - instance ColorComponent GLubyte where color3 = glColor3ub color4 = glColor4ub @@ -851,21 +833,6 @@ vertexAttrib4Iv = vertexAttrib4IvRealFrac -instance VertexAttribComponent GLclampf where - vertexAttrib1 (AttribLocation al) x = glVertexAttrib1f al (realToFrac x) - vertexAttrib2 (AttribLocation al) x y = glVertexAttrib2f al (realToFrac x) (realToFrac y) - vertexAttrib3 (AttribLocation al) x y z = glVertexAttrib3f al (realToFrac x) (realToFrac y) (realToFrac z) - vertexAttrib4 (AttribLocation al) x y z w = glVertexAttrib4f al (realToFrac x) (realToFrac y) (realToFrac z) (realToFrac w) - - vertexAttrib1v (AttribLocation al) = glVertexAttrib1fv al . castPtr - vertexAttrib2v (AttribLocation al) = glVertexAttrib2fv al . castPtr - vertexAttrib3v (AttribLocation al) = glVertexAttrib3fv al . castPtr - vertexAttrib4v (AttribLocation al) = glVertexAttrib4fv al . castPtr - - vertexAttrib4Nv = vertexAttrib4v - - vertexAttrib4Iv = vertexAttrib4IvRealFrac - vertexAttrib4IvRealFrac :: (Storable a, RealFrac a) => AttribLocation -> Ptr a -> IO () vertexAttrib4IvRealFrac location = peek4M $ \x y z w -> vertexAttrib4I location (toGLint x) (toGLint y) (toGLint z) (toGLint w) @@ -885,21 +852,6 @@ vertexAttrib2v (AttribLocation al) = glVertexAttrib2dv al vertexAttrib3v (AttribLocation al) = glVertexAttrib3dv al vertexAttrib4v (AttribLocation al) = glVertexAttrib4dv al - - vertexAttrib4Nv = vertexAttrib4v - - vertexAttrib4Iv = vertexAttrib4IvRealFrac - -instance VertexAttribComponent GLclampd where - vertexAttrib1 (AttribLocation al) x = glVertexAttrib1d al (realToFrac x) - vertexAttrib2 (AttribLocation al) x y = glVertexAttrib2d al (realToFrac x) (realToFrac y) - vertexAttrib3 (AttribLocation al) x y z = glVertexAttrib3d al (realToFrac x) (realToFrac y) (realToFrac z) - vertexAttrib4 (AttribLocation al) x y z w = glVertexAttrib4d al (realToFrac x) (realToFrac y) (realToFrac z) (realToFrac w) - - vertexAttrib1v (AttribLocation al) = glVertexAttrib1dv al . castPtr - vertexAttrib2v (AttribLocation al) = glVertexAttrib2dv al . castPtr - vertexAttrib3v (AttribLocation al) = glVertexAttrib3dv al . castPtr - vertexAttrib4v (AttribLocation al) = glVertexAttrib4dv al . castPtr vertexAttrib4Nv = vertexAttrib4v diff --git a/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs b/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs --- a/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs +++ b/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs @@ -6,7 +6,7 @@ -- Module : Graphics.Rendering.OpenGL.GLU.ErrorsInternal -- Copyright : (c) Sven Panne 2002-2009 -- License : BSD-style (see the file libraries/OpenGL/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : stable -- Portability : portable @@ -59,7 +59,7 @@ | isInvalidEnum c = InvalidEnum | isInvalidValue c = InvalidValue | isInvalidOperation c = InvalidOperation - | isInvalidFramebufferOperation c = InvalidFramebufferOperation + | isInvalidFramebufferOperation c = InvalidFramebufferOperation | isOutOfMemory c = OutOfMemory | isStackOverflow c = StackOverflow | isStackUnderflow c = StackUnderflow diff --git a/Graphics/Rendering/OpenGL/GLU/Tessellation.hs b/Graphics/Rendering/OpenGL/GLU/Tessellation.hs --- a/Graphics/Rendering/OpenGL/GLU/Tessellation.hs +++ b/Graphics/Rendering/OpenGL/GLU/Tessellation.hs @@ -35,9 +35,9 @@ Primitive(..), SimplePolygon(..), tessellate ) where -import Control.Monad ( foldM, unless ) +import Control.Monad ( foldM_, unless ) import Data.IORef ( newIORef, readIORef, writeIORef, modifyIORef ) -import Data.Maybe ( fromJust ) +import Data.Maybe ( fromJust, fromMaybe ) import Data.Tensor import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.Marshal.Array ( peekArray, pokeArray ) @@ -145,7 +145,7 @@ pokeComplexPolygon :: Storable v => Ptr (ComplexPolygon v) -> ComplexPolygon v -> IO () pokeComplexPolygon ptr (ComplexPolygon complexContours) = - foldM pokeAndAdvance (castPtr ptr) complexContours >> return () + foldM_ pokeAndAdvance (castPtr ptr) complexContours >> return () where pokeAndAdvance p complexContour = do pokeComplexContour p complexContour return $ p `plusPtr` sizeOfComplexContour complexContour @@ -468,7 +468,7 @@ bracket (makeTessCombineCallback (combineProperties vertexPool combiner)) freeHaskellFunPtr $ \callbackPtr -> do gluTessCallback tessObj glu_TESS_COMBINE callbackPtr - action + action -- NOTE: SGI's tesselator has a bug, sometimes passing NULL for the last two -- vertices instead of valid vertex data, so we have to work around this. We @@ -480,7 +480,7 @@ [v0, v1, v2, v3] <- mapM (getProperty propertyPtrs) [0..3] [w0, w1, w2, w3] <- peekArray 4 weights let defaultProperty = fromJust v0 - f = maybe defaultProperty id + f = fromMaybe defaultProperty wp = WeightedProperties (w0, f v0) (w1, f v1) (w2, f v2) (w3, f v3) av = AnnotatedVertex newVertex (combiner newVertex wp) poke result =<< pooledNew pool av diff --git a/OpenGL.cabal b/OpenGL.cabal --- a/OpenGL.cabal +++ b/OpenGL.cabal @@ -1,5 +1,5 @@ name: OpenGL -version: 2.5.0.0 +version: 2.6.0.0 license: BSD3 license-file: LICENSE maintainer: Jason Dagit , Sven Panne @@ -35,10 +35,12 @@ Graphics.Rendering.OpenGL.GL.FlushFinish, Graphics.Rendering.OpenGL.GL.Fog, Graphics.Rendering.OpenGL.GL.Framebuffer, + Graphics.Rendering.OpenGL.GL.FramebufferObjects Graphics.Rendering.OpenGL.GL.Hints, Graphics.Rendering.OpenGL.GL, Graphics.Rendering.OpenGL.GL.LineSegments, Graphics.Rendering.OpenGL.GL.PerFragment, + Graphics.Rendering.OpenGL.GL.PixellikeObject, Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable, Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution, Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram, @@ -50,6 +52,7 @@ Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization, Graphics.Rendering.OpenGL.GL.Points, Graphics.Rendering.OpenGL.GL.Polygons, + Graphics.Rendering.OpenGL.GL.QueryObjects, Graphics.Rendering.OpenGL.GL.RasterPos, Graphics.Rendering.OpenGL.GL.ReadCopyPixels, Graphics.Rendering.OpenGL.GL.Rectangles, @@ -64,6 +67,7 @@ Graphics.Rendering.OpenGL.GL.Texturing.Parameters, Graphics.Rendering.OpenGL.GL.Texturing.Queries, Graphics.Rendering.OpenGL.GL.Texturing.Specification, + Graphics.Rendering.OpenGL.GL.TransformFeedback Graphics.Rendering.OpenGL.GLU.Errors, Graphics.Rendering.OpenGL.GLU, Graphics.Rendering.OpenGL.GLU.Initialization, @@ -73,6 +77,7 @@ Graphics.Rendering.OpenGL.GLU.Quadrics, Graphics.Rendering.OpenGL.GLU.Tessellation, Graphics.Rendering.OpenGL.GL.VertexArrays, + Graphics.Rendering.OpenGL.GL.VertexArrayObjects, Graphics.Rendering.OpenGL.GL.VertexSpec, Graphics.Rendering.OpenGL other-modules: @@ -86,7 +91,12 @@ Graphics.Rendering.OpenGL.GL.EdgeFlag, Graphics.Rendering.OpenGL.GL.Exception, Graphics.Rendering.OpenGL.GL.Face, + Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments, + Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects, + Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries, + Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects, Graphics.Rendering.OpenGL.GL.GLboolean, + Graphics.Rendering.OpenGL.GL.GLstring, Graphics.Rendering.OpenGL.GL.IOState, Graphics.Rendering.OpenGL.GL.PeekPoke, Graphics.Rendering.OpenGL.GL.PixelData, @@ -97,7 +107,15 @@ Graphics.Rendering.OpenGL.GL.PolygonMode, Graphics.Rendering.OpenGL.GL.PrimitiveMode, Graphics.Rendering.OpenGL.GL.QueryUtils, + Graphics.Rendering.OpenGL.GL.QueryUtils.PName, + Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib, Graphics.Rendering.OpenGL.GL.RenderMode, + Graphics.Rendering.OpenGL.GL.Shaders.Attribs, + Graphics.Rendering.OpenGL.GL.Shaders.Limits, + Graphics.Rendering.OpenGL.GL.Shaders.Program, + Graphics.Rendering.OpenGL.GL.Shaders.Shaders, + Graphics.Rendering.OpenGL.GL.Shaders.Uniform, + Graphics.Rendering.OpenGL.GL.Shaders.Variables, Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat, Graphics.Rendering.OpenGL.GL.Texturing.TexParameter, Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget, @@ -106,7 +124,7 @@ Graphics.Rendering.OpenGL.GLU.ErrorsInternal ghc-options: -Wall build-depends: - base >= 3 && < 5, OpenGLRaw >= 1.1.0.0, GLURaw >= 1.1.0.0, StateVar == 1.0.*, ObjectName == 1.0.*, Tensor == 1.0.* + base >= 3 && < 5, OpenGLRaw >= 1.3.0.0, GLURaw >= 1.1.0.0, StateVar == 1.0.*, ObjectName == 1.0.*, Tensor == 1.0.* source-repository head type: git