--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Environments
-- 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.13 (Texture Environments and Texture
-- Functions) of the OpenGL 2.1 specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.Texturing.Environments (
   TextureFunction(..), textureFunction,
   TextureCombineFunction(..), combineRGB, combineAlpha,
   ArgNum(..), Arg(..), Src(..), argRGB, argAlpha,
   rgbScale, alphaScale,
   constantColor, textureUnitLODBias
) where

import Control.Monad
import Data.StateVar
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.BlendingFactor
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters
import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.GL

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

data TextureEnvTarget =
     TextureEnv
   | TextureFilterControl   -- GL_TEXTURE_LOD_BIAS_EXT
   | PointSprite            -- GL_COORD_REPLACE_NV

marshalTextureEnvTarget :: TextureEnvTarget -> GLenum
marshalTextureEnvTarget :: TextureEnvTarget -> GLenum
marshalTextureEnvTarget TextureEnvTarget
x = case TextureEnvTarget
x of
   TextureEnvTarget
TextureEnv -> GLenum
GL_TEXTURE_ENV
   TextureEnvTarget
TextureFilterControl -> GLenum
GL_TEXTURE_FILTER_CONTROL
   TextureEnvTarget
PointSprite -> GLenum
GL_POINT_SPRITE

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

data TextureEnvParameter =
     TexEnvParamTextureEnvMode
   | TexEnvParamTextureEnvColor
   | TexEnvParamCombineRGB
   | TexEnvParamCombineAlpha
   | TexEnvParamSrc0RGB
   | TexEnvParamSrc1RGB
   | TexEnvParamSrc2RGB
   | TexEnvParamSrc3RGB
   | TexEnvParamSrc0Alpha
   | TexEnvParamSrc1Alpha
   | TexEnvParamSrc2Alpha
   | TexEnvParamSrc3Alpha
   | TexEnvParamOperand0RGB
   | TexEnvParamOperand1RGB
   | TexEnvParamOperand2RGB
   | TexEnvParamOperand3RGB
   | TexEnvParamOperand0Alpha
   | TexEnvParamOperand1Alpha
   | TexEnvParamOperand2Alpha
   | TexEnvParamOperand3Alpha
   | TexEnvParamRGBScale
   | TexEnvParamAlphaScale
   | TexEnvParamLODBias

marshalTextureEnvParameter :: TextureEnvParameter -> GLenum
marshalTextureEnvParameter :: TextureEnvParameter -> GLenum
marshalTextureEnvParameter TextureEnvParameter
x = case TextureEnvParameter
x of
   TextureEnvParameter
TexEnvParamTextureEnvMode -> GLenum
GL_TEXTURE_ENV_MODE
   TextureEnvParameter
TexEnvParamTextureEnvColor -> GLenum
GL_TEXTURE_ENV_COLOR
   TextureEnvParameter
TexEnvParamCombineRGB -> GLenum
GL_COMBINE_RGB
   TextureEnvParameter
TexEnvParamCombineAlpha -> GLenum
GL_COMBINE_ALPHA
   TextureEnvParameter
TexEnvParamSrc0RGB -> GLenum
GL_SRC0_RGB
   TextureEnvParameter
TexEnvParamSrc1RGB -> GLenum
GL_SRC1_RGB
   TextureEnvParameter
TexEnvParamSrc2RGB -> GLenum
GL_SRC2_RGB
   TextureEnvParameter
TexEnvParamSrc3RGB -> GLenum
GL_SOURCE3_RGB_NV
   TextureEnvParameter
TexEnvParamSrc0Alpha -> GLenum
GL_SRC0_ALPHA
   TextureEnvParameter
TexEnvParamSrc1Alpha -> GLenum
GL_SRC1_ALPHA
   TextureEnvParameter
TexEnvParamSrc2Alpha -> GLenum
GL_SRC2_ALPHA
   TextureEnvParameter
TexEnvParamSrc3Alpha -> GLenum
GL_SOURCE3_ALPHA_NV
   TextureEnvParameter
TexEnvParamOperand0RGB -> GLenum
GL_OPERAND0_RGB
   TextureEnvParameter
