--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.Colors
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 2.14 (Colors and Coloring) of the
-- OpenGL 2.1 specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.Colors (
   -- * Lighting
   lighting, Light(..), light, maxLights,
   FrontFaceDirection(..), frontFace,

   -- * Lighting Parameter Specification
   Face(..),
   materialAmbient, materialDiffuse, materialAmbientAndDiffuse,
   materialSpecular, materialEmission, materialShininess, maxShininess,
   materialColorIndexes,

   ambient, diffuse, specular,
   position, spotDirection, spotExponent, maxSpotExponent, spotCutoff,
   attenuation,

   lightModelAmbient, lightModelLocalViewer, lightModelTwoSide,
   vertexProgramTwoSide,
   LightModelColorControl(..), lightModelColorControl,

   -- * ColorMaterial
   ColorMaterialParameter(..), colorMaterial,

   -- * Flatshading
   ShadingModel(..), shadeModel,

   -- * Color clamping
   ClampTarget(..), ClampMode(..),
   clampColor,
) where

import Control.Monad
import Data.StateVar
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.Tensor
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.Face
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL

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

lighting :: StateVar Capability
lighting :: StateVar Capability
lighting = EnableCap -> StateVar Capability
makeCapability EnableCap
CapLighting

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

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

marshalLight :: Light -> Maybe GLenum
marshalLight :: Light -> Maybe GLenum
marshalLight (Light GLint
l) = GLint -> Maybe GLenum
lightIndexToEnum GLint
l

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

light :: Light -> StateVar Capability
light :: Light -> StateVar Capability
light (Light GLint
l) = EnableCap -> StateVar Capability
makeCapability (GLint -> EnableCap
CapLight GLint
l)

maxLights :: GettableStateVar GLsizei
maxLights :: GettableStateVar GLint
maxLights = forall a. IO a -> IO a
makeGettableStateVar (forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getSizei1 forall a. a -> a
id PName1I
GetMaxLights)

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

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

marshalFrontFaceDirection :: FrontFaceDirection -> GLenum
marshalFrontFaceDirection :: FrontFaceDirection -> GLenum
marshalFrontFaceDirection FrontFaceDirection
x = case FrontFaceDirection
x of
   FrontFaceDirection
CW -> GLenum
GL_CW
   FrontFaceDirection
CCW -> GLenum
GL_CCW

unmarshalFrontFaceDirection :: GLenum -> FrontFaceDirection
unmarshalFrontFaceDirection :: GLenum -> FrontFaceDirection
unmarshalFrontFaceDirection GLenum
x
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_CW = FrontFaceDirection
CW
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_CCW = FrontFaceDirection
CCW
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalFrontFaceDirection: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)

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

frontFace :: StateVar FrontFaceDirection
frontFace :: StateVar FrontFaceDirection
frontFace =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> FrontFaceDirection
unmarshalFrontFaceDirection PName1I
GetFrontFace)
      (forall (m :: * -> *). MonadIO m => GLenum -> m ()
glFrontFace forall b c a. (b -> c) -> (a -> b) -> a -> c
. FrontFaceDirection -> GLenum
marshalFrontFaceDirection)

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

data MaterialParameter =
     MaterialEmission
   | MaterialShininess
   | MaterialAmbientAndDiffuse
   | MaterialColorIndexes
   | MaterialAmbient
   | MaterialDiffuse
   | MaterialSpecular

marshalMaterialParameter :: MaterialParameter -> GLenum
marshalMaterialParameter :: MaterialParameter -> GLenum
marshalMaterialParameter MaterialParameter
x = case MaterialParameter
x of
   MaterialParameter
MaterialEmission -> GLenum
GL_EMISSION
   MaterialParameter
MaterialShininess -> GLenum
GL_SHININESS
   MaterialParameter
MaterialAmbientAndDiffuse -> GLenum
GL_AMBIENT_AND_DIFFUSE
   MaterialParameter
MaterialColorIndexes -> GLenum
GL_COLOR_INDEXES
   MaterialParameter
MaterialAmbient -> GLenum
GL_AMBIENT
   MaterialParameter
MaterialDiffuse -> GLenum
GL_DIFFUSE
   MaterialParameter
