    -----------------------------------------------------------------------------
    --
    -- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments
    -- Copyright   :
    -- License     :  BSD3
    --
    -- Maintainer  :  Sven Panne <sven.panne@aedion.de>
    -- Stability   :
    -- Portability :
    --
    -- |
    --
    -----------------------------------------------------------------------------

    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
    --unmarshalFramebufferObjectAttachment x
    --   | x == gl_DEPTH_ATTACHMENT = DepthAttachment
    --   | x == gl_STENCIL_ATTACHMENT = StencilAttachment
    --   | x == gl_DEPTH_STENCIL_ATTACHMENT = DepthStencilAttachment
    --   | x >= gl_COLOR_ATTACHMENT0 && x <= gl_COLOR_ATTACHMENT15
    --      = ColorAttachment . fromIntegral $ x - gl_COLOR_ATTACHMENT0
    --   | otherwise = error $ "unmarshalFramebufferObjectAttachment: unknown enum value " ++ show 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)