--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Parameters
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- 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 :: forall t.
ParameterizedTextureTarget t =>
t -> StateVar (MinificationFilter, MagnificationFilter)
textureFilter =
   (t -> StateVar MinificationFilter)
-> (t -> StateVar MagnificationFilter)
-> t
-> StateVar (MinificationFilter, MagnificationFilter)
forall t a b.
(t -> StateVar a) -> (t -> StateVar b) -> t -> StateVar (a, b)
combineTexParams
      ((GLint -> MinificationFilter)
-> (MinificationFilter -> GLint)
-> TexParameter
-> t
-> StateVar MinificationFilter
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami GLint -> MinificationFilter
unmarshalMinificationFilter  MinificationFilter -> GLint
marshalMinificationFilter  TexParameter
TextureMinFilter)
      ((GLint -> MagnificationFilter)
-> (MagnificationFilter -> GLint)
-> TexParameter
-> t
-> StateVar MagnificationFilter
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami GLint -> MagnificationFilter
unmarshalMagnificationFilter MagnificationFilter -> GLint
marshalMagnificationFilter TexParameter
TextureMagFilter)

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

data Repetition =
     Repeated
   | Mirrored
   deriving ( Repetition -> Repetition -> Bool
(Repetition -> Repetition -> Bool)
-> (Repetition -> Repetition -> Bool) -> Eq Repetition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Repetition -> Repetition -> Bool
== :: Repetition -> Repetition -> Bool
$c/= :: Repetition -> Repetition -> Bool
/= :: Repetition -> Repetition -> Bool
Eq, Eq Repetition
Eq Repetition
-> (Repetition -> Repetition -> Ordering)
-> (Repetition -> Repetition -> Bool)
-> (Repetition -> Repetition -> Bool)
-> (Repetition -> Repetition -> Bool)
-> (Repetition -> Repetition -> Bool)
-> (Repetition -> Repetition -> Repetition)
-> (Repetition -> Repetition -> Repetition)
-> Ord Repetition
Repetition -> Repetition -> Bool
Repetition -> Repetition -> Ordering
Repetition -> Repetition -> Repetition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Repetition -> Repetition -> Ordering
compare :: Repetition -> Repetition -> Ordering
$c< :: Repetition -> Repetition -> Bool
< :: Repetition -> Repetition -> Bool
$c<= :: Repetition -> Repetition -> Bool
<= :: Repetition -> Repetition -> Bool
$c> :: Repetition -> Repetition -> Bool
> :: Repetition -> Repetition -> Bool
$c>= :: Repetition -> Repetition -> Bool
>= :: Repetition -> Repetition -> Bool
$cmax :: Repetition -> Repetition -> Repetition
max :: Repetition -> Repetition -> Repetition
$cmin :: Repetition -> Repetition -> Repetition
min :: Repetition -> Repetition -> Repetition
Ord, Int -> Repetition -> ShowS
[Repetition] -> ShowS
Repetition -> String
(Int -> Repetition -> ShowS)
-> (Repetition -> String)
-> ([Repetition] -> ShowS)
-> Show Repetition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Repetition -> ShowS
showsPrec :: Int -> Repetition -> ShowS
$cshow :: Repetition -> String
show :: Repetition -> String
$cshowList :: [Repetition] -> ShowS
showList :: [Repetition] -> ShowS
Show )

data Clamping =
     Clamp
   | Repeat
   | ClampToEdge
   | ClampToBorder
   deriving ( Clamping -> Clamping -> Bool
(Clamping -> Clamping -> Bool)
-> (Clamping -> Clamping -> Bool) -> Eq Clamping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Clamping -> Clamping -> Bool
== :: Clamping -> Clamping -> Bool
$c/= :: Clamping -> Clamping -> Bool
/= :: Clamping -> Clamping -> Bool
Eq, Eq Clamping
Eq Clamping
-> (Clamping -> Clamping -> Ordering)
-> (Clamping -> Clamping -> Bool)
-> (Clamping -> Clamping -> Bool)
-> (Clamping -> Clamping -> Bool)
-> (Clamping -> Clamping -> Bool)
-> (Clamping -> Clamping -> Clamping)
-> (Clamping -> Clamping -> Clamping)
-> Ord Clamping
Clamping -> Clamping -> Bool
Clamping -> Clamping -> Ordering
Clamping -> Clamping -> Clamping
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Clamping -> Clamping -> Ordering
compare :: Clamping -> Clamping -> Ordering
$c< :: Clamping -> Clamping -> Bool
< :: Clamping -> Clamping -> Bool
$c<= :: Clamping -> Clamping -> Bool
<= :: Clamping -> Clamping -> Bool
$c> :: Clamping -> Clamping -> Bool
> :: Clamping -> Clamping -> Bool
$c>= :: Clamping -> Clamping -> Bool
>= :: Clamping -> Clamping -> Bool
$cmax :: Clamping -> Clamping -> Clamping
max :: Clamping -> Clamping -> Clamping
$cmin :: Clamping -> Clamping -> Clamping
min :: Clamping -> Clamping -> Clamping
Ord, Int -> Clamping -> ShowS
[Clamping] -> ShowS
Clamping -> String
(Int -> Clamping -> ShowS)
-> (Clamping -> String) -> ([Clamping] -> ShowS) -> Show Clamping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Clamping -> ShowS
showsPrec :: Int -> Clamping -> ShowS
$cshow :: Clamping -> String
show :: Clamping -> String
$cshowList :: [Clamping] -> ShowS
showList :: [Clamping] -> ShowS
Show )