MaterialSpecular -> GLenum
GL_SPECULAR

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

materialAmbient :: Face -> StateVar (Color4 GLfloat)
materialAmbient :: Face -> StateVar (Color4 GLfloat)
materialAmbient =
   forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> MaterialParameter
-> Face
-> StateVar a
makeMaterialVar GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetMaterialfvc GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glMaterialfvc MaterialParameter
MaterialAmbient

materialDiffuse :: Face -> StateVar (Color4 GLfloat)
materialDiffuse :: Face -> StateVar (Color4 GLfloat)
materialDiffuse =
   forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> MaterialParameter
-> Face
-> StateVar a
makeMaterialVar GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetMaterialfvc GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glMaterialfvc MaterialParameter
MaterialDiffuse

materialAmbientAndDiffuse :: Face -> StateVar (Color4 GLfloat)
materialAmbientAndDiffuse :: Face -> StateVar (Color4 GLfloat)
materialAmbientAndDiffuse =
   forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> MaterialParameter
-> Face
-> StateVar a
makeMaterialVar GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetMaterialfvc GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glMaterialfvc MaterialParameter
MaterialAmbientAndDiffuse

materialSpecular :: Face -> StateVar (Color4 GLfloat)
materialSpecular :: Face -> StateVar (Color4 GLfloat)
materialSpecular =
   forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> MaterialParameter
-> Face
-> StateVar a
makeMaterialVar GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetMaterialfvc GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glMaterialfvc MaterialParameter
MaterialSpecular

materialEmission :: Face -> StateVar (Color4 GLfloat)
materialEmission :: Face -> StateVar (Color4 GLfloat)
materialEmission =
   forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> MaterialParameter
-> Face
-> StateVar a
makeMaterialVar GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetMaterialfvc GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glMaterialfvc MaterialParameter
MaterialEmission

makeMaterialVar :: Storable a
                => (GLenum -> GLenum -> Ptr a -> IO ())
                -> (GLenum -> GLenum -> Ptr a -> IO ())
                -> MaterialParameter -> Face -> StateVar a
makeMaterialVar :: forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> MaterialParameter
-> Face
-> StateVar a
makeMaterialVar GLenum -> GLenum -> Ptr a -> IO ()
getter GLenum -> GLenum -> Ptr a -> IO ()
setter MaterialParameter
materialParameter Face
face =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr a
buf -> do GLenum -> GLenum -> Ptr a -> IO ()
getter GLenum
f GLenum
mp Ptr a
buf ; forall a. Storable a => Ptr a -> IO a
peek Ptr a
buf)
                (\a
val -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
val forall a b. (a -> b) -> a -> b
$ GLenum -> GLenum -> Ptr a -> IO ()
setter GLenum
f GLenum
mp)
   where mp :: GLenum
mp = MaterialParameter -> GLenum
marshalMaterialParameter MaterialParameter
materialParameter
         f :: GLenum
f  = Face -> GLenum
marshalFace Face
face

glGetMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetMaterialfvc GLenum
face GLenum
pname Ptr (Color4 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetMaterialfv GLenum
face GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr (Color4 GLfloat)
ptr)

glMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glMaterialfvc GLenum
face GLenum
pname Ptr (Color4 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glMaterialfv GLenum
face GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr (Color4 GLfloat)
ptr)

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

materialShininess :: Face -> StateVar GLfloat
materialShininess :: Face -> StateVar GLfloat
materialShininess =
   forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> MaterialParameter
-> Face
-> StateVar a
makeMaterialVar GLenum -> GLenum -> Ptr GLfloat -> IO ()
glGetMaterialfvf GLenum -> GLenum -> Ptr GLfloat -> IO ()
glMaterialff MaterialParameter
MaterialShininess

glGetMaterialfvf :: GLenum -> GLenum -> Ptr GLfloat -> IO ()
glGetMaterialfvf :: GLenum -> GLenum -> Ptr GLfloat -> IO ()
glGetMaterialfvf GLenum
face GLenum
pname Ptr GLfloat
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetMaterialfv GLenum
face GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr GLfloat
ptr)

