-------------------------------------------------------------------------------- -- | -- 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 -- -- This module corresponds to section 4.1 (Per-Fragment Operations) of the -- OpenGL 2.1 specs. -- -------------------------------------------------------------------------------- module Graphics.Rendering.OpenGL.GL.PerFragment ( -- * Scissor Test scissor, -- * Multisample Fragment Operations sampleAlphaToCoverage, sampleAlphaToOne, sampleCoverage, -- * Depth Bounds Test depthBounds, -- * Alpha Test ComparisonFunction(..), alphaFunc, -- * Stencil Test stencilTest, stencilFunc, stencilFuncSeparate, StencilOp(..), stencilOp, stencilOpSeparate, activeStencilFace, -- * Depth Buffer Test depthFunc, -- * Occlusion Queries QueryObject(QueryObject), QueryTarget(..), withQuery, beginQuery, endQuery, queryCounterBits, currentQuery, queryResult, queryResultAvailable, -- * Blending blend, BlendEquation(..), blendEquation, blendEquationSeparate, BlendingFactor(..), blendFuncSeparate, blendFunc, blendColor, -- * Dithering dither, -- * Logical Operation LogicOp(..), logicOp ) 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.GLboolean import Graphics.Rendering.OpenGL.GL.PeekPoke import Graphics.Rendering.OpenGL.GL.QueryUtils import Graphics.Rendering.OpenGL.GL.VertexSpec import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glAlphaFunc, gl_INDEX_LOGIC_OP ) import Graphics.Rendering.OpenGL.Raw.Core31 import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( glDepthBounds ) import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( glActiveStencilFace ) -------------------------------------------------------------------------------- scissor :: StateVar (Maybe (Position, Size)) scissor = makeStateVarMaybe (return CapScissorTest) (getInteger4 makeSB GetScissorBox) (\(Position x y, Size w h) -> glScissor x y w h) where makeSB x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h)) -------------------------------------------------------------------------------- sampleAlphaToCoverage :: StateVar Capability sampleAlphaToCoverage = makeCapability CapSampleAlphaToCoverage sampleAlphaToOne :: StateVar Capability sampleAlphaToOne = makeCapability CapSampleAlphaToOne sampleCoverage :: StateVar (Maybe (GLclampf, Bool)) sampleCoverage = makeStateVarMaybe (return CapSampleCoverage) (liftM2 (,) (getClampf1 id GetSampleCoverageValue) (getBoolean1 unmarshalGLboolean GetSampleCoverageInvert)) (\(value, invert) -> glSampleCoverage value (marshalGLboolean invert)) -------------------------------------------------------------------------------- depthBounds :: StateVar (Maybe (GLclampd, GLclampd)) depthBounds = makeStateVarMaybe (return CapDepthBoundsTest) (getClampd2 (,) GetDepthBounds) (uncurry glDepthBounds) -------------------------------------------------------------------------------- alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf)) alphaFunc = makeStateVarMaybe (return CapAlphaTest) (liftM2 (,) (getEnum1 unmarshalComparisonFunction GetAlphaTestFunc) (getClampf1 id GetAlphaTestRef)) (uncurry (glAlphaFunc . marshalComparisonFunction)) -------------------------------------------------------------------------------- stencilTest :: StateVar Capability stencilTest = makeCapability CapStencilTest -------------------------------------------------------------------------------- stencilFunc :: StateVar (ComparisonFunction, GLint, GLuint) stencilFunc = makeStateVar (liftM3 (,,) (getEnum1 unmarshalComparisonFunction GetStencilFunc) (getInteger1 id GetStencilRef) (getInteger1 fromIntegral GetStencilValueMask)) (\(func, ref, mask) -> glStencilFunc (marshalComparisonFunction func) ref mask) stencilFuncSeparate :: Face -> SettableStateVar (ComparisonFunction, GLint, GLuint) stencilFuncSeparate face = makeSettableStateVar $ \(func, ref, mask) -> glStencilFuncSeparate (marshalFace face) (marshalComparisonFunction func) ref mask -------------------------------------------------------------------------------- data StencilOp = OpZero | OpKeep | OpReplace | OpIncr | OpIncrWrap | OpDecr | OpDecrWrap | OpInvert deriving ( Eq, Ord, Show ) marshalStencilOp :: StencilOp -> GLenum marshalStencilOp x = case x of OpZero -> gl_ZERO OpKeep -> gl_KEEP OpReplace -> gl_REPLACE OpIncr -> gl_INCR OpIncrWrap -> gl_INCR_WRAP OpDecr -> gl_DECR OpDecrWrap -> gl_DECR_WRAP OpInvert -> gl_INVERT unmarshalStencilOp :: GLenum -> StencilOp unmarshalStencilOp x | x == gl_ZERO = OpZero | x == gl_KEEP = OpKeep | x == gl_REPLACE = OpReplace | x == gl_INCR = OpIncr | x == gl_INCR_WRAP = OpIncrWrap | x == gl_DECR = OpDecr | x == gl_DECR_WRAP = OpDecrWrap | x == gl_INVERT = OpInvert | otherwise = error ("unmarshalStencilOp: illegal value " ++ show x) -------------------------------------------------------------------------------- stencilOp :: StateVar (StencilOp, StencilOp, StencilOp) stencilOp = makeStateVar (liftM3 (,,) (getEnum1 unmarshalStencilOp GetStencilFail) (getEnum1 unmarshalStencilOp GetStencilPassDepthFail) (getEnum1 unmarshalStencilOp GetStencilPassDepthPass)) (\(sf, spdf, spdp) -> glStencilOp (marshalStencilOp sf) (marshalStencilOp spdf) (marshalStencilOp spdp)) stencilOpSeparate :: Face -> SettableStateVar (StencilOp, StencilOp, StencilOp) stencilOpSeparate face = makeSettableStateVar $ \(sf, spdf, spdp) -> glStencilOpSeparate (marshalFace face) (marshalStencilOp sf) (marshalStencilOp spdf) (marshalStencilOp spdp) -------------------------------------------------------------------------------- activeStencilFace :: StateVar (Maybe Face) activeStencilFace = makeStateVarMaybe (return CapStencilTestTwoSide) (getEnum1 unmarshalFace GetActiveStencilFace) (glActiveStencilFace . marshalFace) -------------------------------------------------------------------------------- depthFunc :: StateVar (Maybe ComparisonFunction) depthFunc = makeStateVarMaybe (return CapDepthTest) (getEnum1 unmarshalComparisonFunction GetDepthFunc) (glDepthFunc . marshalComparisonFunction) -------------------------------------------------------------------------------- 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 -------------------------------------------------------------------------------- data BlendEquation = FuncAdd | FuncSubtract | FuncReverseSubtract | Min | Max | LogicOp deriving ( Eq, Ord, Show ) marshalBlendEquation :: BlendEquation -> GLenum marshalBlendEquation x = case x of FuncAdd -> gl_FUNC_ADD FuncSubtract -> gl_FUNC_SUBTRACT FuncReverseSubtract -> gl_FUNC_REVERSE_SUBTRACT Min -> gl_MIN Max -> gl_MAX LogicOp -> gl_INDEX_LOGIC_OP unmarshalBlendEquation :: GLenum -> BlendEquation unmarshalBlendEquation x | x == gl_FUNC_ADD = FuncAdd | x == gl_FUNC_SUBTRACT = FuncSubtract | x == gl_FUNC_REVERSE_SUBTRACT = FuncReverseSubtract | x == gl_MIN = Min | x == gl_MAX = Max | x == gl_INDEX_LOGIC_OP = LogicOp | otherwise = error ("unmarshalBlendEquation: illegal value " ++ show x) -------------------------------------------------------------------------------- blendEquation :: StateVar BlendEquation blendEquation = makeStateVar (getEnum1 unmarshalBlendEquation GetBlendEquation) (glBlendEquation . marshalBlendEquation) blendEquationSeparate :: StateVar (BlendEquation,BlendEquation) blendEquationSeparate = makeStateVar (liftM2 (,) (getEnum1 unmarshalBlendEquation GetBlendEquation) (getEnum1 unmarshalBlendEquation GetBlendEquationAlpha)) (\(funcRGB, funcAlpha) -> glBlendEquationSeparate (marshalBlendEquation funcRGB) (marshalBlendEquation funcAlpha)) -------------------------------------------------------------------------------- blendFuncSeparate :: StateVar ((BlendingFactor, BlendingFactor), (BlendingFactor, BlendingFactor)) blendFuncSeparate = makeStateVar (do srcRGB <- getEnum1 unmarshalBlendingFactor GetBlendSrcRGB srcAlpha <- getEnum1 unmarshalBlendingFactor GetBlendSrcAlpha dstRGB <- getEnum1 unmarshalBlendingFactor GetBlendDstRGB dstAlpha <- getEnum1 unmarshalBlendingFactor GetBlendDstAlpha return ((srcRGB, srcAlpha), (dstRGB, dstAlpha))) (\((srcRGB, srcAlpha), (dstRGB, dstAlpha)) -> glBlendFuncSeparate (marshalBlendingFactor srcRGB) (marshalBlendingFactor srcAlpha) (marshalBlendingFactor dstRGB) (marshalBlendingFactor dstAlpha)) blendFunc :: StateVar (BlendingFactor, BlendingFactor) blendFunc = makeStateVar (liftM2 (,) (getEnum1 unmarshalBlendingFactor GetBlendSrc) (getEnum1 unmarshalBlendingFactor GetBlendDst)) (\(s, d) -> glBlendFunc (marshalBlendingFactor s) (marshalBlendingFactor d)) blendColor :: StateVar (Color4 GLclampf) blendColor = makeStateVar (getClampf4 Color4 GetBlendColor) (\(Color4 r g b a) -> glBlendColor r g b a) -------------------------------------------------------------------------------- dither :: StateVar Capability dither = makeCapability CapDither -------------------------------------------------------------------------------- data LogicOp = Clear | And | AndReverse | Copy | AndInverted | Noop | Xor | Or | Nor | Equiv | Invert | OrReverse | CopyInverted | OrInverted | Nand | Set deriving ( Eq, Ord, Show ) marshalLogicOp :: LogicOp -> GLenum marshalLogicOp x = case x of Clear -> gl_CLEAR And -> gl_AND AndReverse -> gl_AND_REVERSE Copy -> gl_COPY AndInverted -> gl_AND_INVERTED Noop -> gl_NOOP Xor -> gl_XOR Or -> gl_OR Nor -> gl_NOR Equiv -> gl_EQUIV Invert -> gl_INVERT OrReverse -> gl_OR_REVERSE CopyInverted -> gl_COPY_INVERTED OrInverted -> gl_OR_INVERTED Nand -> gl_NAND Set -> gl_SET unmarshalLogicOp :: GLenum -> LogicOp unmarshalLogicOp x | x == gl_CLEAR = Clear | x == gl_AND = And | x == gl_AND_REVERSE = AndReverse | x == gl_COPY = Copy | x == gl_AND_INVERTED = AndInverted | x == gl_NOOP = Noop | x == gl_XOR = Xor | x == gl_OR = Or | x == gl_NOR = Nor | x == gl_EQUIV = Equiv | x == gl_INVERT = Invert | x == gl_OR_REVERSE = OrReverse | x == gl_COPY_INVERTED = CopyInverted | x == gl_OR_INVERTED = OrInverted | x == gl_NAND = Nand | x == gl_SET = Set | otherwise = error ("unmarshalLogicOp: illegal value " ++ show x) -------------------------------------------------------------------------------- logicOp :: StateVar (Maybe LogicOp) logicOp = makeStateVarMaybe (do rgba <- get rgbaMode return $ if rgba then CapColorLogicOp else CapIndexLogicOp) (getEnum1 unmarshalLogicOp GetLogicOpMode) (glLogicOp . marshalLogicOp)