TexEnvParamOperand1RGB -> GLenum
GL_OPERAND1_RGB
   TextureEnvParameter
TexEnvParamOperand2RGB -> GLenum
GL_OPERAND2_RGB
   TextureEnvParameter
TexEnvParamOperand3RGB -> GLenum
GL_OPERAND3_RGB_NV
   TextureEnvParameter
TexEnvParamOperand0Alpha -> GLenum
GL_OPERAND0_ALPHA
   TextureEnvParameter
TexEnvParamOperand1Alpha -> GLenum
GL_OPERAND1_ALPHA
   TextureEnvParameter
TexEnvParamOperand2Alpha -> GLenum
GL_OPERAND2_ALPHA
   TextureEnvParameter
TexEnvParamOperand3Alpha -> GLenum
GL_OPERAND3_ALPHA_NV
   TextureEnvParameter
TexEnvParamRGBScale -> GLenum
GL_RGB_SCALE
   TextureEnvParameter
TexEnvParamAlphaScale -> GLenum
GL_ALPHA_SCALE
   TextureEnvParameter
TexEnvParamLODBias -> GLenum
GL_TEXTURE_LOD_BIAS

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

texEnv :: (GLenum -> GLenum -> b -> IO ())
       -> (a -> (b -> IO ()) -> IO ())
       -> TextureEnvTarget -> TextureEnvParameter -> a -> IO ()
texEnv :: forall b a.
(GLenum -> GLenum -> b -> IO ())
-> (a -> (b -> IO ()) -> IO ())
-> TextureEnvTarget
-> TextureEnvParameter
-> a
-> IO ()
texEnv GLenum -> GLenum -> b -> IO ()
glTexEnv a -> (b -> IO ()) -> IO ()
marshalAct TextureEnvTarget
t TextureEnvParameter
p a
x =
   a -> (b -> IO ()) -> IO ()
marshalAct a
x forall a b. (a -> b) -> a -> b
$
      GLenum -> GLenum -> b -> IO ()
glTexEnv (TextureEnvTarget -> GLenum
marshalTextureEnvTarget TextureEnvTarget
t) (TextureEnvParameter -> GLenum
marshalTextureEnvParameter TextureEnvParameter
p)

glTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glTexEnvC4f GLenum
t GLenum
p Ptr (Color4 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glTexEnvfv GLenum
t GLenum
p (forall a b. Ptr a -> Ptr b
castPtr Ptr (Color4 GLfloat)
ptr)


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

getTexEnv :: Storable b
          => (GLenum -> GLenum -> Ptr b -> IO ())
          -> (b -> a)
          -> TextureEnvTarget -> TextureEnvParameter -> IO a
getTexEnv :: forall b a.
Storable b =>
(GLenum -> GLenum -> Ptr b -> IO ())
-> (b -> a) -> TextureEnvTarget -> TextureEnvParameter -> IO a
getTexEnv GLenum -> GLenum -> Ptr b -> IO ()
glGetTexEnv b -> a
unmarshal TextureEnvTarget
t TextureEnvParameter
p =
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr b
buf -> do
     GLenum -> GLenum -> Ptr b -> IO ()
glGetTexEnv (TextureEnvTarget -> GLenum
marshalTextureEnvTarget TextureEnvTarget
t) (TextureEnvParameter -> GLenum
marshalTextureEnvParameter TextureEnvParameter
p) Ptr b
buf
     forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 b -> a
unmarshal Ptr b
buf

glGetTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetTexEnvC4f GLenum
t GLenum
p Ptr (Color4 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetTexEnvfv GLenum
t GLenum
p (forall a b. Ptr a -> Ptr b
castPtr Ptr (Color4 GLfloat)
ptr)

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

m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()
m2a :: forall a b. (a -> b) -> a -> (b -> IO ()) -> IO ()
m2a a -> b
marshal a
x b -> IO ()
act = b -> IO ()
act (a -> b
marshal a
x)

texEnvi ::
   (GLint -> a) -> (a -> GLint) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a
texEnvi :: forall a.
(GLint -> a)
-> (a -> GLint)
-> TextureEnvTarget
-> TextureEnvParameter
-> StateVar a
texEnvi GLint -> a
unmarshal a -> GLint
marshal TextureEnvTarget
t TextureEnvParameter
p =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall b a.
Storable b =>
(GLenum -> GLenum -> Ptr b -> IO ())
-> (b -> a) -> TextureEnvTarget -> TextureEnvParameter -> IO a
getTexEnv forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glGetTexEnviv GLint -> a
unmarshal     TextureEnvTarget
t TextureEnvParameter
p)
      (forall b a.
(GLenum -> GLenum -> b -> IO ())
-> (a -> (b -> IO ()) -> IO ())
-> TextureEnvTarget
-> TextureEnvParameter
-> a
-> IO ()
texEnv    forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> m ()
glTexEnvi     (forall a b. (a -> b) -> a -> (b -> IO ()) -> IO ()
m2a a -> GLint
marshal) TextureEnvTarget
t TextureEnvParameter
p)

texEnvf ::
   (GLfloat -> a) -> (a -> GLfloat) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a
texEnvf :: forall a.
(GLfloat -> a)
-> (a -> GLfloat)
-> TextureEnvTarget
-> TextureEnvParameter
-> StateVar a
texEnvf GLfloat -> a
unmarshal a -> GLfloat
marshal TextureEnvTarget
t TextureEnvParameter
p =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall b a.
Storable b =>
(GLenum -> GLenum -> Ptr b -> IO ())
-> (b -> a) -> TextureEnvTarget -> TextureEnvParameter -> IO a
getTexEnv forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetTexEnvfv GLfloat -> a
unmarshal     TextureEnvTarget
t TextureEnvParameter
p)
      (forall b a.
(GLenum -> GLenum -> b -> IO ())
-> (a -> (b -> IO ()) -> IO ())
-> TextureEnvTarget
-> TextureEnvParameter
-> a
-> IO ()
texEnv    forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLfloat -> m ()
glTexEnvf     (forall a b. (a -> b) -> a -> (b -> IO ()) -> IO ()
m2a a -> GLfloat
marshal) TextureEnvTarget
t TextureEnvParameter
p)

texEnvC4f :: TextureEnvTarget -> TextureEnvParameter -> StateVar (Color4 GLfloat)
texEnvC4f :: TextureEnvTarget
-> TextureEnvParameter -> StateVar (Color4 GLfloat)
texEnvC4f TextureEnvTarget
t TextureEnvParameter
p =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall b a.
Storable b =>
(GLenum -> GLenum -> Ptr b -> IO ())
-> (b -> a) -> TextureEnvTarget -> TextureEnvParameter -> IO a
getTexEnv GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetTexEnvC4f forall a. a -> a
id   TextureEnvTarget
t TextureEnvParameter
p)
      (forall b a.
(GLenum -> GLenum -> b -> IO ())
-> (a -> (b -> IO ()) -> IO ())
-> TextureEnvTarget
-> TextureEnvParameter
-> a
-> IO ()
texEnv    GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glTexEnvC4f    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TextureEnvTarget
t TextureEnvParameter
p)

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

data TextureFunction =
     Modulate
   | Decal
   | Blend
   | Replace
   | AddUnsigned
   | Combine
   | Combine4
   deriving ( TextureFunction -> TextureFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureFunction -> TextureFunction -> Bool
$c/= :: TextureFunction -> TextureFunction -> Bool
== :: TextureFunction -> TextureFunction -> Bool
$c== :: TextureFunction -> TextureFunction -> Bool
Eq, Eq TextureFunction
TextureFunction -> TextureFunction -> Bool
TextureFunction -> TextureFunction -> Ordering
TextureFunction -> TextureFunction -> TextureFunction
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
min :: TextureFunction -> TextureFunction -> TextureFunction
$cmin :: TextureFunction -> TextureFunction -> TextureFunction
max :: TextureFunction -> TextureFunction -> TextureFunction
$cmax :: TextureFunction -> TextureFunction -> TextureFunction
>= :: TextureFunction -> TextureFunction -> Bool
$c>= :: TextureFunction -> TextureFunction -> Bool
> :: TextureFunction -> TextureFunction -> Bool
$c> :: TextureFunction -> TextureFunction -> Bool
<= :: TextureFunction -> TextureFunction -> Bool
$c<= :: TextureFunction -> TextureFunction -> Bool
< :: TextureFunction -> TextureFunction -> Bool
$c< :: TextureFunction -> TextureFunction -> Bool
compare :: TextureFunction -> TextureFunction -> Ordering
$ccompare :: TextureFunction -> TextureFunction -> Ordering
Ord, Int -> TextureFunction -> ShowS
[TextureFunction] -> ShowS
TextureFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureFunction] -> ShowS
$cshowList :: [TextureFunction] -> ShowS
show :: TextureFunction -> String
$cshow :: TextureFunction -> String
showsPrec :: Int -> TextureFunction -> ShowS
$cshowsPrec :: Int -> TextureFunction -> ShowS
Show )