glMaterialff :: GLenum -> GLenum -> Ptr GLfloat -> IO ()
glMaterialff :: GLenum -> GLenum -> Ptr GLfloat -> IO ()
glMaterialff GLenum
face GLenum
pname Ptr GLfloat
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glMaterialfv GLenum
face GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr GLfloat
ptr)

maxShininess :: GettableStateVar GLfloat
maxShininess :: GettableStateVar GLfloat
maxShininess = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 forall a. a -> a
id PName1F
GetMaxShininess

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

-- Alas, (Index1 GLint, Index1 GLint, Index1 GLint) is not an instance of
-- Storable...

materialColorIndexes ::
   Face -> StateVar (Index1 GLint, Index1 GLint, Index1 GLint)
materialColorIndexes :: Face -> StateVar (Index1 GLint, Index1 GLint, Index1 GLint)
materialColorIndexes Face
face =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (Face -> IO (Index1 GLint, Index1 GLint, Index1 GLint)
getMaterialColorIndexes Face
face) (Face -> (Index1 GLint, Index1 GLint, Index1 GLint) -> IO ()
setMaterialColorIndexes Face
face)

getMaterialColorIndexes :: Face -> IO (Index1 GLint, Index1 GLint, Index1 GLint)
getMaterialColorIndexes :: Face -> IO (Index1 GLint, Index1 GLint, Index1 GLint)
getMaterialColorIndexes Face
face =
   forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
3 forall a b. (a -> b) -> a -> b
$ \Ptr GLint
buf -> do
      forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glGetMaterialiv (Face -> GLenum
marshalFace Face
face)
                      (MaterialParameter -> GLenum
marshalMaterialParameter MaterialParameter
MaterialColorIndexes)
                      Ptr GLint
buf
      forall a b. Storable a => (a -> a -> a -> b) -> Ptr a -> IO b
peek3 (\GLint
a GLint
d GLint
s -> (forall a. a -> Index1 a
Index1 GLint
a, forall a. a -> Index1 a
Index1 GLint
d, forall a. a -> Index1 a
Index1 GLint
s)) Ptr GLint
buf

setMaterialColorIndexes ::
   Face -> (Index1 GLint, Index1 GLint, Index1 GLint) -> IO ()
setMaterialColorIndexes :: Face -> (Index1 GLint, Index1 GLint, Index1 GLint) -> IO ()
setMaterialColorIndexes Face
face (Index1 GLint
a, Index1 GLint
d, Index1 GLint
s) =
   forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [GLint
a, GLint
d, GLint
s] forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLint -> m ()
glMaterialiv (Face -> GLenum
marshalFace Face
face)
                   (MaterialParameter -> GLenum
marshalMaterialParameter MaterialParameter
MaterialColorIndexes)

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

data LightParameter =
     Ambient'
   | Diffuse'
   | Specular'
   | Position
   | SpotDirection
   | SpotExponent
   | SpotCutoff
   | ConstantAttenuation
   | LinearAttenuation
   | QuadraticAttenuation

marshalLightParameter :: LightParameter -> GLenum
marshalLightParameter :: LightParameter -> GLenum
marshalLightParameter LightParameter
x = case LightParameter
x of
   LightParameter
Ambient' -> GLenum
GL_AMBIENT
   LightParameter
Diffuse' -> GLenum
GL_DIFFUSE
   LightParameter
Specular' -> GLenum
GL_SPECULAR
   LightParameter
Position -> GLenum
GL_POSITION
   LightParameter
SpotDirection -> GLenum
GL_SPOT_DIRECTION
   LightParameter
SpotExponent -> GLenum
GL_SPOT_EXPONENT
   LightParameter
SpotCutoff -> GLenum
GL_SPOT_CUTOFF
   LightParameter
ConstantAttenuation -> GLenum
GL_CONSTANT_ATTENUATION
   LightParameter
LinearAttenuation -> GLenum
GL_LINEAR_ATTENUATION
   LightParameter
QuadraticAttenuation -> GLenum
GL_QUADRATIC_ATTENUATION

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

ambient :: Light -> StateVar (Color4 GLfloat)
ambient :: Light -> StateVar (Color4 GLfloat)
ambient = forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetLightfvc GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glLightfvc LightParameter
Ambient' Color4 GLfloat
black

black :: Color4 GLfloat
black :: Color4 GLfloat
black = forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
0 GLfloat
0 GLfloat
0 GLfloat
0

