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

module Graphics.Rendering.OpenGL.GL.PerFragment (
   -- * Discarding Primitives Before Rasterization
   rasterizerDiscard, discardingRasterizer,

   -- * Scissor Test
   scissor,

   -- * Multisample Fragment Operations
   sampleAlphaToCoverage,  sampleAlphaToOne, sampleCoverage,

   -- * Depth Bounds Test
   depthBounds,

   -- * Alpha Test
   ComparisonFunction(..), alphaFunc,

   -- * Stencil Test
   stencilTest, stencilFunc, stencilFuncSeparate, StencilOp(..), stencilOp,
   stencilOpSeparate, activeStencilFace,

   -- * Depth Buffer Test
   depthFunc,

   -- * Blending
   blend, blendBuffer, BlendEquation(..), blendEquation, blendEquationSeparate,
   BlendingFactor(..), blendFuncSeparate, blendFunc, blendColor,

   -- * Dithering
   dither,

   -- * Logical Operation
   LogicOp(..), logicOp
) where

import Control.Monad
import Data.StateVar
import Graphics.Rendering.OpenGL.GL.BlendingFactor
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.ComparisonFunction
import Graphics.Rendering.OpenGL.GL.CoordTrans
import Graphics.Rendering.OpenGL.GL.Exception
import Graphics.Rendering.OpenGL.GL.Face
import Graphics.Rendering.OpenGL.GL.Framebuffer
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.GL

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

rasterizerDiscard :: StateVar Capability
rasterizerDiscard :: StateVar Capability
rasterizerDiscard = EnableCap -> StateVar Capability
makeCapability EnableCap
CapRasterizerDiscard

discardingRasterizer :: IO a -> IO a
discardingRasterizer :: forall a. IO a -> IO a
discardingRasterizer IO a
act = do
   Capability
r <- forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get StateVar Capability
rasterizerDiscard
   forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (StateVar Capability
rasterizerDiscard forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
Enabled) (StateVar Capability
rasterizerDiscard forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
r) IO a
act

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

scissor :: StateVar (Maybe (Position, Size))
scissor :: StateVar (Maybe (Position, Size))
scissor =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return EnableCap
CapScissorTest)
      (forall p a.
GetPName4I p =>
(GLint -> GLint -> GLint -> GLint -> a) -> p -> IO a
getInteger4 forall {a} {a}.
(Integral a, Integral a) =>
GLint -> GLint -> a -> a -> (Position, Size)
makeSB PName4I
GetScissorBox)
      (\(Position GLint
x GLint
y, Size GLint
w GLint
h) -> forall (m :: * -> *).
MonadIO m =>
GLint -> GLint -> GLint -> GLint -> m ()
glScissor GLint
x GLint
y GLint
w GLint
h)
   where makeSB :: GLint -> GLint -> a -> a -> (Position, Size)
makeSB GLint
x GLint
y a
w a
h = (GLint -> GLint -> Position
Position GLint
x GLint
y, GLint -> GLint -> Size
Size (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w) (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h))

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

sampleAlphaToCoverage :: StateVar Capability
sampleAlphaToCoverage :: StateVar Capability
sampleAlphaToCoverage = EnableCap -> StateVar Capability
makeCapability EnableCap
CapSampleAlphaToCoverage

sampleAlphaToOne :: StateVar Capability
sampleAlphaToOne :: StateVar Capability
sampleAlphaToOne = EnableCap -> StateVar Capability
makeCapability EnableCap
CapSampleAlphaToOne

sampleCoverage :: StateVar (Maybe (GLclampf, Bool))
sampleCoverage :: StateVar (Maybe (GLclampf, Bool))
sampleCoverage =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return EnableCap
CapSampleCoverage)
      (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (forall p a. GetPName1F p => (GLclampf -> a) -> p -> IO a
getClampf1 forall a. a -> a
id PName1F
GetSampleCoverageValue)
                  (forall p a. GetPName1I p => (GLboolean -> a) -> p -> IO a
getBoolean1 forall a. (Eq a, Num a) => a -> Bool
unmarshalGLboolean PName1I
GetSampleCoverageInvert))
      (\(GLclampf
value, Bool
invert) -> forall (m :: * -> *). MonadIO m => GLclampf -> GLboolean -> m ()
glSampleCoverage GLclampf
value (forall a. Num a => Bool -> a
marshalGLboolean Bool
invert))

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

