module Graphics.Caramia.Blend.Internal where
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Data ( Data )
import Foreign
import GHC.Generics ( Generic )
import Graphics.Caramia.Color
import Graphics.Caramia.Internal.OpenGLCApi
import Graphics.Caramia.Prelude
data BlendEquation =
BEAdd
| BESubtract
| BEReverseSubtract
| BEMin
| BEMax
deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic )
data BlendFunc =
BFZero
| BFOne
| BFSrcColor
| BFOneMinusSrcColor
| BFDstColor
| BFOneMinusDstColor
| BFSrcAlpha
| BFOneMinusSrcAlpha
| BFDstAlpha
| BFOneMinusDstAlpha
| BFConstantColor
| BFOneMinusConstantColor
| BFConstantAlpha
| BFOneMinusConstantAlpha
| BFSrcAlphaSaturate
deriving ( Eq, Ord, Show, Read, Typeable, Enum, Data, Generic )
toConstantBE :: BlendEquation -> GLenum
toConstantBE BEAdd = GL_FUNC_ADD
toConstantBE BESubtract = GL_FUNC_SUBTRACT
toConstantBE BEReverseSubtract = GL_FUNC_REVERSE_SUBTRACT
toConstantBE BEMin = GL_MIN
toConstantBE BEMax = GL_MAX
toConstantBF :: BlendFunc -> GLenum
toConstantBF BFZero = GL_ZERO
toConstantBF BFOne = GL_ONE
toConstantBF BFSrcColor = GL_SRC_COLOR
toConstantBF BFOneMinusSrcColor = GL_ONE_MINUS_SRC_COLOR
toConstantBF BFDstColor = GL_DST_COLOR
toConstantBF BFOneMinusDstColor = GL_ONE_MINUS_DST_COLOR
toConstantBF BFSrcAlpha = GL_SRC_ALPHA
toConstantBF BFOneMinusSrcAlpha = GL_ONE_MINUS_SRC_ALPHA
toConstantBF BFDstAlpha = GL_DST_ALPHA
toConstantBF BFOneMinusDstAlpha = GL_ONE_MINUS_DST_ALPHA
toConstantBF BFConstantColor = GL_CONSTANT_COLOR
toConstantBF BFOneMinusConstantColor = GL_ONE_MINUS_CONSTANT_COLOR
toConstantBF BFConstantAlpha = GL_CONSTANT_ALPHA
toConstantBF BFOneMinusConstantAlpha = GL_ONE_MINUS_CONSTANT_ALPHA
toConstantBF BFSrcAlphaSaturate = GL_SRC_ALPHA_SATURATE
data BlendSpec = BlendSpec
{ alphaEquation :: !BlendEquation
, colorEquation :: !BlendEquation
, srcColorFunc :: !BlendFunc
, srcAlphaFunc :: !BlendFunc
, dstColorFunc :: !BlendFunc
, dstAlphaFunc :: !BlendFunc
, blendColor :: !Color }
deriving ( Eq, Ord, Show, Read, Typeable, Data, Generic )
setBlendings :: MonadIO m => BlendSpec -> m ()
setBlendings (BlendSpec{..}) = do
glBlendFuncSeparate (toConstantBF srcColorFunc)
(toConstantBF dstColorFunc)
(toConstantBF srcAlphaFunc)
(toConstantBF dstAlphaFunc)
glBlendEquationSeparate (toConstantBE colorEquation)
(toConstantBE alphaEquation)
glBlendColor (viewRed blendColor)
(viewGreen blendColor)
(viewBlue blendColor)
(viewAlpha blendColor)
withBlendings :: (MonadIO m, MonadMask m)
=> BlendSpec
-> m a
-> m a
withBlendings spec@(BlendSpec {..}) action = do
old_be_color <- gi GL_BLEND_EQUATION_RGB
old_be_alpha <- gi GL_BLEND_EQUATION_ALPHA
old_src_color <- gi GL_BLEND_SRC_RGB
old_src_alpha <- gi GL_BLEND_SRC_ALPHA
old_dst_color <- gi GL_BLEND_DST_RGB
old_dst_alpha <- gi GL_BLEND_DST_ALPHA
(r, g, b, a) <- liftIO $ allocaArray 4 $ \color_ptr -> do
glGetFloatv GL_BLEND_COLOR color_ptr
r <- peekElemOff color_ptr 0
g <- peekElemOff color_ptr 1
b <- peekElemOff color_ptr 2
a <- peekElemOff color_ptr 3
return (r, g, b, a)
finally (setBlendings spec >> action) $ do
glBlendColor r g b a
glBlendFuncSeparate old_src_color
old_dst_color
old_src_alpha
old_dst_alpha
glBlendEquationSeparate old_be_color
old_be_alpha