diffuse :: Light -> StateVar (Color4 GLfloat)
diffuse :: Light -> StateVar (Color4 GLfloat)
diffuse = forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetLightfvc GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glLightfvc LightParameter
Diffuse' Color4 GLfloat
black

specular :: Light -> StateVar (Color4 GLfloat)
specular :: Light -> StateVar (Color4 GLfloat)
specular = forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetLightfvc GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glLightfvc LightParameter
Specular' Color4 GLfloat
black

makeLightVar :: Storable a
             => (GLenum -> GLenum -> Ptr a -> IO ())
             -> (GLenum -> GLenum -> Ptr a -> IO ())
             -> LightParameter -> a -> Light -> StateVar a
makeLightVar :: forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar GLenum -> GLenum -> Ptr a -> IO ()
getter GLenum -> GLenum -> Ptr a -> IO ()
setter LightParameter
lightParameter a
defaultValue Light
theLight =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return a
defaultValue) GLenum -> IO a
getLightVar Maybe GLenum
ml)
                (\a
val -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
recordInvalidEnum (a -> GLenum -> IO ()
setLightVar a
val) Maybe GLenum
ml)
   where lp :: GLenum
lp          = LightParameter -> GLenum
marshalLightParameter LightParameter
lightParameter
         ml :: Maybe GLenum
ml          = Light -> Maybe GLenum
marshalLight Light
theLight
         getLightVar :: GLenum -> IO a
getLightVar = \GLenum
l -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr a
buf -> do GLenum -> GLenum -> Ptr a -> IO ()
getter GLenum
l GLenum
lp Ptr a
buf ; forall a. Storable a => Ptr a -> IO a
peek Ptr a
buf
         setLightVar :: a -> GLenum -> IO ()
setLightVar = \a
val GLenum
l -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
val forall a b. (a -> b) -> a -> b
$ GLenum -> GLenum -> Ptr a -> IO ()
setter GLenum
l GLenum
lp

glGetLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glGetLightfvc GLenum
l GLenum
pname Ptr (Color4 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetLightfv GLenum
l GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr (Color4 GLfloat)
ptr)

glLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
glLightfvc GLenum
l GLenum
pname Ptr (Color4 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glLightfv GLenum
l GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr (Color4 GLfloat)
ptr)

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

position :: Light -> StateVar (Vertex4 GLfloat)
position :: Light -> StateVar (Vertex4 GLfloat)
position = forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()
glGetLightfvv GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()
glLightfvv LightParameter
Position (forall a. a -> a -> a -> a -> Vertex4 a
Vertex4 GLfloat
0 GLfloat
0 GLfloat
0 GLfloat
0)

glLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()
glLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()
glLightfvv GLenum
l GLenum
pname Ptr (Vertex4 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glLightfv GLenum
l GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr (Vertex4 GLfloat)
ptr)

glGetLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()
glGetLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()
glGetLightfvv GLenum
l GLenum
pname Ptr (Vertex4 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetLightfv GLenum
l GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr (Vertex4 GLfloat)
ptr)

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

spotDirection :: Light -> StateVar (Normal3 GLfloat)
spotDirection :: Light -> StateVar (Normal3 GLfloat)
spotDirection =
   forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()
glGetLightfvn GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()
glLightfvn LightParameter
SpotDirection (forall a. a -> a -> a -> Normal3 a
Normal3 GLfloat
0 GLfloat
0 GLfloat
0)

glLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()
glLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()
glLightfvn GLenum
l GLenum
pname Ptr (Normal3 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glLightfv GLenum
l GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr (Normal3 GLfloat)
ptr)

glGetLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()
glGetLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()
glGetLightfvn GLenum
l GLenum
pname Ptr (Normal3 GLfloat)
ptr = forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetLightfv GLenum
l GLenum
pname (forall a b. Ptr a -> Ptr b
castPtr Ptr (Normal3 GLfloat)
ptr)

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

spotExponent :: Light -> StateVar GLfloat
spotExponent :: Light -> StateVar GLfloat
spotExponent = forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetLightfv forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glLightfv LightParameter
SpotExponent GLfloat
0