depthBounds :: StateVar (Maybe (GLclampd, GLclampd))
depthBounds :: StateVar (Maybe (GLclampd, GLclampd))
depthBounds =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return EnableCap
CapDepthBoundsTest)
      (forall p a.
GetPName2F p =>
(GLclampd -> GLclampd -> a) -> p -> IO a
getClampd2 (,) PName2F
GetDepthBounds)
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). MonadIO m => GLclampd -> GLclampd -> m ()
glDepthBoundsEXT)

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

alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))
alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))
alphaFunc =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return EnableCap
CapAlphaTest)
      (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 -> ComparisonFunction
unmarshalComparisonFunction PName1I
GetAlphaTestFunc)
                  (forall p a. GetPName1F p => (GLclampf -> a) -> p -> IO a
getClampf1 forall a. a -> a
id PName1F
GetAlphaTestRef))
      (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *). MonadIO m => GLenum -> GLclampf -> m ()
glAlphaFunc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComparisonFunction -> GLenum
marshalComparisonFunction))

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

stencilTest :: StateVar Capability
stencilTest :: StateVar Capability
stencilTest = EnableCap -> StateVar Capability
makeCapability EnableCap
CapStencilTest

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

stencilFunc :: StateVar (ComparisonFunction, GLint, GLuint)
stencilFunc :: StateVar (ComparisonFunction, GLint, GLenum)
stencilFunc =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (Face -> StateVar (ComparisonFunction, GLint, GLenum)
stencilFuncSeparate Face
Front))
      (\(ComparisonFunction
func, GLint
ref, GLenum
mask) ->
         forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> m ()
glStencilFunc (ComparisonFunction -> GLenum
marshalComparisonFunction ComparisonFunction
func) GLint
ref GLenum
mask)

stencilFuncSeparate :: Face -> StateVar (ComparisonFunction, GLint, GLuint)
stencilFuncSeparate :: Face -> StateVar (ComparisonFunction, GLint, GLenum)
stencilFuncSeparate Face
face =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (case Face
face of
          Face
Front -> forall {p} {p} {p} {a3}.
(GetPName1I p, GetPName1I p, GetPName1I p, Num a3) =>
p -> p -> p -> IO (ComparisonFunction, GLint, a3)
getStencilFunc PName1I
GetStencilFunc
                                  PName1I
GetStencilRef
                                  PName1I
GetStencilValueMask
          Face
Back -> forall {p} {p} {p} {a3}.
(GetPName1I p, GetPName1I p, GetPName1I p, Num a3) =>
p -> p -> p -> IO (ComparisonFunction, GLint, a3)
getStencilFunc PName1I
GetStencilBackFunc
                                 PName1I
GetStencilBackRef
                                 PName1I
GetStencilBackValueMask
          Face
FrontAndBack -> do IO ()
recordInvalidEnum; forall (m :: * -> *) a. Monad m => a -> m a
return (ComparisonFunction
Never, GLint
0, GLenum
0))
      (\(ComparisonFunction
func, GLint
ref, GLenum
mask) ->
         forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLint -> GLenum -> m ()
glStencilFuncSeparate (Face -> GLenum
marshalFace Face
face)
                               (ComparisonFunction -> GLenum
marshalComparisonFunction ComparisonFunction
func) GLint
ref GLenum
mask)
   where getStencilFunc :: p -> p -> p -> IO (ComparisonFunction, GLint, a3)
getStencilFunc p
func p
ref p
mask =
            forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> ComparisonFunction
unmarshalComparisonFunction p
func)
                        (forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 forall a. a -> a
id p
ref)
                        (forall p a. GetPName1I p => (GLint -> a) -> p -> IO a
getInteger1 forall a b. (Integral a, Num b) => a -> b
fromIntegral p
mask)

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