marshalTextureFunction :: TextureFunction -> GLint
marshalTextureFunction :: TextureFunction -> GLint
marshalTextureFunction TextureFunction
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ case TextureFunction
x of
   TextureFunction
Modulate -> GLenum
GL_MODULATE
   TextureFunction
Decal -> GLenum
GL_DECAL
   TextureFunction
Blend -> GLenum
GL_BLEND
   TextureFunction
Replace -> GLenum
GL_REPLACE
   TextureFunction
AddUnsigned -> GLenum
GL_ADD
   TextureFunction
Combine -> GLenum
GL_COMBINE
   TextureFunction
Combine4 -> GLenum
GL_COMBINE4_NV

unmarshalTextureFunction :: GLint -> TextureFunction
unmarshalTextureFunction :: GLint -> TextureFunction
unmarshalTextureFunction GLint
x
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_MODULATE = TextureFunction
Modulate
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_DECAL = TextureFunction
Decal
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_BLEND = TextureFunction
Blend
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_REPLACE = TextureFunction
Replace
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_ADD = TextureFunction
AddUnsigned
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMBINE = TextureFunction
Combine
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_COMBINE4_NV = TextureFunction
Combine4
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalTextureFunction: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLint
x)
   where y :: GLenum
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
x

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

textureFunction :: StateVar TextureFunction
textureFunction :: StateVar TextureFunction
textureFunction =
   forall a.
(GLint -> a)
-> (a -> GLint)
-> TextureEnvTarget
-> TextureEnvParameter
-> StateVar a
texEnvi GLint -> TextureFunction
unmarshalTextureFunction TextureFunction -> GLint
marshalTextureFunction TextureEnvTarget
TextureEnv TextureEnvParameter
TexEnvParamTextureEnvMode

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

data TextureCombineFunction =
     Replace'
   | Modulate'
   | AddUnsigned'
   | AddSigned
   | Interpolate
   | Subtract
   | Dot3RGB
   | Dot3RGBA
   deriving ( TextureCombineFunction -> TextureCombineFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureCombineFunction -> TextureCombineFunction -> Bool
$c/= :: TextureCombineFunction -> TextureCombineFunction -> Bool
== :: TextureCombineFunction -> TextureCombineFunction -> Bool
$c== :: TextureCombineFunction -> TextureCombineFunction -> Bool
Eq, Eq TextureCombineFunction
TextureCombineFunction -> TextureCombineFunction -> Bool
TextureCombineFunction -> TextureCombineFunction -> Ordering
TextureCombineFunction
-> TextureCombineFunction -> TextureCombineFunction
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
min :: TextureCombineFunction
-> TextureCombineFunction -> TextureCombineFunction
$cmin :: TextureCombineFunction
-> TextureCombineFunction -> TextureCombineFunction
max :: TextureCombineFunction
-> TextureCombineFunction -> TextureCombineFunction
$cmax :: TextureCombineFunction
-> TextureCombineFunction -> TextureCombineFunction
>= :: TextureCombineFunction -> TextureCombineFunction -> Bool
$c>= :: TextureCombineFunction -> TextureCombineFunction -> Bool
> :: TextureCombineFunction -> TextureCombineFunction -> Bool
$c> :: TextureCombineFunction -> TextureCombineFunction -> Bool
<= :: TextureCombineFunction -> TextureCombineFunction -> Bool
$c<= :: TextureCombineFunction -> TextureCombineFunction -> Bool
< :: TextureCombineFunction -> TextureCombineFunction -> Bool
$c< :: TextureCombineFunction -> TextureCombineFunction -> Bool
compare :: TextureCombineFunction -> TextureCombineFunction -> Ordering
$ccompare :: TextureCombineFunction -> TextureCombineFunction -> Ordering
Ord, Int -> TextureCombineFunction -> ShowS
[TextureCombineFunction] -> ShowS
TextureCombineFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureCombineFunction] -> ShowS
$cshowList :: [TextureCombineFunction] -> ShowS
show :: TextureCombineFunction -> String
$cshow :: TextureCombineFunction -> String
showsPrec :: Int -> TextureCombineFunction -> ShowS
$cshowsPrec :: Int -> TextureCombineFunction -> ShowS
Show )