maxSpotExponent :: GettableStateVar GLfloat
maxSpotExponent :: GettableStateVar GLfloat
maxSpotExponent = forall a. IO a -> IO a
makeGettableStateVar forall a b. (a -> b) -> a -> b
$ forall p a. GetPName1F p => (GLfloat -> a) -> p -> IO a
getFloat1 forall a. a -> a
id PName1F
GetMaxSpotExponent

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

spotCutoff :: Light -> StateVar GLfloat
spotCutoff :: Light -> StateVar GLfloat
spotCutoff = forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetLightfv forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glLightfv LightParameter
SpotCutoff GLfloat
0

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

attenuation :: Light -> StateVar (GLfloat, GLfloat, GLfloat)
attenuation :: Light -> StateVar (GLfloat, GLfloat, GLfloat)
attenuation Light
theLight =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) (forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (Light -> StateVar GLfloat
constantAttenuation  Light
theLight))
                   (forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (Light -> StateVar GLfloat
linearAttenuation    Light
theLight))
                   (forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (Light -> StateVar GLfloat
quadraticAttenuation Light
theLight)))
      (\(GLfloat
constant, GLfloat
linear, GLfloat
quadratic) -> do
         Light -> StateVar GLfloat
constantAttenuation  Light
theLight forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLfloat
constant
         Light -> StateVar GLfloat
linearAttenuation    Light
theLight forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLfloat
linear
         Light -> StateVar GLfloat
quadraticAttenuation Light
theLight forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= GLfloat
quadratic)

constantAttenuation :: Light -> StateVar GLfloat
constantAttenuation :: Light -> StateVar GLfloat
constantAttenuation = forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetLightfv forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glLightfv LightParameter
ConstantAttenuation GLfloat
0

linearAttenuation :: Light -> StateVar GLfloat
linearAttenuation :: Light -> StateVar GLfloat
linearAttenuation = forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetLightfv forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glLightfv LightParameter
LinearAttenuation GLfloat
0

quadraticAttenuation :: Light -> StateVar GLfloat
quadraticAttenuation :: Light -> StateVar GLfloat
quadraticAttenuation =
   forall a.
Storable a =>
(GLenum -> GLenum -> Ptr a -> IO ())
-> (GLenum -> GLenum -> Ptr a -> IO ())
-> LightParameter
-> a
-> Light
-> StateVar a
makeLightVar forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glGetLightfv forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> Ptr GLfloat -> m ()
glLightfv LightParameter
QuadraticAttenuation GLfloat
0

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

data LightModelParameter =
     LightModelAmbient
   | LightModelLocalViewer
   | LightModelTwoSide
   | LightModelColorControl

marshalLightModelParameter :: LightModelParameter -> GLenum
marshalLightModelParameter :: LightModelParameter -> GLenum
marshalLightModelParameter LightModelParameter
x = case LightModelParameter
x of
   LightModelParameter
LightModelAmbient -> GLenum
GL_LIGHT_MODEL_AMBIENT
   LightModelParameter
LightModelLocalViewer -> GLenum
GL_LIGHT_MODEL_LOCAL_VIEWER
   LightModelParameter
LightModelTwoSide -> GLenum
GL_LIGHT_MODEL_TWO_SIDE
   LightModelParameter
LightModelColorControl -> GLenum
GL_LIGHT_MODEL_COLOR_CONTROL

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

lightModelAmbient :: StateVar (Color4 GLfloat)
lightModelAmbient :: StateVar (Color4 GLfloat)
lightModelAmbient =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall p a.
GetPName4F p =>
(GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a
getFloat4 forall a. a -> a -> a -> a -> Color4 a
Color4 PName4F
GetLightModelAmbient)
      (\Color4 GLfloat
c -> forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color4 GLfloat
c forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *). MonadIO m => GLenum -> Ptr GLfloat -> m ()
glLightModelfv (LightModelParameter -> GLenum
marshalLightModelParameter LightModelParameter
LightModelAmbient) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr)

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

lightModelLocalViewer :: StateVar Capability
lightModelLocalViewer :: StateVar Capability
lightModelLocalViewer =
   PName1I -> LightModelParameter -> StateVar Capability
makeLightModelCapVar PName1I
GetLightModelLocalViewer LightModelParameter
LightModelLocalViewer

