{-# LANGUAGE RecordWildCards, NoImplicitPrelude, DeriveDataTypeable #-} module Graphics.Caramia.Render.Internal where import Graphics.Caramia.Prelude import Graphics.Caramia.Internal.OpenGLCApi import Control.Monad.IO.Class import Control.Monad.Catch -- | A comparison function. Incoming value is compared with this function to -- the existing value. -- -- This can be used with depth and stencil tests. -- -- See @ glDepthFunc @ from OpenGL specification or man pages for more detailed -- explanation. 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 -- | Stencil buffer operations. -- -- See @ glStencilOp @ for explanations of each constructor. data StencilOp = Keep | Zero | Replace -- ^ This one replaces the old value in the stencil buffer with the given -- reference value and ANDs the result with mask. | 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) {-# INLINE setStencilFunc #-} 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 == 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 (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 == 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 == GL_TRUE then glEnable GL_STENCIL_TEST else glDisable GL_STENCIL_TEST next' = withCulling cullFace action data Culling = Back | Front | FrontAndBack -- ^ This stops the drawing of any faces but points and lines -- (or other non-facey like primitives) are drawn. | 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 -- | Specifies the tests that are run on a fragment to decide if it should be -- seen. data FragmentPassTests = FragmentPassTests { depthTest :: !(Maybe ComparisonFunc) -- ^ Which depth test to use, if any? , writeDepth :: Bool -- ^ If depth test is specified, should we also update the depth buffer with -- new depth values? The depth buffer will not be written if `depthTest` is -- not specified regardless of the value in this field. , stencilTest :: !(Maybe ComparisonFunc) -- ^ Which stencil test to use, if any? , stencilReference :: !Word32 , stencilMask :: !Word32 , failStencilOp :: !StencilOp -- ^ What to do with the stencil buffer if stencil test fails. , depthFailStencilOp :: !StencilOp -- ^ What to do with the stencil buffer if stencil test passes but depth -- testing fails). , depthPassStencilOp :: !StencilOp -- ^ What to do with the stencil buffer if stencil and depth test passes, or -- if depth buffer is not present or depth test is disabled. , cullFace :: !Culling -- ^ What kind of face culling should we do. } deriving ( Eq, Ord, Show, Read, Typeable ) -- | Returns the default fragment pass tests. -- -- Neither depth or stencil test is enabled. `writeDepth` is set to true but -- that value is only used if you specify with depth test to use. -- -- All stencil operations are set to `Keep`. -- -- Culling is set to `Back`. defaultFragmentPassTests :: FragmentPassTests defaultFragmentPassTests = FragmentPassTests { depthTest = Nothing , writeDepth = True , stencilTest = Nothing , stencilReference = 0 , stencilMask = 0xffffffff , failStencilOp = Keep , depthFailStencilOp = Keep , depthPassStencilOp = Keep , cullFace = Back } -- TODO: separate stencil tests for backsides of triangles -- (glStencilOpSeparate)