data StencilOp =
     OpZero
   | OpKeep
   | OpReplace
   | OpIncr
   | OpIncrWrap
   | OpDecr
   | OpDecrWrap
   | OpInvert
   deriving ( StencilOp -> StencilOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StencilOp -> StencilOp -> Bool
$c/= :: StencilOp -> StencilOp -> Bool
== :: StencilOp -> StencilOp -> Bool
$c== :: StencilOp -> StencilOp -> Bool
Eq, Eq StencilOp
StencilOp -> StencilOp -> Bool
StencilOp -> StencilOp -> Ordering
StencilOp -> StencilOp -> StencilOp
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 :: StencilOp -> StencilOp -> StencilOp
$cmin :: StencilOp -> StencilOp -> StencilOp
max :: StencilOp -> StencilOp -> StencilOp
$cmax :: StencilOp -> StencilOp -> StencilOp
>= :: StencilOp -> StencilOp -> Bool
$c>= :: StencilOp -> StencilOp -> Bool
> :: StencilOp -> StencilOp -> Bool
$c> :: StencilOp -> StencilOp -> Bool
<= :: StencilOp -> StencilOp -> Bool
$c<= :: StencilOp -> StencilOp -> Bool
< :: StencilOp -> StencilOp -> Bool
$c< :: StencilOp -> StencilOp -> Bool
compare :: StencilOp -> StencilOp -> Ordering
$ccompare :: StencilOp -> StencilOp -> Ordering
Ord, Int -> StencilOp -> ShowS
[StencilOp] -> ShowS
StencilOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StencilOp] -> ShowS
$cshowList :: [StencilOp] -> ShowS
show :: StencilOp -> String
$cshow :: StencilOp -> String
showsPrec :: Int -> StencilOp -> ShowS
$cshowsPrec :: Int -> StencilOp -> ShowS
Show )

marshalStencilOp :: StencilOp -> GLenum
marshalStencilOp :: StencilOp -> GLenum
marshalStencilOp StencilOp
x = case StencilOp
x of
   StencilOp
OpZero -> GLenum
GL_ZERO
   StencilOp
OpKeep -> GLenum
GL_KEEP
   StencilOp
OpReplace -> GLenum
GL_REPLACE
   StencilOp
OpIncr -> GLenum
GL_INCR
   StencilOp
OpIncrWrap -> GLenum
GL_INCR_WRAP
   StencilOp
OpDecr -> GLenum
GL_DECR
   StencilOp
OpDecrWrap -> GLenum
GL_DECR_WRAP
   StencilOp
OpInvert -> GLenum
GL_INVERT

unmarshalStencilOp :: GLenum -> StencilOp
unmarshalStencilOp :: GLenum -> StencilOp
unmarshalStencilOp GLenum
x
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_ZERO = StencilOp
OpZero
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_KEEP = StencilOp
OpKeep
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_REPLACE = StencilOp
OpReplace
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_INCR = StencilOp
OpIncr
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_INCR_WRAP = StencilOp
OpIncrWrap
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_DECR = StencilOp
OpDecr
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_DECR_WRAP = StencilOp
OpDecrWrap
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVERT = StencilOp
OpInvert
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalStencilOp: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)

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

stencilOp :: StateVar (StencilOp, StencilOp, StencilOp)
stencilOp :: StateVar (StencilOp, StencilOp, StencilOp)
stencilOp =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get (Face -> StateVar (StencilOp, StencilOp, StencilOp)
stencilOpSeparate Face
Front))
      (\(StencilOp
sf, StencilOp
spdf, StencilOp
spdp) -> forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> m ()
glStencilOp (StencilOp -> GLenum
marshalStencilOp StencilOp
sf)
                                        (StencilOp -> GLenum
marshalStencilOp StencilOp
spdf)
                                        (StencilOp -> GLenum
marshalStencilOp StencilOp
spdp))

stencilOpSeparate :: Face -> StateVar (StencilOp, StencilOp, StencilOp)
stencilOpSeparate :: Face -> StateVar (StencilOp, StencilOp, StencilOp)
stencilOpSeparate Face
face =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (case Face
face of
          Face
Front -> forall {p} {p} {p}.
(GetPName1I p, GetPName1I p, GetPName1I p) =>
p -> p -> p -> IO (StencilOp, StencilOp, StencilOp)
getStencilOp PName1I
GetStencilFail
                                PName1I
GetStencilPassDepthFail
                                PName1I
GetStencilPassDepthPass
          Face
Back ->  forall {p} {p} {p}.
(GetPName1I p, GetPName1I p, GetPName1I p) =>
p -> p -> p -> IO (StencilOp, StencilOp, StencilOp)
getStencilOp PName1I
GetStencilBackFail
                                PName1I
GetStencilBackPassDepthFail
                                PName1I
GetStencilBackPassDepthPass
          Face
FrontAndBack -> do IO ()
recordInvalidEnum
                             forall (m :: * -> *) a. Monad m => a -> m a
return (StencilOp
OpZero, StencilOp
OpZero, StencilOp
OpZero))
      (\(StencilOp
sf, StencilOp
spdf, StencilOp
spdp) -> forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLenum -> m ()
glStencilOpSeparate (Face -> GLenum
marshalFace Face
face)
                                                (StencilOp -> GLenum
marshalStencilOp StencilOp
sf)
                                                (StencilOp -> GLenum
marshalStencilOp StencilOp
spdf)
                                                (StencilOp -> GLenum
marshalStencilOp StencilOp
spdp))
   where getStencilOp :: p -> p -> p -> IO (StencilOp, StencilOp, StencilOp)