makeLightModelCapVar :: PName1I -> LightModelParameter -> StateVar Capability
makeLightModelCapVar :: PName1I -> LightModelParameter -> StateVar Capability
makeLightModelCapVar PName1I
pname LightModelParameter
lightModelParameter =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall p a. GetPName1I p => (GLboolean -> a) -> p -> IO a
getBoolean1 GLboolean -> Capability
unmarshalCapability PName1I
pname)
      (forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glLightModeli (LightModelParameter -> GLenum
marshalLightModelParameter LightModelParameter
lightModelParameter) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capability -> GLboolean
marshalCapability)

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

lightModelTwoSide :: StateVar Capability
lightModelTwoSide :: StateVar Capability
lightModelTwoSide = PName1I -> LightModelParameter -> StateVar Capability
makeLightModelCapVar PName1I
GetLightModelTwoSide LightModelParameter
LightModelTwoSide

vertexProgramTwoSide :: StateVar Capability
vertexProgramTwoSide :: StateVar Capability
vertexProgramTwoSide = EnableCap -> StateVar Capability
makeCapability EnableCap
CapVertexProgramTwoSide

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

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

marshalLightModelColorControl :: LightModelColorControl -> GLenum
marshalLightModelColorControl :: LightModelColorControl -> GLenum
marshalLightModelColorControl LightModelColorControl
x = case LightModelColorControl
x of
   LightModelColorControl
SingleColor -> GLenum
GL_SINGLE_COLOR
   LightModelColorControl
SeparateSpecularColor -> GLenum
GL_SEPARATE_SPECULAR_COLOR

unmarshalLightModelColorControl :: GLenum -> LightModelColorControl
unmarshalLightModelColorControl :: GLenum -> LightModelColorControl
unmarshalLightModelColorControl GLenum
x
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_SINGLE_COLOR = LightModelColorControl
SingleColor
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_SEPARATE_SPECULAR_COLOR = LightModelColorControl
SeparateSpecularColor
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalLightModelColorControl: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)

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

lightModelColorControl :: StateVar LightModelColorControl
lightModelColorControl :: StateVar LightModelColorControl
lightModelColorControl =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> LightModelColorControl
unmarshalLightModelColorControl PName1I
GetLightModelColorControl)
      (forall (m :: * -> *). MonadIO m => GLenum -> GLint -> m ()
glLightModeli (LightModelParameter -> GLenum
marshalLightModelParameter LightModelParameter
LightModelColorControl) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. LightModelColorControl -> GLenum
marshalLightModelColorControl)

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

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

marshalColorMaterialParameter :: ColorMaterialParameter -> GLenum
marshalColorMaterialParameter :: ColorMaterialParameter -> GLenum
marshalColorMaterialParameter ColorMaterialParameter
x = case ColorMaterialParameter
x of
   ColorMaterialParameter
Ambient -> GLenum
GL_AMBIENT
   ColorMaterialParameter
Diffuse -> GLenum
GL_DIFFUSE
   ColorMaterialParameter
Specular -> GLenum
GL_SPECULAR
   ColorMaterialParameter
Emission -> GLenum
GL_EMISSION
   ColorMaterialParameter
AmbientAndDiffuse -> GLenum
GL_AMBIENT_AND_DIFFUSE

unmarshalColorMaterialParameter :: GLenum -> ColorMaterialParameter
unmarshalColorMaterialParameter :: GLenum -> ColorMaterialParameter
unmarshalColorMaterialParameter GLenum
x
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_AMBIENT = ColorMaterialParameter
Ambient
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_DIFFUSE = ColorMaterialParameter
Diffuse
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_SPECULAR = ColorMaterialParameter
Specular
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_EMISSION = ColorMaterialParameter
Emission
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_AMBIENT_AND_DIFFUSE = ColorMaterialParameter
AmbientAndDiffuse
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalColorMaterialParameter: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)

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