marshalTextureWrapMode :: (Repetition, Clamping) -> GLint
marshalTextureWrapMode :: (Repetition, Clamping) -> GLint
marshalTextureWrapMode (Repetition, Clamping)
x = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ case (Repetition, Clamping)
x of
   (Repetition
Repeated, Clamping
Clamp) -> GLenum
GL_CLAMP
   (Repetition
Repeated, Clamping
Repeat) -> GLenum
GL_REPEAT
   (Repetition
Repeated, Clamping
ClampToEdge) -> GLenum
GL_CLAMP_TO_EDGE
   (Repetition
Repeated, Clamping
ClampToBorder) -> GLenum
GL_CLAMP_TO_BORDER
   (Repetition
Mirrored, Clamping
Clamp) -> GLenum
GL_MIRROR_CLAMP_EXT
   (Repetition
Mirrored, Clamping
Repeat) -> GLenum
GL_MIRRORED_REPEAT
   (Repetition
Mirrored, Clamping
ClampToEdge) -> GLenum
GL_MIRROR_CLAMP_TO_EDGE
   (Repetition
Mirrored, Clamping
ClampToBorder) -> GLenum
GL_MIRROR_CLAMP_TO_BORDER_EXT

unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)
unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)
unmarshalTextureWrapMode GLint
x
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_CLAMP = (Repetition
Repeated, Clamping
Clamp)
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_REPEAT = (Repetition
Repeated, Clamping
Repeat)
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_CLAMP_TO_EDGE = (Repetition
Repeated, Clamping
ClampToEdge)
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_CLAMP_TO_BORDER = (Repetition
Repeated, Clamping
ClampToBorder)
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_MIRROR_CLAMP_EXT = (Repetition
Mirrored, Clamping
Clamp)
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_MIRRORED_REPEAT = (Repetition
Mirrored, Clamping
Repeat)
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_MIRROR_CLAMP_TO_EDGE = (Repetition
Mirrored, Clamping
ClampToEdge)
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_MIRROR_CLAMP_TO_BORDER_EXT = (Repetition
Mirrored, Clamping
ClampToBorder)
   | Bool
otherwise = String -> (Repetition, Clamping)
forall a. HasCallStack => String -> a
error (String
"unmarshalTextureWrapMode: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLint -> String
forall a. Show a => a -> String
show GLint
x)
   where y :: GLenum
y = GLint -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
x

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

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

invalidTextureCoord :: StateVar (Repetition,Clamping)
invalidTextureCoord :: StateVar (Repetition, Clamping)
invalidTextureCoord =
   IO (Repetition, Clamping)
-> ((Repetition, Clamping) -> IO ())
-> StateVar (Repetition, Clamping)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (do IO ()
recordInvalidEnum; (Repetition, Clamping) -> IO (Repetition, Clamping)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Repetition
Repeated, Clamping
Repeat))
      (IO () -> (Repetition, Clamping) -> IO ()
forall a b. a -> b -> a
const IO ()
recordInvalidEnum)

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

textureBorderColor :: ParameterizedTextureTarget t => t -> StateVar (Color4 GLfloat)
textureBorderColor :: forall t.
ParameterizedTextureTarget t =>
t -> StateVar (Color4 GLfloat)
textureBorderColor = TexParameter -> t -> StateVar (Color4 GLfloat)
forall t.
ParameterizedTextureTarget t =>
TexParameter -> t -> StateVar (Color4 GLfloat)
texParamC4f TexParameter
TextureBorderColor

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