getStencilOp p
sf p
spdf p
spdp =
            (forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> StencilOp
unmarshalStencilOp p
sf)
                         (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> StencilOp
unmarshalStencilOp p
spdf)
                         (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> StencilOp
unmarshalStencilOp p
spdp))


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

activeStencilFace :: StateVar (Maybe Face)
activeStencilFace :: StateVar (Maybe Face)
activeStencilFace =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return EnableCap
CapStencilTestTwoSide)
      (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> Face
unmarshalFace PName1I
GetActiveStencilFace)
      (forall (m :: * -> *). MonadIO m => GLenum -> m ()
glActiveStencilFaceEXT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face -> GLenum
marshalFace)

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

depthFunc :: StateVar (Maybe ComparisonFunction)
depthFunc :: StateVar (Maybe ComparisonFunction)
depthFunc =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return EnableCap
CapDepthTest)
      (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> ComparisonFunction
unmarshalComparisonFunction PName1I
GetDepthFunc)
      (forall (m :: * -> *). MonadIO m => GLenum -> m ()
glDepthFunc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComparisonFunction -> GLenum
marshalComparisonFunction)

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

blend :: StateVar Capability
blend :: StateVar Capability
blend = EnableCap -> StateVar Capability
makeCapability EnableCap
CapBlend

-- | enable or disable blending based on the buffer bound to the /i/'th drawBuffer
-- that is the buffer fmap (!! i) (get drawBuffers)
blendBuffer :: DrawBufferIndex -> StateVar Capability
blendBuffer :: GLenum -> StateVar Capability
blendBuffer = forall a.
(a -> GLenum) -> IndexedEnableCap -> a -> StateVar Capability
makeIndexedCapability ((forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
GL_DRAW_BUFFER0) forall a. Num a => a -> a -> a
+) IndexedEnableCap
BlendI

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

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

marshalBlendEquation :: BlendEquation -> GLenum
marshalBlendEquation :: BlendEquation -> GLenum
marshalBlendEquation BlendEquation
x = case BlendEquation
x of
   BlendEquation
FuncAdd -> GLenum
GL_FUNC_ADD
   BlendEquation
FuncSubtract -> GLenum
GL_FUNC_SUBTRACT
   BlendEquation
FuncReverseSubtract -> GLenum
GL_FUNC_REVERSE_SUBTRACT
   BlendEquation
Min -> GLenum
GL_MIN
   BlendEquation
Max -> GLenum
GL_MAX
   BlendEquation
LogicOp -> GLenum
GL_INDEX_LOGIC_OP

unmarshalBlendEquation :: GLenum -> BlendEquation
unmarshalBlendEquation :: GLenum -> BlendEquation
unmarshalBlendEquation GLenum
x
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_FUNC_ADD = BlendEquation
FuncAdd
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_FUNC_SUBTRACT = BlendEquation
FuncSubtract
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_FUNC_REVERSE_SUBTRACT = BlendEquation
FuncReverseSubtract
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_MIN = BlendEquation
Min
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_MAX = BlendEquation
Max
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_INDEX_LOGIC_OP = BlendEquation
LogicOp
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalBlendEquation: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)

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

blendEquation :: StateVar BlendEquation
blendEquation :: StateVar BlendEquation
blendEquation =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendEquation
unmarshalBlendEquation PName1I
GetBlendEquation)
      (forall (m :: * -> *). MonadIO m => GLenum -> m ()
glBlendEquation forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlendEquation -> GLenum
marshalBlendEquation)