colorMaterial :: StateVar (Maybe (Face, ColorMaterialParameter))
colorMaterial :: StateVar (Maybe (Face, ColorMaterialParameter))
colorMaterial =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return EnableCap
CapColorMaterial)
      (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
         (,)
         (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> Face
unmarshalFace PName1I
GetColorMaterialFace)
         (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> ColorMaterialParameter
unmarshalColorMaterialParameter PName1I
GetColorMaterialParameter))
      (\(Face
face, ColorMaterialParameter
param) -> forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glColorMaterial (Face -> GLenum
marshalFace Face
face)
                                         (ColorMaterialParameter -> GLenum
marshalColorMaterialParameter ColorMaterialParameter
param))

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

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

marshalShadingModel :: ShadingModel -> GLenum
marshalShadingModel :: ShadingModel -> GLenum
marshalShadingModel ShadingModel
x = case ShadingModel
x of
   ShadingModel
Flat -> GLenum
GL_FLAT
   ShadingModel
Smooth -> GLenum
GL_SMOOTH

unmarshalShadingModel :: GLenum -> ShadingModel
unmarshalShadingModel :: GLenum -> ShadingModel
unmarshalShadingModel GLenum
x
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_FLAT = ShadingModel
Flat
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_SMOOTH = ShadingModel
Smooth
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalShadingModel: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)

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

shadeModel :: StateVar ShadingModel
shadeModel :: StateVar ShadingModel
shadeModel =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> ShadingModel
unmarshalShadingModel PName1I
GetShadeModel)
      (forall (m :: * -> *). MonadIO m => GLenum -> m ()
glShadeModel forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShadingModel -> GLenum
marshalShadingModel)

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

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

marshalClampTarget :: ClampTarget -> GLenum
marshalClampTarget :: ClampTarget -> GLenum
marshalClampTarget ClampTarget
x = case ClampTarget
x of
   ClampTarget
ClampVertexColor -> GLenum
GL_CLAMP_VERTEX_COLOR
   ClampTarget
ClampFragmentColor -> GLenum
GL_CLAMP_FRAGMENT_COLOR
   ClampTarget
ClampReadColor -> GLenum
GL_CLAMP_READ_COLOR

marshalClampTargetToPName :: ClampTarget -> PName1I
marshalClampTargetToPName :: ClampTarget -> PName1I
marshalClampTargetToPName ClampTarget
x = case ClampTarget
x of
   ClampTarget
ClampFragmentColor -> PName1I
GetFragmentColorClamp
   ClampTarget
ClampVertexColor -> PName1I
GetVertexColorClamp
   ClampTarget
ClampReadColor -> PName1I
GetReadColorClamp

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

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

marshalClampMode :: ClampMode -> GLenum
marshalClampMode :: ClampMode -> GLenum
marshalClampMode ClampMode
x = case ClampMode
x of
   ClampMode
ClampOn -> forall a b. (Integral a, Num b) => a -> b
fromIntegral GLboolean
GL_TRUE
   ClampMode
FixedOnly -> GLenum
GL_FIXED_ONLY
   ClampMode
ClampOff -> forall a b. (Integral a, Num b) => a -> b
fromIntegral GLboolean
GL_FALSE

unmarshalClampMode :: GLenum -> ClampMode
unmarshalClampMode :: GLenum -> ClampMode
unmarshalClampMode GLenum
x
   | GLenum
x forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral GLboolean
GL_TRUE = ClampMode
ClampOn
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_FIXED_ONLY = ClampMode
FixedOnly
   | GLenum
x forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral GLboolean
GL_FALSE = ClampMode
ClampOff
   | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"unmarshalClampMode: unknown enum value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x

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

clampColor :: ClampTarget -> StateVar ClampMode
clampColor :: ClampTarget -> StateVar ClampMode
clampColor ClampTarget
ct = forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar (ClampTarget -> IO ClampMode
getClampColor ClampTarget
ct) (forall {m :: * -> *}. MonadIO m => ClampTarget -> ClampMode -> m ()
setClampColor ClampTarget
ct)
   where getClampColor :: ClampTarget -> IO ClampMode
getClampColor = forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> ClampMode
unmarshalClampMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClampTarget -> PName1I
marshalClampTargetToPName
         setClampColor :: ClampTarget -> ClampMode -> m ()
setClampColor ClampTarget
t = forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glClampColor (ClampTarget -> GLenum
marshalClampTarget ClampTarget
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClampMode -> GLenum
marshalClampMode