marshalTextureCombineFunction :: TextureCombineFunction -> GLint
marshalTextureCombineFunction :: TextureCombineFunction -> GLint
marshalTextureCombineFunction TextureCombineFunction
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ case TextureCombineFunction
x of
   TextureCombineFunction
Replace' -> GLenum
GL_REPLACE
   TextureCombineFunction
Modulate' -> GLenum
GL_MODULATE
   TextureCombineFunction
AddUnsigned' -> GLenum
GL_ADD
   TextureCombineFunction
AddSigned -> GLenum
GL_ADD_SIGNED
   TextureCombineFunction
Interpolate -> GLenum
GL_INTERPOLATE
   TextureCombineFunction
Subtract -> GLenum
GL_SUBTRACT
   TextureCombineFunction
Dot3RGB -> GLenum
GL_DOT3_RGB
   TextureCombineFunction
Dot3RGBA -> GLenum
GL_DOT3_RGBA

unmarshalTextureCombineFunction :: GLint -> TextureCombineFunction
unmarshalTextureCombineFunction :: GLint -> TextureCombineFunction
unmarshalTextureCombineFunction GLint
x
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_REPLACE = TextureCombineFunction
Replace'
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_MODULATE = TextureCombineFunction
Modulate'
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_ADD = TextureCombineFunction
AddUnsigned'
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_ADD_SIGNED = TextureCombineFunction
AddSigned
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_INTERPOLATE = TextureCombineFunction
Interpolate
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_SUBTRACT = TextureCombineFunction
Subtract
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_DOT3_RGB = TextureCombineFunction
Dot3RGB
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_DOT3_RGBA = TextureCombineFunction
Dot3RGBA
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalTextureCombineFunction: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLint
x)
   where y :: GLenum
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
x

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

combineRGB :: StateVar TextureCombineFunction
combineRGB :: StateVar TextureCombineFunction
combineRGB = TextureEnvParameter -> StateVar TextureCombineFunction
combine TextureEnvParameter
TexEnvParamCombineRGB

combineAlpha :: StateVar TextureCombineFunction
combineAlpha :: StateVar TextureCombineFunction
combineAlpha = TextureEnvParameter -> StateVar TextureCombineFunction
combine TextureEnvParameter
TexEnvParamCombineAlpha

combine :: TextureEnvParameter -> StateVar TextureCombineFunction
combine :: TextureEnvParameter -> StateVar TextureCombineFunction
combine =
   forall a.
(GLint -> a)
-> (a -> GLint)
-> TextureEnvTarget
-> TextureEnvParameter
-> StateVar a
texEnvi GLint -> TextureCombineFunction
unmarshalTextureCombineFunction TextureCombineFunction -> GLint
marshalTextureCombineFunction TextureEnvTarget
TextureEnv

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

