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