--------------------------------------------------------------------------------
-- |
-- 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 Graphics.Rendering.OpenGL.GL.BasicTypes (
   GLint, GLfloat, GLclampf, Capability(..) )
import Graphics.Rendering.OpenGL.GL.Capability (
   marshalCapability, unmarshalCapability )
import Graphics.Rendering.OpenGL.GL.ComparisonFunction (
   marshalComparisonFunction, unmarshalComparisonFunction )
import Graphics.Rendering.OpenGL.GL.CoordTrans ( TextureCoordName(..) )
import Graphics.Rendering.OpenGL.GL.PerFragment ( ComparisonFunction )
import Graphics.Rendering.OpenGL.GL.PixelRectangles (
   PixelInternalFormat(..) )
import Graphics.Rendering.OpenGL.GL.QueryUtils (
   GetPName(GetMaxTextureMaxAnisotropy,GetMaxTextureLODBias), getFloat1)
import Graphics.Rendering.OpenGL.GL.StateVar (
   GettableStateVar, makeGettableStateVar,
   StateVar, makeStateVar )
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (
   Level, TextureTarget(..) )
import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter (
   TexParameter(TextureMinFilter,TextureMagFilter,TextureWrapS,TextureWrapT,
                TextureWrapR,TextureBorderColor,TextureMinLOD,TextureMaxLOD,
                TextureBaseLevel,TextureMaxLevel,TextureMaxAnisotropy,
                TextureLODBias,GenerateMipmap,DepthTextureMode,
                TextureCompareMode,TextureCompareFunc,TextureCompareFailValue,
                TextureCompare,TextureCompareOperator),
   texParami, texParamf, texParamC4f, combineTexParams, combineTexParamsMaybe )
import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (
   marshalPixelInternalFormat, unmarshalPixelInternalFormat )
import Graphics.Rendering.OpenGL.GL.VertexSpec( Color4(..) )
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidEnum )

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

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 = case x of
   (Nearest, Nothing     ) -> 0x2600
   (Linear', Nothing     ) -> 0x2601
   (Nearest, Just Nearest) -> 0x2700
   (Linear', Just Nearest) -> 0x2701
   (Nearest, Just Linear') -> 0x2702
   (Linear', Just Linear') -> 0x2703

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

unmarshalMinificationFilter :: GLint -> MinificationFilter
unmarshalMinificationFilter x
   | x ==  0x2600 = (Nearest, Nothing     )
   | x ==  0x2601 = (Linear', Nothing     )
   | x ==  0x2700 = (Nearest, Just Nearest)
   | x ==  0x2701 = (Linear', Just Nearest)
   | x ==  0x2702 = (Nearest, Just Linear')
   | x ==  0x2703 = (Linear', Just Linear')
   | otherwise = error ("unmarshalMinificationFilter: illegal value " ++ show 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 = case x of
   (Repeated, Clamp) -> 0x2900
   (Repeated, Repeat) -> 0x2901
   (Repeated, ClampToEdge) -> 0x812f
   (Repeated, ClampToBorder) -> 0x812d
   (Mirrored, Clamp) -> 0x8742
   (Mirrored, Repeat) -> 0x8370
   (Mirrored, ClampToEdge) -> 0x8743
   (Mirrored, ClampToBorder) -> 0x8912

unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)
unmarshalTextureWrapMode x
   | x == 0x2900 = (Repeated, Clamp)
   | x == 0x2901 = (Repeated, Repeat)
   | x == 0x812f = (Repeated, ClampToEdge)
   | x == 0x812d = (Repeated, ClampToBorder)
   | x == 0x8742 = (Mirrored, Clamp)
   | x == 0x8370 = (Mirrored, Repeat)
   | x == 0x8743 = (Mirrored, ClampToEdge)
   | x == 0x8912 = (Mirrored, ClampToBorder)
   | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show 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 = case x of
   Disabled -> 0x0     -- i.e. None
   Enabled -> 0x884e   -- i.e. CompareRToTexture

unmarshalTextureCompareMode :: GLint -> Capability
unmarshalTextureCompareMode x
   | x == 0x0 = Disabled
   | x == 0x884e = Enabled
   | otherwise = error ("unmarshalTextureCompareMode: illegal value " ++ show 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 id id 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)