data ArgNum =
     Arg0
   | Arg1
   | Arg2
   | Arg3
   deriving ( ArgNum -> ArgNum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgNum -> ArgNum -> Bool
$c/= :: ArgNum -> ArgNum -> Bool
== :: ArgNum -> ArgNum -> Bool
$c== :: ArgNum -> ArgNum -> Bool
Eq, Eq ArgNum
ArgNum -> ArgNum -> Bool
ArgNum -> ArgNum -> Ordering
ArgNum -> ArgNum -> ArgNum
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
min :: ArgNum -> ArgNum -> ArgNum
$cmin :: ArgNum -> ArgNum -> ArgNum
max :: ArgNum -> ArgNum -> ArgNum
$cmax :: ArgNum -> ArgNum -> ArgNum
>= :: ArgNum -> ArgNum -> Bool
$c>= :: ArgNum -> ArgNum -> Bool
> :: ArgNum -> ArgNum -> Bool
$c> :: ArgNum -> ArgNum -> Bool
<= :: ArgNum -> ArgNum -> Bool
$c<= :: ArgNum -> ArgNum -> Bool
< :: ArgNum -> ArgNum -> Bool
$c< :: ArgNum -> ArgNum -> Bool
compare :: ArgNum -> ArgNum -> Ordering
$ccompare :: ArgNum -> ArgNum -> Ordering
Ord, Int -> ArgNum -> ShowS
[ArgNum] -> ShowS
ArgNum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgNum] -> ShowS
$cshowList :: [ArgNum] -> ShowS
show :: ArgNum -> String
$cshow :: ArgNum -> String
showsPrec :: Int -> ArgNum -> ShowS
$cshowsPrec :: Int -> ArgNum -> ShowS
Show )

argNumToOperandRGB :: ArgNum -> TextureEnvParameter
argNumToOperandRGB :: ArgNum -> TextureEnvParameter
argNumToOperandRGB ArgNum
x = case ArgNum
x of
   ArgNum
Arg0 -> TextureEnvParameter
TexEnvParamOperand0RGB
   ArgNum
Arg1 -> TextureEnvParameter
TexEnvParamOperand1RGB
   ArgNum
Arg2 -> TextureEnvParameter
TexEnvParamOperand2RGB
   ArgNum
Arg3 -> TextureEnvParameter
TexEnvParamOperand3RGB

argNumToOperandAlpha :: ArgNum -> TextureEnvParameter
argNumToOperandAlpha :: ArgNum -> TextureEnvParameter
argNumToOperandAlpha ArgNum
x = case ArgNum
x of
   ArgNum
Arg0 -> TextureEnvParameter
TexEnvParamOperand0Alpha
   ArgNum
Arg1 -> TextureEnvParameter
TexEnvParamOperand1Alpha
   ArgNum
Arg2 -> TextureEnvParameter
TexEnvParamOperand2Alpha
   ArgNum
Arg3 -> TextureEnvParameter
TexEnvParamOperand3Alpha

argNumToSrcRGB :: ArgNum -> TextureEnvParameter
argNumToSrcRGB :: ArgNum -> TextureEnvParameter
argNumToSrcRGB ArgNum
x = case ArgNum
x of
   ArgNum
Arg0 -> TextureEnvParameter
TexEnvParamSrc0RGB
   ArgNum
Arg1 -> TextureEnvParameter
TexEnvParamSrc1RGB
   ArgNum
Arg2 -> TextureEnvParameter
TexEnvParamSrc2RGB
   ArgNum
Arg3 -> TextureEnvParameter
TexEnvParamSrc3RGB

argNumToSrcAlpha :: ArgNum -> TextureEnvParameter
argNumToSrcAlpha :: ArgNum -> TextureEnvParameter
argNumToSrcAlpha ArgNum
x = case ArgNum
x of
   ArgNum
Arg0 -> TextureEnvParameter
TexEnvParamSrc0Alpha
   ArgNum
Arg1 -> TextureEnvParameter
TexEnvParamSrc1Alpha
   ArgNum
Arg2 -> TextureEnvParameter
TexEnvParamSrc2Alpha
   ArgNum
Arg3 -> TextureEnvParameter
TexEnvParamSrc3Alpha

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

