module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments (
FramebufferObjectAttachment(..),
fboaToBufferMode, fboaFromBufferMode,
maxColorAttachments,
FramebufferAttachment(..),
framebufferRenderbuffer, framebufferTexture1D, framebufferTexture2D,
framebufferTexture3D, framebufferTextureLayer,
getFBAParameteriv,
) where
import Data.Maybe (fromMaybe)
import Foreign.Marshal
import Graphics.Rendering.OpenGL.Raw.Core31
import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects
import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects
import Graphics.Rendering.OpenGL.GL.BufferMode
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.Texturing.Objects
import Graphics.Rendering.OpenGL.GL.Texturing.Specification
import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
data FramebufferObjectAttachment =
ColorAttachment !GLuint
| DepthAttachment
| StencilAttachment
| DepthStencilAttachment
deriving (Eq, Show)
marshalFramebufferObjectAttachment :: FramebufferObjectAttachment -> Maybe GLenum
marshalFramebufferObjectAttachment x = case x of
ColorAttachment c -> let ec = fromIntegral c in if ec >= maxColorAttachments
then Nothing
else Just $ gl_COLOR_ATTACHMENT0 + ec
DepthAttachment -> Just gl_DEPTH_ATTACHMENT
StencilAttachment -> Just gl_STENCIL_ATTACHMENT
DepthStencilAttachment -> Just gl_DEPTH_STENCIL_ATTACHMENT
fboaToBufferMode :: FramebufferObjectAttachment -> Maybe BufferMode
fboaToBufferMode (ColorAttachment i) = Just . FBOColorAttachment $ fromIntegral i
fboaToBufferMode _ = Nothing
fboaFromBufferMode :: BufferMode -> Maybe FramebufferObjectAttachment
fboaFromBufferMode (FBOColorAttachment i) = Just . ColorAttachment $ fromIntegral i
fboaFromBufferMode _ = Nothing
unmarshalFramebufferObjectAttachment :: GLenum -> FramebufferObjectAttachment
unmarshalFramebufferObjectAttachment x = maybe
(error $ "unmarshalFramebufferObjectAttachment: unknown enum value " ++ show x) id $
unmarshalFramebufferObjectAttachmentSafe x
unmarshalFramebufferObjectAttachmentSafe :: GLenum -> Maybe FramebufferObjectAttachment
unmarshalFramebufferObjectAttachmentSafe x
| x == gl_DEPTH_ATTACHMENT = Just DepthAttachment
| x == gl_STENCIL_ATTACHMENT = Just StencilAttachment
| x == gl_DEPTH_STENCIL_ATTACHMENT = Just DepthStencilAttachment
| x >= gl_COLOR_ATTACHMENT0 && x <= gl_COLOR_ATTACHMENT0 + maxColorAttachments
= Just . ColorAttachment . fromIntegral $ x gl_COLOR_ATTACHMENT0
| otherwise = Nothing
class Show a => FramebufferAttachment a where
marshalAttachment :: a -> Maybe GLenum
unmarshalAttachment :: GLenum -> a
unmarshalAttachmentSafe :: GLenum -> Maybe a
instance FramebufferAttachment FramebufferObjectAttachment where
marshalAttachment = marshalFramebufferObjectAttachment
unmarshalAttachment = unmarshalFramebufferObjectAttachment
unmarshalAttachmentSafe = unmarshalFramebufferObjectAttachmentSafe
instance FramebufferAttachment BufferMode where
marshalAttachment = marshalBufferMode
unmarshalAttachment = unmarshalBufferMode
unmarshalAttachmentSafe = unmarshalBufferModeSafe
framebufferRenderbuffer :: FramebufferTarget -> FramebufferObjectAttachment
-> RenderbufferTarget -> RenderbufferObject -> IO ()
framebufferRenderbuffer fbt fba rbt (RenderbufferObject rboi) =
maybe recordInvalidValue (\mfba -> glFramebufferRenderbuffer (marshalFramebufferTarget fbt)
mfba (marshalRenderbufferTarget rbt) rboi) $ marshalFramebufferObjectAttachment fba
framebufferTexture1D :: FramebufferTarget -> FramebufferObjectAttachment
-> TextureObject -> Level -> IO ()
framebufferTexture1D fbt fba (TextureObject t) l = maybe recordInvalidValue
(\mfba -> glFramebufferTexture1D (marshalFramebufferTarget fbt) mfba
(marshalTextureTarget Texture1D) t l) $ marshalFramebufferObjectAttachment fba
framebufferTexture2D :: FramebufferTarget -> FramebufferObjectAttachment
-> Maybe CubeMapTarget-> TextureObject -> Level -> IO ()
framebufferTexture2D fbt fba mcmt (TextureObject t) l = maybe recordInvalidValue
(\mfba -> glFramebufferTexture2D (marshalFramebufferTarget fbt) mfba
(maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mcmt) t l)
$ marshalFramebufferObjectAttachment fba
framebufferTexture3D :: FramebufferTarget -> FramebufferObjectAttachment
-> TextureObject -> Level -> GLint -> IO ()
framebufferTexture3D fbt fba (TextureObject t) le la = maybe recordInvalidValue
(\mfba -> glFramebufferTexture3D (marshalFramebufferTarget fbt) mfba
(marshalTextureTarget Texture1D) t le la) $ marshalFramebufferObjectAttachment fba
framebufferTextureLayer :: FramebufferTarget -> FramebufferObjectAttachment
-> TextureObject -> Level -> GLint -> IO()
framebufferTextureLayer fbt fba (TextureObject t) le la = maybe recordInvalidValue
(\mfba -> glFramebufferTextureLayer (marshalFramebufferTarget fbt)
mfba t le la) $ marshalFramebufferObjectAttachment fba
getFBAParameteriv :: FramebufferAttachment fba => FramebufferTarget -> fba
-> (GLint -> a) -> GLenum -> IO a
getFBAParameteriv fbt fba f p = alloca $ \buf -> do
glGetFramebufferAttachmentParameteriv (marshalFramebufferTarget fbt)
mfba p buf
peek1 f buf
where mfba = fromMaybe (error $ "invalid value" ++ show fba) (marshalAttachment fba)