module Graphics.Rendering.OpenGL.GL.PerFragment (
scissor,
sampleAlphaToCoverage, sampleAlphaToOne, sampleCoverage,
depthBounds,
ComparisonFunction(..), alphaFunc,
stencilTest, stencilFunc, stencilFuncSeparate, StencilOp(..), stencilOp,
stencilOpSeparate, activeStencilFace,
depthFunc,
QueryObject(QueryObject), QueryTarget(..), withQuery,
beginQuery, endQuery,
queryCounterBits, currentQuery,
queryResult, queryResultAvailable,
blend, BlendEquation(..), blendEquation, blendEquationSeparate,
BlendingFactor(..), blendFuncSeparate, blendFunc, blendColor,
dither,
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
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)