data Arg = Arg BlendingFactor Src
   deriving ( Arg -> Arg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arg -> Arg -> Bool
$c/= :: Arg -> Arg -> Bool
== :: Arg -> Arg -> Bool
$c== :: Arg -> Arg -> Bool
Eq, Eq Arg
Arg -> Arg -> Bool
Arg -> Arg -> Ordering
Arg -> Arg -> Arg
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
min :: Arg -> Arg -> Arg
$cmin :: Arg -> Arg -> Arg
max :: Arg -> Arg -> Arg
$cmax :: Arg -> Arg -> Arg
>= :: Arg -> Arg -> Bool
$c>= :: Arg -> Arg -> Bool
> :: Arg -> Arg -> Bool
$c> :: Arg -> Arg -> Bool
<= :: Arg -> Arg -> Bool
$c<= :: Arg -> Arg -> Bool
< :: Arg -> Arg -> Bool
$c< :: Arg -> Arg -> Bool
compare :: Arg -> Arg -> Ordering
$ccompare :: Arg -> Arg -> Ordering
Ord, Int -> Arg -> ShowS
[Arg] -> ShowS
Arg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arg] -> ShowS
$cshowList :: [Arg] -> ShowS
show :: Arg -> String
$cshow :: Arg -> String
showsPrec :: Int -> Arg -> ShowS
$cshowsPrec :: Int -> Arg -> ShowS
Show )

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

data Src =
     CurrentUnit
   | Previous
   | Crossbar TextureUnit
   | Constant
   | PrimaryColor
   deriving ( Src -> Src -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Src -> Src -> Bool
$c/= :: Src -> Src -> Bool
== :: Src -> Src -> Bool
$c== :: Src -> Src -> Bool
Eq, Eq Src
Src -> Src -> Bool
Src -> Src -> Ordering
Src -> Src -> Src
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
min :: Src -> Src -> Src
$cmin :: Src -> Src -> Src
max :: Src -> Src -> Src
$cmax :: Src -> Src -> Src
>= :: Src -> Src -> Bool
$c>= :: Src -> Src -> Bool
> :: Src -> Src -> Bool
$c> :: Src -> Src -> Bool
<= :: Src -> Src -> Bool
$c<= :: Src -> Src -> Bool
< :: Src -> Src -> Bool
$c< :: Src -> Src -> Bool
compare :: Src -> Src -> Ordering
$ccompare :: Src -> Src -> Ordering
Ord, Int -> Src -> ShowS
[Src] -> ShowS
Src -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Src] -> ShowS
$cshowList :: [Src] -> ShowS
show :: Src -> String
$cshow :: Src -> String
showsPrec :: Int -> Src -> ShowS
$cshowsPrec :: Int -> Src -> ShowS
Show )

marshalSrc :: Src -> GLint
marshalSrc :: Src -> GLint
marshalSrc Src
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ case Src
x of
   Src
CurrentUnit -> GLenum
GL_TEXTURE
   Src
Previous -> GLenum
GL_PREVIOUS
   Crossbar TextureUnit
u -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (TextureUnit -> GLenum
marshalTextureUnit TextureUnit
u)
   Src
Constant -> GLenum
GL_CONSTANT
   Src
PrimaryColor -> GLenum
GL_PRIMARY_COLOR

unmarshalSrc :: GLint -> Src
unmarshalSrc :: GLint -> Src
unmarshalSrc GLint
x
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_TEXTURE = Src
CurrentUnit
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_PREVIOUS = Src
Previous
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_CONSTANT = Src
Constant
   | GLenum
y forall a. Eq a => a -> a -> Bool
== GLenum
GL_PRIMARY_COLOR = Src
PrimaryColor
   | Bool
otherwise = TextureUnit -> Src
Crossbar (GLenum -> TextureUnit
unmarshalTextureUnit (forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
x))
   where y :: GLenum
y = forall a b. (Integral a, Num b) => a -> b
fromIntegral GLint
x

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

argRGB :: ArgNum -> StateVar Arg
argRGB :: ArgNum -> StateVar Arg
argRGB ArgNum
n = TextureEnvParameter -> TextureEnvParameter -> StateVar Arg
arg (ArgNum -> TextureEnvParameter
argNumToOperandRGB ArgNum
n) (ArgNum -> TextureEnvParameter
argNumToSrcRGB ArgNum
n)

