    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.PerFragment
    -- Copyright   :  (c) Sven Panne 2002-2006
    -- 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,
       queryCounterBits, currentQuery,
       queryResult, queryResultAvailable,

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

       -- * Dithering
       dither,

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

    import Control.Monad ( liftM2, liftM3 )
    import Foreign.Marshal.Alloc ( alloca )
    import Foreign.Marshal.Array ( withArrayLen, peekArray, allocaArray )
    import Foreign.Ptr ( Ptr )
    import Graphics.Rendering.OpenGL.GL.BufferObjects ( ObjectName(..) )
    import Graphics.Rendering.OpenGL.GL.Capability (
       EnableCap(CapScissorTest,CapSampleAlphaToCoverage,CapSampleAlphaToOne,
                 CapSampleCoverage,CapDepthBoundsTest,CapAlphaTest,CapStencilTest,
                 CapStencilTestTwoSide,CapDepthTest,CapBlend,CapDither,
                 CapIndexLogicOp,CapColorLogicOp),
       makeCapability, makeStateVarMaybe )
    import Graphics.Rendering.OpenGL.GL.BasicTypes (
       GLboolean, GLint, GLuint, GLsizei, GLenum, GLclampf, GLclampd, Capability )
    import Graphics.Rendering.OpenGL.GL.BlendingFactor (
       BlendingFactor(..), marshalBlendingFactor, unmarshalBlendingFactor )
    import Graphics.Rendering.OpenGL.GL.ComparisonFunction ( ComparisonFunction(..),
       marshalComparisonFunction, unmarshalComparisonFunction )
    import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) )
    import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )
    import Graphics.Rendering.OpenGL.GL.Extensions (
       FunPtr, unsafePerformIO, Invoker, getProcAddress )
    import Graphics.Rendering.OpenGL.GL.Face ( marshalFace, unmarshalFace )
    import Graphics.Rendering.OpenGL.GL.Colors ( Face )
    import Graphics.Rendering.OpenGL.GL.GLboolean (
       marshalGLboolean, unmarshalGLboolean )
    import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )
    import Graphics.Rendering.OpenGL.GL.QueryUtils (
       GetPName(GetScissorBox,GetSampleCoverageValue,GetSampleCoverageInvert,
                GetDepthBounds,GetAlphaTestFunc,GetAlphaTestRef,GetStencilFunc,
                GetStencilRef,GetStencilValueMask,GetStencilFail,
                GetStencilPassDepthFail,GetStencilPassDepthPass,
                GetActiveStencilFace,GetDepthFunc,GetBlendEquation,
                GetBlendEquationAlpha,GetBlendDstRGB,GetBlendSrcRGB,
                GetBlendDstAlpha,GetBlendSrcAlpha,GetBlendSrc,GetBlendDst,
                GetBlendColor,GetLogicOpMode),
       getInteger1, getInteger4, getEnum1, getFloat1, getFloat4, getDouble2,
       getBoolean1 )
    import Graphics.Rendering.OpenGL.GL.StateVar (
       HasGetter(get), GettableStateVar, makeGettableStateVar,
       SettableStateVar, makeSettableStateVar,
       StateVar, makeStateVar )
    import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..), rgbaMode )

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

    #include "HsOpenGLExt.h"

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

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

    foreign import CALLCONV unsafe "glScissor" glScissor ::
       GLint -> GLint -> GLsizei -> GLsizei -> IO ()

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

    sampleAlphaToCoverage :: StateVar Capability
    sampleAlphaToCoverage = makeCapability CapSampleAlphaToCoverage

    sampleAlphaToOne :: StateVar Capability
    sampleAlphaToOne = makeCapability CapSampleAlphaToOne

    sampleCoverage :: StateVar (Maybe (GLclampf, Bool))
    sampleCoverage =
       makeStateVarMaybe
          (return CapSampleCoverage)
          (liftM2 (,) (getFloat1 id GetSampleCoverageValue)
                      (getBoolean1 unmarshalGLboolean GetSampleCoverageInvert))
          (\(value, invert) -> glSampleCoverageARB value (marshalGLboolean invert))

    EXTENSION_ENTRY("GL_ARB_multisample or OpenGL 1.3",glSampleCoverageARB,GLclampf -> GLboolean -> IO ())

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

    depthBounds :: StateVar (Maybe (GLclampd, GLclampd))
    depthBounds =
       makeStateVarMaybe
          (return CapDepthBoundsTest)
          (getDouble2 (,) GetDepthBounds)
          (uncurry glDepthBoundsEXT)

    EXTENSION_ENTRY("GL_EXT_depth_bounds_test",glDepthBoundsEXT,GLclampd -> GLclampd -> IO ())

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

    alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))
    alphaFunc =
       makeStateVarMaybe
          (return CapAlphaTest)
          (liftM2 (,) (getEnum1 unmarshalComparisonFunction GetAlphaTestFunc)
                      (getFloat1 id GetAlphaTestRef))
          (uncurry (glAlphaFunc . marshalComparisonFunction))

    foreign import CALLCONV unsafe "glAlphaFunc" glAlphaFunc ::
       GLenum -> GLclampf -> IO ()

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

    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)

    foreign import CALLCONV unsafe "glStencilFunc" glStencilFunc ::
       GLenum -> GLint -> GLuint -> IO ()

    stencilFuncSeparate :: Face -> SettableStateVar (ComparisonFunction, GLint, GLuint)
    stencilFuncSeparate face =
       makeSettableStateVar $ \(func, ref, mask) ->
          glStencilFuncSeparate (marshalFace face) (marshalComparisonFunction func) ref mask

    EXTENSION_ENTRY("OpenGL 2.0",glStencilFuncSeparate,GLenum -> GLenum -> GLint -> GLuint -> IO ())

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

    data StencilOp =
         OpZero
       | OpKeep
       | OpReplace
       | OpIncr
       | OpIncrWrap
       | OpDecr
       | OpDecrWrap
       | OpInvert
       deriving ( Eq, Ord, Show )

    marshalStencilOp :: StencilOp -> GLenum
    marshalStencilOp x = case x of
       OpZero -> 0x0
       OpKeep -> 0x1e00
       OpReplace -> 0x1e01
       OpIncr -> 0x1e02
       OpIncrWrap -> 0x8507
       OpDecr -> 0x1e03
       OpDecrWrap -> 0x8508
       OpInvert -> 0x150a

    unmarshalStencilOp :: GLenum -> StencilOp
    unmarshalStencilOp x
       | x == 0x0 = OpZero
       | x == 0x1e00 = OpKeep
       | x == 0x1e01 = OpReplace
       | x == 0x1e02 = OpIncr
       | x == 0x8507 = OpIncrWrap
       | x == 0x1e03 = OpDecr
       | x == 0x8508 = OpDecrWrap
       | x == 0x150a = 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))

    foreign import CALLCONV unsafe "glStencilOp" glStencilOp ::
       GLenum -> GLenum -> GLenum -> IO ()

    stencilOpSeparate :: Face -> SettableStateVar (StencilOp, StencilOp, StencilOp)
    stencilOpSeparate face =
       makeSettableStateVar $ \(sf, spdf, spdp) ->
          glStencilOpSeparate (marshalFace face)
                              (marshalStencilOp sf)
                              (marshalStencilOp spdf)
                              (marshalStencilOp spdp)

    EXTENSION_ENTRY("OpenGL 2.0",glStencilOpSeparate,GLenum -> GLenum -> GLenum -> GLenum -> IO ())

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

    activeStencilFace :: StateVar (Maybe Face)
    activeStencilFace =
       makeStateVarMaybe
          (return CapStencilTestTwoSide)
          (getEnum1 unmarshalFace GetActiveStencilFace)
          (glActiveStencilFaceEXT . marshalFace)

    EXTENSION_ENTRY("GL_EXT_stencil_two_side",glActiveStencilFaceEXT,GLenum -> IO ())

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

    depthFunc :: StateVar (Maybe ComparisonFunction)
    depthFunc =
       makeStateVarMaybe
          (return CapDepthTest)
          (getEnum1 unmarshalComparisonFunction GetDepthFunc)
          (glDepthFunc . marshalComparisonFunction)

    foreign import CALLCONV unsafe "glDepthFunc" glDepthFunc :: GLenum -> IO ()

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

    newtype QueryObject = QueryObject { queryID :: GLuint }
       deriving ( Eq, Ord, Show )

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

    instance ObjectName QueryObject where
       genObjectNames n =
          allocaArray n $ \buf -> do
            glGenQueriesARB (fromIntegral n) buf
            fmap (map QueryObject) $ peekArray n buf

       deleteObjectNames queryObjects =
          withArrayLen (map queryID queryObjects) $
             glDeleteQueriesARB . fromIntegral

       isObjectName = fmap unmarshalGLboolean . glIsQueryARB . queryID

    EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glGenQueriesARB,GLsizei -> Ptr GLuint -> IO ())

    EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glDeleteQueriesARB,GLsizei -> Ptr GLuint -> IO ())

    EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glIsQueryARB,GLuint -> IO GLboolean)

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

    data QueryTarget =
         SamplesPassed
       deriving ( Eq, Ord, Show )

    marshalQueryTarget :: QueryTarget -> GLenum
    marshalQueryTarget x = case x of
       SamplesPassed -> 0x8914

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

    beginQuery :: QueryTarget -> QueryObject -> IO ()
    beginQuery t = glBeginQueryARB (marshalQueryTarget t) . queryID

    EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glBeginQueryARB,GLenum -> GLuint -> IO ())

    endQuery :: QueryTarget -> IO ()
    endQuery = glEndQueryARB . marshalQueryTarget

    EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glEndQueryARB,GLenum -> IO ())

    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 -> 0x8864
       CurrentQuery -> 0x8865

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

    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
             glGetQueryivARB (marshalQueryTarget t) (marshalGetQueryPName p) buf
             peek1 f buf

    EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glGetQueryivARB,GLenum -> GLenum -> Ptr GLint -> IO ())

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

    data GetQueryObjectPName =
         QueryResult
       | QueryResultAvailable

    marshalGetQueryObjectPName :: GetQueryObjectPName -> GLenum
    marshalGetQueryObjectPName x = case x of
       QueryResult -> 0x8866
       QueryResultAvailable -> 0x8867

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

    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
             glGetQueryObjectuivARB (queryID q) (marshalGetQueryObjectPName p) buf
             peek1 f buf

    EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glGetQueryObjectuivARB,GLuint -> GLenum -> Ptr GLuint -> IO ())

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

    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 -> 0x8006
       FuncSubtract -> 0x800a
       FuncReverseSubtract -> 0x800b
       Min -> 0x8007
       Max -> 0x8008
       LogicOp -> 0xbf1

    unmarshalBlendEquation :: GLenum -> BlendEquation
    unmarshalBlendEquation x
       | x == 0x8006 = FuncAdd
       | x == 0x800a = FuncSubtract
       | x == 0x800b = FuncReverseSubtract
       | x == 0x8007 = Min
       | x == 0x8008 = Max
       | x == 0xbf1 = LogicOp
       | otherwise = error ("unmarshalBlendEquation: illegal value " ++ show x)

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

    blendEquation :: StateVar BlendEquation
    blendEquation =
       makeStateVar
          (getEnum1 unmarshalBlendEquation GetBlendEquation)
          (glBlendEquationEXT . marshalBlendEquation)

    EXTENSION_ENTRY("GL_EXT_blend_minmax or GL_EXT_blend_subtract or OpenGL 1.4",glBlendEquationEXT,GLenum -> IO ())

    blendEquationSeparate :: StateVar (BlendEquation,BlendEquation)
    blendEquationSeparate =
       makeStateVar
          (liftM2 (,) (getEnum1 unmarshalBlendEquation GetBlendEquation)
                      (getEnum1 unmarshalBlendEquation GetBlendEquationAlpha))
          (\(funcRGB, funcAlpha) ->
              glBlendEquationSeparate (marshalBlendEquation funcRGB)
                                      (marshalBlendEquation funcAlpha))

    EXTENSION_ENTRY("GL_EXT_blend_equation_separate or OpenGL 2.0",glBlendEquationSeparate,GLenum -> GLenum -> IO ())

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

    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)) ->
             glBlendFuncSeparateEXT (marshalBlendingFactor srcRGB)
                                    (marshalBlendingFactor srcAlpha)
                                    (marshalBlendingFactor dstRGB)
                                    (marshalBlendingFactor dstAlpha))

    EXTENSION_ENTRY("GL_EXT_blend_func_separate or OpenGL 1.4",glBlendFuncSeparateEXT,GLenum -> GLenum -> GLenum -> GLenum -> IO ())

    blendFunc :: StateVar (BlendingFactor, BlendingFactor)
    blendFunc =
       makeStateVar
          (liftM2 (,) (getEnum1 unmarshalBlendingFactor GetBlendSrc)
                      (getEnum1 unmarshalBlendingFactor GetBlendDst))
          (\(s, d) ->
             glBlendFunc (marshalBlendingFactor s) (marshalBlendingFactor d))

    foreign import CALLCONV unsafe "glBlendFunc" glBlendFunc ::
       GLenum -> GLenum -> IO ()

    blendColor :: StateVar (Color4 GLclampf)
    blendColor =
       makeStateVar
          (getFloat4 Color4 GetBlendColor)
          (\(Color4 r g b a) -> glBlendColorEXT r g b a)

    EXTENSION_ENTRY("GL_EXT_blend_color or OpenGL 1.4",glBlendColorEXT,GLclampf -> GLclampf -> GLclampf -> GLclampf -> IO ())

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

    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 -> 0x1500
       And -> 0x1501
       AndReverse -> 0x1502
       Copy -> 0x1503
       AndInverted -> 0x1504
       Noop -> 0x1505
       Xor -> 0x1506
       Or -> 0x1507
       Nor -> 0x1508
       Equiv -> 0x1509
       Invert -> 0x150a
       OrReverse -> 0x150b
       CopyInverted -> 0x150c
       OrInverted -> 0x150d
       Nand -> 0x150e
       Set -> 0x150f

    unmarshalLogicOp :: GLenum -> LogicOp
    unmarshalLogicOp x
       | x == 0x1500 = Clear
       | x == 0x1501 = And
       | x == 0x1502 = AndReverse
       | x == 0x1503 = Copy
       | x == 0x1504 = AndInverted
       | x == 0x1505 = Noop
       | x == 0x1506 = Xor
       | x == 0x1507 = Or
       | x == 0x1508 = Nor
       | x == 0x1509 = Equiv
       | x == 0x150a = Invert
       | x == 0x150b = OrReverse
       | x == 0x150c = CopyInverted
       | x == 0x150d = OrInverted
       | x == 0x150e = Nand
       | x == 0x150f = 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)

    foreign import CALLCONV unsafe "glLogicOp" glLogicOp :: GLenum -> IO ()