type LOD = GLfloat

textureObjectLODBias :: ParameterizedTextureTarget t => t -> StateVar LOD
textureObjectLODBias :: forall t. ParameterizedTextureTarget t => t -> StateVar GLfloat
textureObjectLODBias = (GLfloat -> GLfloat)
-> (GLfloat -> GLfloat) -> TexParameter -> t -> StateVar GLfloat
forall t a.
ParameterizedTextureTarget t =>
(GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> t -> StateVar a
texParamf GLfloat -> GLfloat
forall a. a -> a
id GLfloat -> GLfloat
forall a. a -> a
id TexParameter
TextureLODBias

maxTextureLODBias :: GettableStateVar LOD
maxTextureLODBias :: GettableStateVar GLfloat
maxTextureLODBias =
   GettableStateVar GLfloat -> GettableStateVar GLfloat
forall a. IO a -> IO a
makeGettableStateVar ((GLfloat -> GLfloat) -> PName1F -> GettableStateVar GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
forall a. (GLfloat -> a) -> PName1F -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id PName1F
GetMaxTextureLODBias)

textureLODRange :: ParameterizedTextureTarget t => t -> StateVar (LOD,LOD)
textureLODRange :: forall t.
ParameterizedTextureTarget t =>
t -> StateVar (GLfloat, GLfloat)
textureLODRange =
   (t -> StateVar GLfloat)
-> (t -> StateVar GLfloat) -> t -> StateVar (GLfloat, GLfloat)
forall t a b.
(t -> StateVar a) -> (t -> StateVar b) -> t -> StateVar (a, b)
combineTexParams
      ((GLfloat -> GLfloat)
-> (GLfloat -> GLfloat) -> TexParameter -> t -> StateVar GLfloat
forall t a.
ParameterizedTextureTarget t =>
(GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> t -> StateVar a
texParamf GLfloat -> GLfloat
forall a. a -> a
id GLfloat -> GLfloat
forall a. a -> a
id TexParameter
TextureMinLOD)
      ((GLfloat -> GLfloat)
-> (GLfloat -> GLfloat) -> TexParameter -> t -> StateVar GLfloat
forall t a.
ParameterizedTextureTarget t =>
(GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> t -> StateVar a
texParamf GLfloat -> GLfloat
forall a. a -> a
id GLfloat -> GLfloat
forall a. a -> a
id TexParameter
TextureMaxLOD)

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

textureMaxAnisotropy :: ParameterizedTextureTarget t => t -> StateVar GLfloat
textureMaxAnisotropy :: forall t. ParameterizedTextureTarget t => t -> StateVar GLfloat
textureMaxAnisotropy = (GLfloat -> GLfloat)
-> (GLfloat -> GLfloat) -> TexParameter -> t -> StateVar GLfloat
forall t a.
ParameterizedTextureTarget t =>
(GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> t -> StateVar a
texParamf GLfloat -> GLfloat
forall a. a -> a
id GLfloat -> GLfloat
forall a. a -> a
id TexParameter
TextureMaxAnisotropy

maxTextureMaxAnisotropy :: GettableStateVar GLfloat
maxTextureMaxAnisotropy :: GettableStateVar GLfloat
maxTextureMaxAnisotropy =
   GettableStateVar GLfloat -> GettableStateVar GLfloat
forall a. IO a -> IO a
makeGettableStateVar ((GLfloat -> GLfloat) -> PName1F -> GettableStateVar GLfloat
forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
forall a. (GLfloat -> a) -> PName1F -> IO a
getFloat1 GLfloat -> GLfloat
forall a. a -> a
id PName1F
GetMaxTextureMaxAnisotropy)

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

textureLevelRange :: ParameterizedTextureTarget t => t -> StateVar (Level,Level)
textureLevelRange :: forall t.
ParameterizedTextureTarget t =>
t -> StateVar (GLint, GLint)
textureLevelRange =
   (t -> StateVar GLint)
-> (t -> StateVar GLint) -> t -> StateVar (GLint, GLint)
forall t a b.
(t -> StateVar a) -> (t -> StateVar b) -> t -> StateVar (a, b)
combineTexParams
      ((GLint -> GLint)
-> (GLint -> GLint) -> TexParameter -> t -> StateVar GLint
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami GLint -> GLint
forall a. a -> a
id GLint -> GLint
forall a. a -> a
id TexParameter
TextureBaseLevel)
      ((GLint -> GLint)
-> (GLint -> GLint) -> TexParameter -> t -> StateVar GLint
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami GLint -> GLint
forall a. a -> a
id GLint -> GLint
forall a. a -> a
id TexParameter
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 :: forall t. ParameterizedTextureTarget t => t -> StateVar Capability
generateMipmap = (GLint -> Capability)
-> (Capability -> GLint)
-> TexParameter
-> t
-> StateVar Capability
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami GLint -> Capability
unmarshal Capability -> GLint
marshal TexParameter
GenerateMipmap
   where unmarshal :: GLint -> Capability
unmarshal = GLboolean -> Capability
unmarshalCapability (GLboolean -> Capability)
-> (GLint -> GLboolean) -> GLint -> Capability
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLboolean
forall a b. (Integral a, Num b) => a -> b
fromIntegral
         marshal :: Capability -> GLint
marshal = GLboolean -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLboolean -> GLint)
-> (Capability -> GLboolean) -> Capability -> GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capability -> GLboolean
marshalCapability

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

-- Only Luminance', Intensity, and Alpha' allowed
depthTextureMode :: ParameterizedTextureTarget t => t -> StateVar PixelInternalFormat
depthTextureMode :: forall t.
ParameterizedTextureTarget t =>
t -> StateVar PixelInternalFormat
depthTextureMode =
   (GLint -> PixelInternalFormat)
-> (PixelInternalFormat -> GLint)
-> TexParameter
-> t
-> StateVar PixelInternalFormat
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami GLint -> PixelInternalFormat
unmarshalPixelInternalFormat PixelInternalFormat -> GLint
marshalPixelInternalFormat TexParameter
DepthTextureMode

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

marshalTextureCompareMode :: Capability -> GLint
marshalTextureCompareMode :: Capability -> GLint
marshalTextureCompareMode Capability
x = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint) -> GLenum -> GLint
forall a b. (a -> b) -> a -> b
$ case Capability
x of
   Capability
Disabled -> GLenum
GL_NONE
   Capability
Enabled -> GLenum
GL_COMPARE_REF_TO_TEXTURE

unmarshalTextureCompareMode :: GLint -> Capability
unmarshalTextureCompareMode :: GLint -> Capability
unmarshalTextureCompareMode GLint
x
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_NONE = Capability
Disabled
   | GLenum
y GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMPARE_REF_TO_TEXTURE = Capability
Enabled
   | Bool
otherwise = String -> Capability
forall a. HasCallStack => String -> a
error (String
"unmarshalTextureCompareMode: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLint -> String
forall a. Show a => a -> String
show GLint
x)
   where y :: GLenum
y = GLint -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
x

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

textureCompareMode :: ParameterizedTextureTarget t => t -> StateVar (Maybe ComparisonFunction)
textureCompareMode :: forall t.
ParameterizedTextureTarget t =>
t -> StateVar (Maybe ComparisonFunction)
textureCompareMode =
   (t -> StateVar Capability)
-> (t -> StateVar ComparisonFunction)
-> t
-> StateVar (Maybe ComparisonFunction)
forall t a.
(t -> StateVar Capability)
-> (t -> StateVar a) -> t -> StateVar (Maybe a)
combineTexParamsMaybe
      ((GLint -> Capability)
-> (Capability -> GLint)
-> TexParameter
-> t
-> StateVar Capability
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami GLint -> Capability
unmarshalTextureCompareMode Capability -> GLint
marshalTextureCompareMode TexParameter
TextureCompareMode)
      ((GLint -> ComparisonFunction)
-> (ComparisonFunction -> GLint)
-> TexParameter
-> t
-> StateVar ComparisonFunction
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami GLint -> ComparisonFunction
unmarshal ComparisonFunction -> GLint
marshal TexParameter
TextureCompareFunc)
   where unmarshal :: GLint -> ComparisonFunction
unmarshal = GLenum -> ComparisonFunction
unmarshalComparisonFunction (GLenum -> ComparisonFunction)
-> (GLint -> GLenum) -> GLint -> ComparisonFunction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral
         marshal :: ComparisonFunction -> GLint
marshal = GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint)
-> (ComparisonFunction -> GLenum) -> ComparisonFunction -> GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComparisonFunction -> GLenum
marshalComparisonFunction

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

textureCompareFailValue :: ParameterizedTextureTarget t => t -> StateVar GLclampf
textureCompareFailValue :: forall t. ParameterizedTextureTarget t => t -> StateVar GLfloat
textureCompareFailValue = (GLfloat -> GLfloat)
-> (GLfloat -> GLfloat) -> TexParameter -> t -> StateVar GLfloat
forall t a.
ParameterizedTextureTarget t =>
(GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> t -> StateVar a
texParamf GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac TexParameter
TextureCompareFailValue

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

data TextureCompareOperator =
     LequalR
   | GequalR
   deriving ( TextureCompareOperator -> TextureCompareOperator -> Bool
(TextureCompareOperator -> TextureCompareOperator -> Bool)
-> (TextureCompareOperator -> TextureCompareOperator -> Bool)
-> Eq TextureCompareOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextureCompareOperator -> TextureCompareOperator -> Bool
== :: TextureCompareOperator -> TextureCompareOperator -> Bool
$c/= :: TextureCompareOperator -> TextureCompareOperator -> Bool
/= :: TextureCompareOperator -> TextureCompareOperator -> Bool
Eq, Eq TextureCompareOperator
Eq TextureCompareOperator
-> (TextureCompareOperator -> TextureCompareOperator -> Ordering)
-> (TextureCompareOperator -> TextureCompareOperator -> Bool)
-> (TextureCompareOperator -> TextureCompareOperator -> Bool)
-> (TextureCompareOperator -> TextureCompareOperator -> Bool)
-> (TextureCompareOperator -> TextureCompareOperator -> Bool)
-> (TextureCompareOperator
    -> TextureCompareOperator -> TextureCompareOperator)
-> (TextureCompareOperator
    -> TextureCompareOperator -> TextureCompareOperator)
-> Ord TextureCompareOperator
TextureCompareOperator -> TextureCompareOperator -> Bool
TextureCompareOperator -> TextureCompareOperator -> Ordering
TextureCompareOperator
-> TextureCompareOperator -> TextureCompareOperator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TextureCompareOperator -> TextureCompareOperator -> Ordering
compare :: TextureCompareOperator -> TextureCompareOperator -> Ordering
$c< :: TextureCompareOperator -> TextureCompareOperator -> Bool
< :: TextureCompareOperator -> TextureCompareOperator -> Bool
$c<= :: TextureCompareOperator -> TextureCompareOperator -> Bool
<= :: TextureCompareOperator -> TextureCompareOperator -> Bool
$c> :: TextureCompareOperator -> TextureCompareOperator -> Bool
> :: TextureCompareOperator -> TextureCompareOperator -> Bool
$c>= :: TextureCompareOperator -> TextureCompareOperator -> Bool
>= :: TextureCompareOperator -> TextureCompareOperator -> Bool
$cmax :: TextureCompareOperator
-> TextureCompareOperator -> TextureCompareOperator
max :: TextureCompareOperator
-> TextureCompareOperator -> TextureCompareOperator
$cmin :: TextureCompareOperator
-> TextureCompareOperator -> TextureCompareOperator
min :: TextureCompareOperator
-> TextureCompareOperator -> TextureCompareOperator
Ord, Int -> TextureCompareOperator -> ShowS
[TextureCompareOperator] -> ShowS
TextureCompareOperator -> String
(Int -> TextureCompareOperator -> ShowS)
-> (TextureCompareOperator -> String)
-> ([TextureCompareOperator] -> ShowS)
-> Show TextureCompareOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextureCompareOperator -> ShowS
showsPrec :: Int -> TextureCompareOperator -> ShowS
$cshow :: TextureCompareOperator -> String
show :: TextureCompareOperator -> String
$cshowList :: [TextureCompareOperator] -> ShowS
showList :: [TextureCompareOperator] -> ShowS
Show )

marshalTextureCompareOperator :: TextureCompareOperator -> GLenum
marshalTextureCompareOperator :: TextureCompareOperator -> GLenum
marshalTextureCompareOperator TextureCompareOperator
x = case TextureCompareOperator
x of
   TextureCompareOperator
LequalR -> GLenum
GL_TEXTURE_LEQUAL_R_SGIX
   TextureCompareOperator
GequalR -> GLenum
GL_TEXTURE_GEQUAL_R_SGIX

unmarshalTextureCompareOperator :: GLenum -> TextureCompareOperator
unmarshalTextureCompareOperator :: GLenum -> TextureCompareOperator
unmarshalTextureCompareOperator GLenum
x
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_TEXTURE_LEQUAL_R_SGIX = TextureCompareOperator
LequalR
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_TEXTURE_GEQUAL_R_SGIX = TextureCompareOperator
GequalR
   | Bool
otherwise = String -> TextureCompareOperator
forall a. HasCallStack => String -> a
error (String
"unmarshalTextureCompareOperator: illegal value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
x)

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

textureCompareOperator :: ParameterizedTextureTarget t => t -> StateVar (Maybe TextureCompareOperator)
textureCompareOperator :: forall t.
ParameterizedTextureTarget t =>
t -> StateVar (Maybe TextureCompareOperator)
textureCompareOperator =
   (t -> StateVar Capability)
-> (t -> StateVar TextureCompareOperator)
-> t
-> StateVar (Maybe TextureCompareOperator)
forall t a.
(t -> StateVar Capability)
-> (t -> StateVar a) -> t -> StateVar (Maybe a)
combineTexParamsMaybe
      ((GLint -> Capability)
-> (Capability -> GLint)
-> TexParameter
-> t
-> StateVar Capability
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami (GLboolean -> Capability
unmarshalCapability (GLboolean -> Capability)
-> (GLint -> GLboolean) -> GLint -> Capability
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLboolean
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (GLboolean -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral(GLboolean -> GLint)
-> (Capability -> GLboolean) -> Capability -> GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capability -> GLboolean
marshalCapability) TexParameter
TextureCompare)
      ((GLint -> TextureCompareOperator)
-> (TextureCompareOperator -> GLint)
-> TexParameter
-> t
-> StateVar TextureCompareOperator
forall t a.
ParameterizedTextureTarget t =>
(GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a
texParami (GLenum -> TextureCompareOperator
unmarshalTextureCompareOperator (GLenum -> TextureCompareOperator)
-> (GLint -> GLenum) -> GLint -> TextureCompareOperator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLint -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (GLenum -> GLint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> GLint)
-> (TextureCompareOperator -> GLenum)
-> TextureCompareOperator
-> GLint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureCompareOperator -> GLenum
marshalTextureCompareOperator) TexParameter
TextureCompareOperator)

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

combineTexParams :: (t -> StateVar a)
                 -> (t -> StateVar b)
                 -> (t -> StateVar (a,b))
combineTexParams :: forall t a b.
(t -> StateVar a) -> (t -> StateVar b) -> t -> StateVar (a, b)
combineTexParams t -> StateVar a
v t -> StateVar b
w t
t =
   IO (a, b) -> ((a, b) -> IO ()) -> StateVar (a, b)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      ((a -> b -> (a, b)) -> IO a -> IO b -> IO (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (StateVar a -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *). MonadIO m => StateVar a -> m a
get (t -> StateVar a
v t
t)) (StateVar b -> IO b
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *). MonadIO m => StateVar b -> m b
get (t -> StateVar b
w t
t)))
      (\(a
x,b
y) -> do t -> StateVar a
v t
t StateVar a -> a -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar a -> a -> m ()
$= a
x; t -> StateVar b
w t
t StateVar b -> b -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar b -> b -> m ()
$= b
y)

combineTexParamsMaybe :: (t -> StateVar Capability)
                      -> (t -> StateVar a)
                      -> (t -> StateVar (Maybe a))
combineTexParamsMaybe :: forall t a.
(t -> StateVar Capability)
-> (t -> StateVar a) -> t -> StateVar (Maybe a)
combineTexParamsMaybe t -> StateVar Capability
enab t -> StateVar a
val t
t =
   IO (Maybe a) -> (Maybe a -> IO ()) -> StateVar (Maybe a)
forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (do Capability
tcm <- StateVar Capability -> IO Capability
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> m Capability
get (t -> StateVar Capability
enab t
t)
          case Capability
tcm of
             Capability
Disabled -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
             Capability
Enabled -> (a -> Maybe a) -> IO a -> IO (Maybe a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (IO a -> IO (Maybe a)) -> IO a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ StateVar a -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *). MonadIO m => StateVar a -> m a
get (t -> StateVar a
val t
t))
      (IO () -> (a -> IO ()) -> Maybe a -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (t -> StateVar Capability
enab t
t StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Disabled)
             (\a
tcf -> do t -> StateVar a
val t
t StateVar a -> a -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *). MonadIO m => StateVar a -> a -> m ()
$= a
tcf
                         t -> StateVar Capability
enab t
t StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar Capability -> Capability -> m ()
$= Capability
Enabled))