blendEquationSeparate :: StateVar (BlendEquation,BlendEquation)
blendEquationSeparate :: StateVar (BlendEquation, BlendEquation)
blendEquationSeparate =
   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 (,) (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendEquation
unmarshalBlendEquation PName1I
GetBlendEquation)
                  (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendEquation
unmarshalBlendEquation PName1I
GetBlendEquationAlpha))
      (\(BlendEquation
funcRGB, BlendEquation
funcAlpha) ->
          forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBlendEquationSeparate (BlendEquation -> GLenum
marshalBlendEquation BlendEquation
funcRGB)
                                  (BlendEquation -> GLenum
marshalBlendEquation BlendEquation
funcAlpha))

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

blendFuncSeparate ::
   StateVar ((BlendingFactor, BlendingFactor), (BlendingFactor, BlendingFactor))
blendFuncSeparate :: StateVar
  ((BlendingFactor, BlendingFactor),
   (BlendingFactor, BlendingFactor))
blendFuncSeparate =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (do BlendingFactor
srcRGB   <- forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendingFactor
unmarshalBlendingFactor PName1I
GetBlendSrcRGB
          BlendingFactor
srcAlpha <- forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendingFactor
unmarshalBlendingFactor PName1I
GetBlendSrcAlpha
          BlendingFactor
dstRGB   <- forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendingFactor
unmarshalBlendingFactor PName1I
GetBlendDstRGB
          BlendingFactor
dstAlpha <- forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendingFactor
unmarshalBlendingFactor PName1I
GetBlendDstAlpha
          forall (m :: * -> *) a. Monad m => a -> m a
return ((BlendingFactor
srcRGB, BlendingFactor
srcAlpha), (BlendingFactor
dstRGB, BlendingFactor
dstAlpha)))
      (\((BlendingFactor
srcRGB, BlendingFactor
srcAlpha), (BlendingFactor
dstRGB, BlendingFactor
dstAlpha)) ->
         forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> GLenum -> m ()
glBlendFuncSeparate (BlendingFactor -> GLenum
marshalBlendingFactor BlendingFactor
srcRGB)
                             (BlendingFactor -> GLenum
marshalBlendingFactor BlendingFactor
srcAlpha)
                             (BlendingFactor -> GLenum
marshalBlendingFactor BlendingFactor
dstRGB)
                             (BlendingFactor -> GLenum
marshalBlendingFactor BlendingFactor
dstAlpha))

blendFunc :: StateVar (BlendingFactor, BlendingFactor)
blendFunc :: StateVar (BlendingFactor, BlendingFactor)
blendFunc =
   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 (,) (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendingFactor
unmarshalBlendingFactor PName1I
GetBlendSrc)
                  (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> BlendingFactor
unmarshalBlendingFactor PName1I
GetBlendDst))
      (\(BlendingFactor
s, BlendingFactor
d) ->
         forall (m :: * -> *). MonadIO m => GLenum -> GLenum -> m ()
glBlendFunc (BlendingFactor -> GLenum
marshalBlendingFactor BlendingFactor
s) (BlendingFactor -> GLenum
marshalBlendingFactor BlendingFactor
d))

blendColor :: StateVar (Color4 GLclampf)
blendColor :: StateVar (Color4 GLclampf)
blendColor =
   forall a. IO a -> (a -> IO ()) -> StateVar a
makeStateVar
      (forall p a.
GetPName4F p =>
(GLclampf -> GLclampf -> GLclampf -> GLclampf -> a) -> p -> IO a
getClampf4 forall a. a -> a -> a -> a -> Color4 a
Color4 PName4F
GetBlendColor)
      (\(Color4 GLclampf
r GLclampf
g GLclampf
b GLclampf
a) -> forall (m :: * -> *).
MonadIO m =>
GLclampf -> GLclampf -> GLclampf -> GLclampf -> m ()
glBlendColor GLclampf
r GLclampf
g GLclampf
b GLclampf
a)

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

dither :: StateVar Capability
dither :: StateVar Capability
dither = EnableCap -> StateVar Capability
makeCapability EnableCap
CapDither

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