argAlpha :: ArgNum -> StateVar Arg
argAlpha :: ArgNum -> StateVar Arg
argAlpha ArgNum
n = TextureEnvParameter -> TextureEnvParameter -> StateVar Arg
arg (ArgNum -> TextureEnvParameter
argNumToOperandAlpha ArgNum
n) (ArgNum -> TextureEnvParameter
argNumToSrcAlpha ArgNum
n)

arg :: TextureEnvParameter -> TextureEnvParameter -> StateVar Arg
arg :: TextureEnvParameter -> TextureEnvParameter -> StateVar Arg
arg TextureEnvParameter
op TextureEnvParameter
src = StateVar BlendingFactor -> StateVar Src -> StateVar Arg
combineArg (TextureEnvParameter -> StateVar BlendingFactor
textureEnvOperand TextureEnvParameter
op) (TextureEnvParameter -> StateVar Src
textureEnvSrc TextureEnvParameter
src)
   where combineArg :: StateVar BlendingFactor -> StateVar Src -> StateVar Arg
         combineArg :: StateVar BlendingFactor -> StateVar Src -> StateVar Arg
combineArg StateVar BlendingFactor
v StateVar Src
w = forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
                             (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 BlendingFactor -> Src -> Arg
Arg (forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get StateVar BlendingFactor
v) (forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get StateVar Src
w))
                             (\(Arg BlendingFactor
x Src
y) -> do StateVar BlendingFactor
v forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= BlendingFactor
x; StateVar Src
w forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Src
y)

textureEnvOperand :: TextureEnvParameter -> StateVar BlendingFactor
textureEnvOperand :: TextureEnvParameter -> StateVar BlendingFactor
textureEnvOperand =
   forall a.
(GLint -> a)
-> (a -> GLint)
-> TextureEnvTarget
-> TextureEnvParameter
-> StateVar a
texEnvi (GLenum -> BlendingFactor
unmarshalBlendingFactor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlendingFactor -> GLenum
marshalBlendingFactor) TextureEnvTarget
TextureEnv

textureEnvSrc :: TextureEnvParameter -> StateVar Src
textureEnvSrc :: TextureEnvParameter -> StateVar Src
textureEnvSrc = forall a.
(GLint -> a)
-> (a -> GLint)
-> TextureEnvTarget
-> TextureEnvParameter
-> StateVar a
texEnvi GLint -> Src
unmarshalSrc Src -> GLint
marshalSrc TextureEnvTarget
TextureEnv

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

rgbScale :: StateVar GLfloat
rgbScale :: StateVar GLfloat
rgbScale = TextureEnvParameter -> StateVar GLfloat
scale TextureEnvParameter
TexEnvParamRGBScale

alphaScale :: StateVar GLfloat
alphaScale :: StateVar GLfloat
alphaScale = TextureEnvParameter -> StateVar GLfloat
scale TextureEnvParameter
TexEnvParamAlphaScale

scale :: TextureEnvParameter -> StateVar GLfloat
scale :: TextureEnvParameter -> StateVar GLfloat
scale = forall a.
(GLfloat -> a)
-> (a -> GLfloat)
-> TextureEnvTarget
-> TextureEnvParameter
-> StateVar a
texEnvf forall a. a -> a
id forall a. a -> a
id TextureEnvTarget
TextureEnv

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

constantColor :: StateVar (Color4 GLfloat)
constantColor :: StateVar (Color4 GLfloat)
constantColor = TextureEnvTarget
-> TextureEnvParameter -> StateVar (Color4 GLfloat)
texEnvC4f TextureEnvTarget
TextureEnv TextureEnvParameter
TexEnvParamTextureEnvColor

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

textureUnitLODBias :: StateVar LOD
textureUnitLODBias :: StateVar GLfloat
textureUnitLODBias = forall a.
(GLfloat -> a)
-> (a -> GLfloat)
-> TextureEnvTarget
-> TextureEnvParameter
-> StateVar a
texEnvf forall a. a -> a
id forall a. a -> a
id TextureEnvTarget
TextureFilterControl TextureEnvParameter
TexEnvParamLODBias