-------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GL.Texturing.Parameters -- Copyright : (c) Sven Panne 2002-2016 -- License : BSD3 -- -- Maintainer : Sven Panne -- 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 Control.Monad 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.Filter 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.GL -------------------------------------------------------------------------------- textureFilter :: ParameterizedTextureTarget t => t -> 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_EXT (Mirrored, Repeat) -> GL_MIRRORED_REPEAT (Mirrored, ClampToEdge) -> GL_MIRROR_CLAMP_TO_EDGE (Mirrored, ClampToBorder) -> GL_MIRROR_CLAMP_TO_BORDER_EXT 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_EXT = (Mirrored, Clamp) | y == GL_MIRRORED_REPEAT = (Mirrored, Repeat) | y == GL_MIRROR_CLAMP_TO_EDGE = (Mirrored, ClampToEdge) | y == GL_MIRROR_CLAMP_TO_BORDER_EXT = (Mirrored, ClampToBorder) | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show x) where y = fromIntegral x -------------------------------------------------------------------------------- textureWrapMode :: ParameterizedTextureTarget t => t -> 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 :: ParameterizedTextureTarget t => t -> StateVar (Color4 GLfloat) textureBorderColor = texParamC4f TextureBorderColor -------------------------------------------------------------------------------- type LOD = GLfloat textureObjectLODBias :: ParameterizedTextureTarget t => t -> StateVar LOD textureObjectLODBias = texParamf id id TextureLODBias maxTextureLODBias :: GettableStateVar LOD maxTextureLODBias = makeGettableStateVar (getFloat1 id GetMaxTextureLODBias) textureLODRange :: ParameterizedTextureTarget t => t -> StateVar (LOD,LOD) textureLODRange = combineTexParams (texParamf id id TextureMinLOD) (texParamf id id TextureMaxLOD) -------------------------------------------------------------------------------- textureMaxAnisotropy :: ParameterizedTextureTarget t => t -> StateVar GLfloat textureMaxAnisotropy = texParamf id id TextureMaxAnisotropy maxTextureMaxAnisotropy :: GettableStateVar GLfloat maxTextureMaxAnisotropy = makeGettableStateVar (getFloat1 id GetMaxTextureMaxAnisotropy) -------------------------------------------------------------------------------- textureLevelRange :: ParameterizedTextureTarget t => t -> StateVar (Level,Level) textureLevelRange = combineTexParams (texParami id id TextureBaseLevel) (texParami id id TextureMaxLevel) -------------------------------------------------------------------------------- -- | Note: OpenGL 3.1 deprecated this texture parameter, use -- 'Graphics.Rendering.OpenGL.GL.Texturing.Objects.generateMipmap'' instead. generateMipmap :: ParameterizedTextureTarget t => t -> StateVar Capability generateMipmap = texParami unmarshal marshal GenerateMipmap where unmarshal = unmarshalCapability . fromIntegral marshal = fromIntegral . marshalCapability -------------------------------------------------------------------------------- -- Only Luminance', Intensity, and Alpha' allowed depthTextureMode :: ParameterizedTextureTarget t => t -> 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 :: ParameterizedTextureTarget t => t -> StateVar (Maybe ComparisonFunction) textureCompareMode = combineTexParamsMaybe (texParami unmarshalTextureCompareMode marshalTextureCompareMode TextureCompareMode) (texParami unmarshal marshal TextureCompareFunc) where unmarshal = unmarshalComparisonFunction . fromIntegral marshal = fromIntegral . marshalComparisonFunction -------------------------------------------------------------------------------- textureCompareFailValue :: ParameterizedTextureTarget t => t -> StateVar GLclampf textureCompareFailValue = texParamf realToFrac realToFrac TextureCompareFailValue -------------------------------------------------------------------------------- data TextureCompareOperator = LequalR | GequalR deriving ( Eq, Ord, Show ) marshalTextureCompareOperator :: TextureCompareOperator -> GLenum marshalTextureCompareOperator x = case x of LequalR -> GL_TEXTURE_LEQUAL_R_SGIX GequalR -> GL_TEXTURE_GEQUAL_R_SGIX unmarshalTextureCompareOperator :: GLenum -> TextureCompareOperator unmarshalTextureCompareOperator x | x == GL_TEXTURE_LEQUAL_R_SGIX = LequalR | x == GL_TEXTURE_GEQUAL_R_SGIX = GequalR | otherwise = error ("unmarshalTextureCompareOperator: illegal value " ++ show x) -------------------------------------------------------------------------------- textureCompareOperator :: ParameterizedTextureTarget t => t -> StateVar (Maybe TextureCompareOperator) textureCompareOperator = combineTexParamsMaybe (texParami (unmarshalCapability . fromIntegral) (fromIntegral. marshalCapability) TextureCompare) (texParami (unmarshalTextureCompareOperator . fromIntegral) (fromIntegral . marshalTextureCompareOperator) TextureCompareOperator) -------------------------------------------------------------------------------- combineTexParams :: (t -> StateVar a) -> (t -> StateVar b) -> (t -> StateVar (a,b)) combineTexParams v w t = makeStateVar (liftM2 (,) (get (v t)) (get (w t))) (\(x,y) -> do v t $= x; w t $= y) combineTexParamsMaybe :: (t -> StateVar Capability) -> (t -> StateVar a) -> (t -> StateVar (Maybe a)) combineTexParamsMaybe enab val t = makeStateVar (do tcm <- get (enab t) case tcm of Disabled -> return Nothing Enabled -> fmap Just $ get (val t)) (maybe (enab t $= Disabled) (\tcf -> do val t $= tcf enab t $= Enabled))