data LogicOp =
     Clear
   | And
   | AndReverse
   | Copy
   | AndInverted
   | Noop
   | Xor
   | Or
   | Nor
   | Equiv
   | Invert
   | OrReverse
   | CopyInverted
   | OrInverted
   | Nand
   | Set
   deriving ( LogicOp -> LogicOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogicOp -> LogicOp -> Bool
$c/= :: LogicOp -> LogicOp -> Bool
== :: LogicOp -> LogicOp -> Bool
$c== :: LogicOp -> LogicOp -> Bool
Eq, Eq LogicOp
LogicOp -> LogicOp -> Bool
LogicOp -> LogicOp -> Ordering
LogicOp -> LogicOp -> LogicOp
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 :: LogicOp -> LogicOp -> LogicOp
$cmin :: LogicOp -> LogicOp -> LogicOp
max :: LogicOp -> LogicOp -> LogicOp
$cmax :: LogicOp -> LogicOp -> LogicOp
>= :: LogicOp -> LogicOp -> Bool
$c>= :: LogicOp -> LogicOp -> Bool
> :: LogicOp -> LogicOp -> Bool
$c> :: LogicOp -> LogicOp -> Bool
<= :: LogicOp -> LogicOp -> Bool
$c<= :: LogicOp -> LogicOp -> Bool
< :: LogicOp -> LogicOp -> Bool
$c< :: LogicOp -> LogicOp -> Bool
compare :: LogicOp -> LogicOp -> Ordering
$ccompare :: LogicOp -> LogicOp -> Ordering
Ord, Int -> LogicOp -> ShowS
[LogicOp] -> ShowS
LogicOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogicOp] -> ShowS
$cshowList :: [LogicOp] -> ShowS
show :: LogicOp -> String
$cshow :: LogicOp -> String
showsPrec :: Int -> LogicOp -> ShowS
$cshowsPrec :: Int -> LogicOp -> ShowS
Show )

marshalLogicOp :: LogicOp -> GLenum
marshalLogicOp :: LogicOp -> GLenum
marshalLogicOp LogicOp
x = case LogicOp
x of
   LogicOp
Clear -> GLenum
GL_CLEAR
   LogicOp
And -> GLenum
GL_AND
   LogicOp
AndReverse -> GLenum
GL_AND_REVERSE
   LogicOp
Copy -> GLenum
GL_COPY
   LogicOp
AndInverted -> GLenum
GL_AND_INVERTED
   LogicOp
Noop -> GLenum
GL_NOOP
   LogicOp
Xor -> GLenum
GL_XOR
   LogicOp
Or -> GLenum
GL_OR
   LogicOp
Nor -> GLenum
GL_NOR
   LogicOp
Equiv -> GLenum
GL_EQUIV
   LogicOp
Invert -> GLenum
GL_INVERT
   LogicOp
OrReverse -> GLenum
GL_OR_REVERSE
   LogicOp
CopyInverted -> GLenum
GL_COPY_INVERTED
   LogicOp
OrInverted -> GLenum
GL_OR_INVERTED
   LogicOp
Nand -> GLenum
GL_NAND
   LogicOp
Set -> GLenum
GL_SET

unmarshalLogicOp :: GLenum -> LogicOp
unmarshalLogicOp :: GLenum -> LogicOp
unmarshalLogicOp GLenum
x
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_CLEAR = LogicOp
Clear
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_AND = LogicOp
And
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_AND_REVERSE = LogicOp
AndReverse
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_COPY = LogicOp
Copy
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_AND_INVERTED = LogicOp
AndInverted
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_NOOP = LogicOp
Noop
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_XOR = LogicOp
Xor
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_OR = LogicOp
Or
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_NOR = LogicOp
Nor
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_EQUIV = LogicOp
Equiv
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_INVERT = LogicOp
Invert
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_OR_REVERSE = LogicOp
OrReverse
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_COPY_INVERTED = LogicOp
CopyInverted
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_OR_INVERTED = LogicOp
OrInverted
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_NAND = LogicOp
Nand
   | GLenum
x forall a. Eq a => a -> a -> Bool
== GLenum
GL_SET = LogicOp
Set
   | Bool
otherwise = forall a. HasCallStack => String -> a
error (String
"unmarshalLogicOp: illegal value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GLenum
x)

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

logicOp :: StateVar (Maybe LogicOp)
logicOp :: StateVar (Maybe LogicOp)
logicOp =
   forall a.
IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
makeStateVarMaybe
      (do Bool
rgba <- forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get GettableStateVar Bool
rgbaMode
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
rgba then EnableCap
CapColorLogicOp else EnableCap
CapIndexLogicOp)
      (forall p a. GetPName1I p => (GLenum -> a) -> p -> IO a
getEnum1 GLenum -> LogicOp
unmarshalLogicOp PName1I
GetLogicOpMode)
      (forall (m :: * -> *). MonadIO m => GLenum -> m ()
glLogicOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicOp -> GLenum
marshalLogicOp)