    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Parameters
    -- 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 3.8.4 (Texture Parameters), section 3.8.7
    -- (Texture Wrap Mode), section 3.8.8 (Texture Minification), and section 3.8.9
    -- (Texture Magnification) of the OpenGL 2.1 specs.
    --
    --------------------------------------------------------------------------------

    module Graphics.Rendering.OpenGL.GL.Texturing.Parameters (
       TextureFilter(..), MinificationFilter, MagnificationFilter, textureFilter,
       Repetition(..), Clamping(..), textureWrapMode,
       textureBorderColor, LOD, textureObjectLODBias, maxTextureLODBias,
       textureLODRange, textureMaxAnisotropy, maxTextureMaxAnisotropy,
       textureLevelRange, generateMipmap, depthTextureMode, textureCompareMode,
       textureCompareFailValue, TextureCompareOperator(..), textureCompareOperator
    ) where

    import Data.StateVar
    import Graphics.Rendering.OpenGL.GL.Capability
    import Graphics.Rendering.OpenGL.GL.ComparisonFunction
    import Graphics.Rendering.OpenGL.GL.CoordTrans
    import Graphics.Rendering.OpenGL.GL.PerFragment
    import Graphics.Rendering.OpenGL.GL.QueryUtils
    import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
    import Graphics.Rendering.OpenGL.GL.Texturing.Specification
    import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter
    import Graphics.Rendering.OpenGL.GL.VertexSpec
    import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
    import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( gl_CLAMP )
    import Graphics.Rendering.OpenGL.Raw.Core31
    import Graphics.Rendering.OpenGL.Raw.EXT.TextureMirrorClamp (
       gl_MIRROR_CLAMP, gl_MIRROR_CLAMP_TO_BORDER, gl_MIRROR_CLAMP_TO_EDGE )

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

    data TextureFilter =
         Nearest
       | Linear'
       deriving ( Eq, Ord, Show )

    type MinificationFilter = (TextureFilter, Maybe TextureFilter)

    type MagnificationFilter = TextureFilter

    -- We treat MagnificationFilter as a degenerated case of MinificationFilter
    magToMin :: MagnificationFilter -> MinificationFilter
    magToMin magFilter = (magFilter, Nothing)

    minToMag :: MinificationFilter -> MagnificationFilter
    minToMag (magFilter, Nothing) = magFilter
    minToMag minFilter = error ("minToMag: illegal value " ++ show minFilter)

    marshalMinificationFilter :: MinificationFilter -> GLint
    marshalMinificationFilter x = fromIntegral $ case x of
       (Nearest, Nothing     ) -> gl_NEAREST
       (Linear', Nothing     ) -> gl_LINEAR
       (Nearest, Just Nearest) -> gl_NEAREST_MIPMAP_NEAREST
       (Linear', Just Nearest) -> gl_LINEAR_MIPMAP_NEAREST
       (Nearest, Just Linear') -> gl_NEAREST_MIPMAP_LINEAR
       (Linear', Just Linear') -> gl_LINEAR_MIPMAP_LINEAR

    marshalMagnificationFilter :: MagnificationFilter -> GLint
    marshalMagnificationFilter = marshalMinificationFilter . magToMin

    unmarshalMinificationFilter :: GLint -> MinificationFilter
    unmarshalMinificationFilter x
       | y ==  gl_NEAREST = (Nearest, Nothing)
       | y ==  gl_LINEAR = (Linear', Nothing)
       | y ==  gl_NEAREST_MIPMAP_NEAREST = (Nearest, Just Nearest)
       | y ==  gl_LINEAR_MIPMAP_NEAREST = (Linear', Just Nearest)
       | y ==  gl_NEAREST_MIPMAP_LINEAR = (Nearest, Just Linear')
       | y ==  gl_LINEAR_MIPMAP_LINEAR = (Linear', Just Linear')
       | otherwise = error ("unmarshalMinificationFilter: illegal value " ++ show x)
       where y = fromIntegral x

    unmarshalMagnificationFilter :: GLint -> MagnificationFilter
    unmarshalMagnificationFilter = minToMag . unmarshalMinificationFilter

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

    textureFilter :: TextureTarget -> StateVar (MinificationFilter, MagnificationFilter)
    textureFilter =
       combineTexParams
          (texParami unmarshalMinificationFilter  marshalMinificationFilter  TextureMinFilter)
          (texParami unmarshalMagnificationFilter marshalMagnificationFilter TextureMagFilter)

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

    data Repetition =
         Repeated
       | Mirrored
       deriving ( Eq, Ord, Show )

    data Clamping =
         Clamp
       | Repeat
       | ClampToEdge
       | ClampToBorder
       deriving ( Eq, Ord, Show )

    marshalTextureWrapMode :: (Repetition, Clamping) -> GLint
    marshalTextureWrapMode x = fromIntegral $ case x of
       (Repeated, Clamp) -> gl_CLAMP
       (Repeated, Repeat) -> gl_REPEAT
       (Repeated, ClampToEdge) -> gl_CLAMP_TO_EDGE
       (Repeated, ClampToBorder) -> gl_CLAMP_TO_BORDER
       (Mirrored, Clamp) -> gl_MIRROR_CLAMP
       (Mirrored, Repeat) -> gl_MIRRORED_REPEAT
       (Mirrored, ClampToEdge) -> gl_MIRROR_CLAMP_TO_EDGE
       (Mirrored, ClampToBorder) -> gl_MIRROR_CLAMP_TO_BORDER

    unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)
    unmarshalTextureWrapMode x
       | y == gl_CLAMP = (Repeated, Clamp)
       | y == gl_REPEAT = (Repeated, Repeat)
       | y == gl_CLAMP_TO_EDGE = (Repeated, ClampToEdge)
       | y == gl_CLAMP_TO_BORDER = (Repeated, ClampToBorder)
       | y == gl_MIRROR_CLAMP = (Mirrored, Clamp)
       | y == gl_MIRRORED_REPEAT = (Mirrored, Repeat)
       | y == gl_MIRROR_CLAMP_TO_EDGE = (Mirrored, ClampToEdge)
       | y == gl_MIRROR_CLAMP_TO_BORDER = (Mirrored, ClampToBorder)
       | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show x)
       where y = fromIntegral x

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

    textureWrapMode :: TextureTarget -> TextureCoordName -> StateVar (Repetition,Clamping)
    textureWrapMode t coord = case coord of
       S -> wrap TextureWrapS
       T -> wrap TextureWrapT
       R -> wrap TextureWrapR
       Q -> invalidTextureCoord
       where wrap c = texParami unmarshalTextureWrapMode marshalTextureWrapMode c t

    invalidTextureCoord :: StateVar (Repetition,Clamping)
    invalidTextureCoord =
       makeStateVar
          (do recordInvalidEnum; return (Repeated, Repeat))
          (const recordInvalidEnum)

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

    textureBorderColor :: TextureTarget -> StateVar (Color4 GLfloat)
    textureBorderColor = texParamC4f TextureBorderColor

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

    type LOD = GLfloat

    textureObjectLODBias :: TextureTarget -> StateVar LOD
    textureObjectLODBias = texParamf id id TextureLODBias

    maxTextureLODBias :: GettableStateVar LOD
    maxTextureLODBias =
       makeGettableStateVar (getFloat1 id GetMaxTextureLODBias)

    textureLODRange :: TextureTarget -> StateVar (LOD,LOD)
    textureLODRange =
       combineTexParams
          (texParamf id id TextureMinLOD)
          (texParamf id id TextureMaxLOD)

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

    textureMaxAnisotropy :: TextureTarget -> StateVar GLfloat
    textureMaxAnisotropy = texParamf id id TextureMaxAnisotropy

    maxTextureMaxAnisotropy :: GettableStateVar GLfloat
    maxTextureMaxAnisotropy =
       makeGettableStateVar (getFloat1 id GetMaxTextureMaxAnisotropy)

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

    textureLevelRange :: TextureTarget -> StateVar (Level,Level)
    textureLevelRange =
       combineTexParams
          (texParami id id TextureBaseLevel)
          (texParami id id TextureMaxLevel)

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

    generateMipmap :: TextureTarget -> StateVar Capability
    generateMipmap = texParami unmarshal marshal GenerateMipmap
       where unmarshal = unmarshalCapability . fromIntegral
             marshal = fromIntegral . marshalCapability

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

    -- Only Luminance', Intensity, and Alpha' allowed
    depthTextureMode :: TextureTarget -> StateVar PixelInternalFormat
    depthTextureMode =
       texParami unmarshalPixelInternalFormat marshalPixelInternalFormat DepthTextureMode

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

    marshalTextureCompareMode :: Capability -> GLint
    marshalTextureCompareMode x = fromIntegral $ case x of
       Disabled -> gl_NONE
       Enabled -> gl_COMPARE_REF_TO_TEXTURE

    unmarshalTextureCompareMode :: GLint -> Capability
    unmarshalTextureCompareMode x
       | y == gl_NONE = Disabled
       | y == gl_COMPARE_REF_TO_TEXTURE = Enabled
       | otherwise = error ("unmarshalTextureCompareMode: illegal value " ++ show x)
       where y = fromIntegral x

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

    textureCompareMode :: TextureTarget -> StateVar (Maybe ComparisonFunction)
    textureCompareMode =
       combineTexParamsMaybe
          (texParami unmarshalTextureCompareMode marshalTextureCompareMode TextureCompareMode)
          (texParami unmarshal marshal TextureCompareFunc)
       where unmarshal = unmarshalComparisonFunction . fromIntegral
             marshal = fromIntegral . marshalComparisonFunction

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

    textureCompareFailValue :: TextureTarget -> StateVar GLclampf
    textureCompareFailValue = texParamf realToFrac realToFrac TextureCompareFailValue

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

    data TextureCompareOperator =
         LequalR
       | GequalR
       deriving ( Eq, Ord, Show )

    marshalTextureCompareOperator :: TextureCompareOperator -> GLint
    marshalTextureCompareOperator x = case x of
       LequalR -> 0x819c
       GequalR -> 0x819d

    unmarshalTextureCompareOperator :: GLint -> TextureCompareOperator
    unmarshalTextureCompareOperator x
       | x == 0x819c = LequalR
       | x == 0x819d = GequalR
       | otherwise = error ("unmarshalTextureCompareOperator: illegal value " ++ show x)

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

    textureCompareOperator :: TextureTarget -> StateVar (Maybe TextureCompareOperator)
    textureCompareOperator =
       combineTexParamsMaybe
          (texParami (unmarshalCapability . fromIntegral) (fromIntegral. marshalCapability) TextureCompare)
          (texParami unmarshalTextureCompareOperator marshalTextureCompareOperator TextureCompareOperator)