    --------------------------------------------------------------------------------
    -- |
    -- 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,

       -- * Blending
       blend, blendBuffer, BlendEquation(..), blendEquation, blendEquationSeparate,
       BlendingFactor(..), blendFuncSeparate, blendFunc, blendColor,

       -- * Dithering
       dither,

       -- * Logical Operation
       LogicOp(..), logicOp,

       -- * for backward compatibility reasons
       module Graphics.Rendering.OpenGL.GL.QueryObjects
    ) where

    import Control.Monad
    import Graphics.Rendering.OpenGL.GL.StateVar
    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.Face
    import Graphics.Rendering.OpenGL.GL.Framebuffer
    import Graphics.Rendering.OpenGL.GL.GLboolean
    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 (
       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)

    --------------------------------------------------------------------------------

    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

    --------------------------------------------------------------------------------

    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)