module Graphics.Caramia.Render.Internal where
import Graphics.Caramia.Prelude
import Graphics.Caramia.Internal.OpenGLCApi
import Control.Monad.IO.Class
import Control.Monad.Catch
data ComparisonFunc =
Never
| Less
| Equal
| LEqual
| Greater
| NotEqual
| GEqual
| Always
deriving ( Eq, Ord, Show, Read, Typeable )
comparisonFuncToConstant :: ComparisonFunc -> GLenum
comparisonFuncToConstant Never = gl_NEVER
comparisonFuncToConstant Less = gl_LESS
comparisonFuncToConstant Equal = gl_EQUAL
comparisonFuncToConstant LEqual = gl_LEQUAL
comparisonFuncToConstant Greater = gl_GREATER
comparisonFuncToConstant NotEqual = gl_NOTEQUAL
comparisonFuncToConstant GEqual = gl_GEQUAL
comparisonFuncToConstant Always = gl_ALWAYS
data StencilOp =
Keep
| Zero
| Replace
| Increment
| IncrementAndWrap
| Decrease
| DecreaseAndWrap
| Invert
deriving ( Eq, Ord, Show, Read, Typeable )
stencilOpToConstant :: StencilOp -> GLenum
stencilOpToConstant Keep = gl_KEEP
stencilOpToConstant Zero = gl_ZERO
stencilOpToConstant Replace = gl_REPLACE
stencilOpToConstant Increment = gl_INCR
stencilOpToConstant IncrementAndWrap = gl_INCR_WRAP
stencilOpToConstant Decrease = gl_DECR
stencilOpToConstant DecreaseAndWrap = gl_DECR_WRAP
stencilOpToConstant Invert = gl_INVERT
setStencilFunc :: MonadIO m
=> ComparisonFunc
-> StencilOp
-> StencilOp
-> StencilOp
-> Word32
-> Word32
-> m ()
setStencilFunc func op1 op2 op3 ref mask = do
glStencilFunc (comparisonFuncToConstant func)
(fromIntegral ref)
(fromIntegral mask)
glStencilOp (stencilOpToConstant op1)
(stencilOpToConstant op2)
(stencilOpToConstant op3)
withStencilFunc :: (MonadIO m, MonadMask m)
=> ComparisonFunc
-> StencilOp
-> StencilOp
-> StencilOp
-> Word32
-> Word32
-> m a
-> m a
withStencilFunc func op1 op2 op3 ref mask action = do
old_func <- gi gl_STENCIL_FUNC
old_ref <- gi gl_STENCIL_REF
old_mask <- gi gl_STENCIL_VALUE_MASK
old_op1 <- gi gl_STENCIL_FAIL
old_op2 <- gi gl_STENCIL_PASS_DEPTH_FAIL
old_op3 <- gi gl_STENCIL_PASS_DEPTH_PASS
finally (setStencilFunc func op1 op2 op3 ref mask >> action)
(do
glStencilFunc old_func (fromIntegral old_ref) old_mask
glStencilOp old_op1 old_op2 old_op3)
withCulling :: (MonadIO m, MonadMask m) => Culling -> m a -> m a
withCulling culling action = do
old_culling <- gi gl_CULL_FACE_MODE
was_enabled <- glIsEnabled gl_CULL_FACE
finally (setCulling culling >> action)
(liftIO $ do
if was_enabled == fromIntegral gl_TRUE
then glEnable gl_CULL_FACE
else glDisable gl_CULL_FACE
glCullFace old_culling)
setCulling :: (MonadIO m, MonadMask m) => Culling -> m ()
setCulling NoCulling = glDisable gl_CULL_FACE
setCulling x = mask_ $
glEnable gl_CULL_FACE >>
glCullFace (cullingToConstant x)
setDepthFunc :: MonadIO m => ComparisonFunc -> Bool -> m ()
setDepthFunc func write_depth = do
glDepthFunc (comparisonFuncToConstant func)
glDepthMask (fromIntegral $ if write_depth then gl_TRUE else gl_FALSE)
withDepthFunc :: (MonadIO m, MonadMask m) => ComparisonFunc -> Bool -> m a -> m a
withDepthFunc func write_depth action = do
old_depth_func <- gi gl_DEPTH_FUNC
old_depth_write <- gi gl_DEPTH_WRITEMASK
finally (setDepthFunc func write_depth >> action)
(do
glDepthFunc old_depth_func
glDepthMask (fromIntegral old_depth_write))
setFragmentPassTests :: (MonadIO m, MonadMask m) => FragmentPassTests -> m ()
setFragmentPassTests (FragmentPassTests {..}) = do
case depthTest of
Nothing -> glDisable gl_DEPTH_TEST
Just dt -> glEnable gl_DEPTH_TEST >>
setDepthFunc dt writeDepth
case stencilTest of
Nothing -> glDisable gl_STENCIL_TEST
Just st -> glEnable gl_STENCIL_TEST >>
setStencilFunc st
failStencilOp
depthFailStencilOp
depthPassStencilOp
stencilReference
stencilMask
setCulling cullFace
withFragmentPassTests :: (MonadIO m, MonadMask m) => FragmentPassTests -> m a -> m a
withFragmentPassTests (FragmentPassTests {..}) action = do
was_it_enabled <- glIsEnabled gl_DEPTH_TEST
finally
(case depthTest of
Nothing -> glDisable gl_DEPTH_TEST >> next
Just dt -> glEnable gl_DEPTH_TEST >>
withDepthFunc dt writeDepth next) $
if was_it_enabled == fromIntegral gl_TRUE
then glEnable gl_DEPTH_TEST
else glDisable gl_DEPTH_TEST
where
next = do
was_it_enabled <- glIsEnabled gl_STENCIL_TEST
finally
(case stencilTest of
Nothing -> glDisable gl_STENCIL_TEST >> next'
Just st -> glEnable gl_STENCIL_TEST >>
withStencilFunc st
failStencilOp
depthFailStencilOp
depthPassStencilOp
stencilReference
stencilMask
next') $
if was_it_enabled == fromIntegral gl_TRUE
then glEnable gl_STENCIL_TEST
else glDisable gl_STENCIL_TEST
next' = withCulling cullFace action
data Culling =
Back
| Front
| FrontAndBack
| NoCulling
deriving ( Eq, Ord, Show, Read, Typeable )
cullingToConstant :: Culling -> GLenum
cullingToConstant Back = gl_BACK
cullingToConstant Front = gl_FRONT
cullingToConstant FrontAndBack = gl_FRONT_AND_BACK
cullingToConstant NoCulling = 0
data FragmentPassTests = FragmentPassTests {
depthTest :: !(Maybe ComparisonFunc)
, writeDepth :: Bool
, stencilTest :: !(Maybe ComparisonFunc)
, stencilReference :: !Word32
, stencilMask :: !Word32
, failStencilOp :: !StencilOp
, depthFailStencilOp :: !StencilOp
, depthPassStencilOp :: !StencilOp
, cullFace :: !Culling
}
deriving ( Eq, Ord, Show, Read, Typeable )
defaultFragmentPassTests :: FragmentPassTests
defaultFragmentPassTests = FragmentPassTests
{ depthTest = Nothing
, writeDepth = True
, stencilTest = Nothing
, stencilReference = 0
, stencilMask = 0xffffffff
, failStencilOp = Keep
, depthFailStencilOp = Keep
, depthPassStencilOp = Keep
, cullFace = Back }