{-# OPTIONS_HADDOCK hide #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment
-- Copyright   :  (c) Sven Panne 2013-2019
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This is a purely internal module for marshaling FramebufferObjectAttachments.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment (
   FramebufferObjectAttachment(..),
   marshalFramebufferObjectAttachment,
   unmarshalFramebufferObjectAttachment,
   unmarshalFramebufferObjectAttachmentSafe,
   fboaToBufferMode, fboaFromBufferMode,

   FramebufferAttachment(..), getFBAParameteriv
) where

import Data.Maybe
import Foreign.Marshal
import Graphics.Rendering.OpenGL.GL.BufferMode
import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.GL

--------------------------------------------------------------------------------

data FramebufferObjectAttachment =
     ColorAttachment !GLuint
   | DepthAttachment
   | StencilAttachment
   | DepthStencilAttachment
   deriving ( FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
(FramebufferObjectAttachment
 -> FramebufferObjectAttachment -> Bool)
-> (FramebufferObjectAttachment
    -> FramebufferObjectAttachment -> Bool)
-> Eq FramebufferObjectAttachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
$c/= :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
== :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
$c== :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
Eq, Eq FramebufferObjectAttachment
Eq FramebufferObjectAttachment =>
(FramebufferObjectAttachment
 -> FramebufferObjectAttachment -> Ordering)
-> (FramebufferObjectAttachment
    -> FramebufferObjectAttachment -> Bool)
-> (FramebufferObjectAttachment
    -> FramebufferObjectAttachment -> Bool)
-> (FramebufferObjectAttachment
    -> FramebufferObjectAttachment -> Bool)
-> (FramebufferObjectAttachment
    -> FramebufferObjectAttachment -> Bool)
-> (FramebufferObjectAttachment
    -> FramebufferObjectAttachment -> FramebufferObjectAttachment)
-> (FramebufferObjectAttachment
    -> FramebufferObjectAttachment -> FramebufferObjectAttachment)
-> Ord FramebufferObjectAttachment
FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
FramebufferObjectAttachment
-> FramebufferObjectAttachment -> Ordering
FramebufferObjectAttachment
-> FramebufferObjectAttachment -> FramebufferObjectAttachment
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FramebufferObjectAttachment
-> FramebufferObjectAttachment -> FramebufferObjectAttachment
$cmin :: FramebufferObjectAttachment
-> FramebufferObjectAttachment -> FramebufferObjectAttachment
max :: FramebufferObjectAttachment
-> FramebufferObjectAttachment -> FramebufferObjectAttachment
$cmax :: FramebufferObjectAttachment
-> FramebufferObjectAttachment -> FramebufferObjectAttachment
>= :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
$c>= :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
> :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
$c> :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
<= :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
$c<= :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
< :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
$c< :: FramebufferObjectAttachment -> FramebufferObjectAttachment -> Bool
compare :: FramebufferObjectAttachment
-> FramebufferObjectAttachment -> Ordering
$ccompare :: FramebufferObjectAttachment
-> FramebufferObjectAttachment -> Ordering
$cp1Ord :: Eq FramebufferObjectAttachment
Ord, Int -> FramebufferObjectAttachment -> ShowS
[FramebufferObjectAttachment] -> ShowS
FramebufferObjectAttachment -> String
(Int -> FramebufferObjectAttachment -> ShowS)
-> (FramebufferObjectAttachment -> String)
-> ([FramebufferObjectAttachment] -> ShowS)
-> Show FramebufferObjectAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FramebufferObjectAttachment] -> ShowS
$cshowList :: [FramebufferObjectAttachment] -> ShowS
show :: FramebufferObjectAttachment -> String
$cshow :: FramebufferObjectAttachment -> String
showsPrec :: Int -> FramebufferObjectAttachment -> ShowS
$cshowsPrec :: Int -> FramebufferObjectAttachment -> ShowS
Show )

marshalFramebufferObjectAttachment :: FramebufferObjectAttachment -> Maybe GLenum
marshalFramebufferObjectAttachment :: FramebufferObjectAttachment -> Maybe GLenum
marshalFramebufferObjectAttachment x :: FramebufferObjectAttachment
x = case FramebufferObjectAttachment
x of
   ColorAttachment c :: GLenum
c -> let ec :: GLenum
ec = GLenum -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
c in if GLenum
ec GLenum -> GLenum -> Bool
forall a. Ord a => a -> a -> Bool
>= GLenum
maxColorAttachments
      then Maybe GLenum
forall a. Maybe a
Nothing
      else GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just (GLenum -> Maybe GLenum) -> GLenum -> Maybe GLenum
forall a b. (a -> b) -> a -> b
$ GLenum
GL_COLOR_ATTACHMENT0 GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
+ GLenum
ec
   DepthAttachment -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_DEPTH_ATTACHMENT
   StencilAttachment -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_STENCIL_ATTACHMENT
   DepthStencilAttachment -> GLenum -> Maybe GLenum
forall a. a -> Maybe a
Just GLenum
GL_DEPTH_STENCIL_ATTACHMENT

unmarshalFramebufferObjectAttachment :: GLenum -> FramebufferObjectAttachment
unmarshalFramebufferObjectAttachment :: GLenum -> FramebufferObjectAttachment
unmarshalFramebufferObjectAttachment x :: GLenum
x = FramebufferObjectAttachment
-> (FramebufferObjectAttachment -> FramebufferObjectAttachment)
-> Maybe FramebufferObjectAttachment
-> FramebufferObjectAttachment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
   (String -> FramebufferObjectAttachment
forall a. HasCallStack => String -> a
error (String -> FramebufferObjectAttachment)
-> String -> FramebufferObjectAttachment
forall a b. (a -> b) -> a -> b
$ "unmarshalFramebufferObjectAttachment: unknown enum value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GLenum -> String
forall a. Show a => a -> String
show GLenum
x) FramebufferObjectAttachment -> FramebufferObjectAttachment
forall a. a -> a
id (Maybe FramebufferObjectAttachment -> FramebufferObjectAttachment)
-> Maybe FramebufferObjectAttachment -> FramebufferObjectAttachment
forall a b. (a -> b) -> a -> b
$
      GLenum -> Maybe FramebufferObjectAttachment
unmarshalFramebufferObjectAttachmentSafe GLenum
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 :: GLenum -> Maybe FramebufferObjectAttachment
unmarshalFramebufferObjectAttachmentSafe x :: GLenum
x
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEPTH_ATTACHMENT = FramebufferObjectAttachment -> Maybe FramebufferObjectAttachment
forall a. a -> Maybe a
Just FramebufferObjectAttachment
DepthAttachment
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_STENCIL_ATTACHMENT = FramebufferObjectAttachment -> Maybe FramebufferObjectAttachment
forall a. a -> Maybe a
Just FramebufferObjectAttachment
StencilAttachment
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Eq a => a -> a -> Bool
== GLenum
GL_DEPTH_STENCIL_ATTACHMENT = FramebufferObjectAttachment -> Maybe FramebufferObjectAttachment
forall a. a -> Maybe a
Just FramebufferObjectAttachment
DepthStencilAttachment
   | GLenum
x GLenum -> GLenum -> Bool
forall a. Ord a => a -> a -> Bool
>= GLenum
GL_COLOR_ATTACHMENT0 Bool -> Bool -> Bool
&& GLenum
x GLenum -> GLenum -> Bool
forall a. Ord a => a -> a -> Bool
<= GLenum
GL_COLOR_ATTACHMENT0 GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
+ GLenum
maxColorAttachments
      = FramebufferObjectAttachment -> Maybe FramebufferObjectAttachment
forall a. a -> Maybe a
Just (FramebufferObjectAttachment -> Maybe FramebufferObjectAttachment)
-> (GLenum -> FramebufferObjectAttachment)
-> GLenum
-> Maybe FramebufferObjectAttachment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> FramebufferObjectAttachment
ColorAttachment (GLenum -> FramebufferObjectAttachment)
-> (GLenum -> GLenum) -> GLenum -> FramebufferObjectAttachment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GLenum -> Maybe FramebufferObjectAttachment)
-> GLenum -> Maybe FramebufferObjectAttachment
forall a b. (a -> b) -> a -> b
$ GLenum
x GLenum -> GLenum -> GLenum
forall a. Num a => a -> a -> a
- GLenum
GL_COLOR_ATTACHMENT0
   | Bool
otherwise = Maybe FramebufferObjectAttachment
forall a. Maybe a
Nothing

fboaToBufferMode :: FramebufferObjectAttachment -> Maybe BufferMode
fboaToBufferMode :: FramebufferObjectAttachment -> Maybe BufferMode
fboaToBufferMode (ColorAttachment i :: GLenum
i) = BufferMode -> Maybe BufferMode
forall a. a -> Maybe a
Just (BufferMode -> Maybe BufferMode)
-> (GLsizei -> BufferMode) -> GLsizei -> Maybe BufferMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLsizei -> BufferMode
FBOColorAttachment (GLsizei -> Maybe BufferMode) -> GLsizei -> Maybe BufferMode
forall a b. (a -> b) -> a -> b
$ GLenum -> GLsizei
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLenum
i
fboaToBufferMode _                   = Maybe BufferMode
forall a. Maybe a
Nothing

fboaFromBufferMode :: BufferMode -> Maybe FramebufferObjectAttachment
fboaFromBufferMode :: BufferMode -> Maybe FramebufferObjectAttachment
fboaFromBufferMode (FBOColorAttachment i :: GLsizei
i) = FramebufferObjectAttachment -> Maybe FramebufferObjectAttachment
forall a. a -> Maybe a
Just (FramebufferObjectAttachment -> Maybe FramebufferObjectAttachment)
-> (GLenum -> FramebufferObjectAttachment)
-> GLenum
-> Maybe FramebufferObjectAttachment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GLenum -> FramebufferObjectAttachment
ColorAttachment (GLenum -> Maybe FramebufferObjectAttachment)
-> GLenum -> Maybe FramebufferObjectAttachment
forall a b. (a -> b) -> a -> b
$ GLsizei -> GLenum
forall a b. (Integral a, Num b) => a -> b
fromIntegral GLsizei
i
fboaFromBufferMode _                      = Maybe FramebufferObjectAttachment
forall a. Maybe a
Nothing

-----------------------------------------------------------------------------

class Show a => FramebufferAttachment a where
   marshalAttachment :: a -> Maybe GLenum
   unmarshalAttachment :: GLenum -> a
   unmarshalAttachmentSafe :: GLenum -> Maybe a

instance FramebufferAttachment FramebufferObjectAttachment where
   marshalAttachment :: FramebufferObjectAttachment -> Maybe GLenum
marshalAttachment = FramebufferObjectAttachment -> Maybe GLenum
marshalFramebufferObjectAttachment
   unmarshalAttachment :: GLenum -> FramebufferObjectAttachment
unmarshalAttachment = GLenum -> FramebufferObjectAttachment
unmarshalFramebufferObjectAttachment
   unmarshalAttachmentSafe :: GLenum -> Maybe FramebufferObjectAttachment
unmarshalAttachmentSafe = GLenum -> Maybe FramebufferObjectAttachment
unmarshalFramebufferObjectAttachmentSafe

instance FramebufferAttachment BufferMode where
   marshalAttachment :: BufferMode -> Maybe GLenum
marshalAttachment = BufferMode -> Maybe GLenum
marshalBufferMode
   unmarshalAttachment :: GLenum -> BufferMode
unmarshalAttachment = GLenum -> BufferMode
unmarshalBufferMode
   unmarshalAttachmentSafe :: GLenum -> Maybe BufferMode
unmarshalAttachmentSafe = GLenum -> Maybe BufferMode
unmarshalBufferModeSafe

-----------------------------------------------------------------------------

getFBAParameteriv :: FramebufferAttachment fba => FramebufferTarget -> fba
    -> (GLint -> a) -> GLenum -> IO a
getFBAParameteriv :: FramebufferTarget -> fba -> (GLsizei -> a) -> GLenum -> IO a
getFBAParameteriv fbt :: FramebufferTarget
fbt fba :: fba
fba f :: GLsizei -> a
f p :: GLenum
p = GLsizei -> (Ptr GLsizei -> IO a) -> IO a
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 0 ((Ptr GLsizei -> IO a) -> IO a) -> (Ptr GLsizei -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \buf :: Ptr GLsizei
buf -> do
   GLenum -> GLenum -> GLenum -> Ptr GLsizei -> IO ()
forall (m :: * -> *).
MonadIO m =>
GLenum -> GLenum -> GLenum -> Ptr GLsizei -> m ()
glGetFramebufferAttachmentParameteriv (FramebufferTarget -> GLenum
marshalFramebufferTarget FramebufferTarget
fbt)
      GLenum
mfba GLenum
p Ptr GLsizei
buf
   (GLsizei -> a) -> Ptr GLsizei -> IO a
forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 GLsizei -> a
f Ptr GLsizei
buf
      where mfba :: GLenum
mfba = GLenum -> Maybe GLenum -> GLenum
forall a. a -> Maybe a -> a
fromMaybe (String -> GLenum
forall a. HasCallStack => String -> a
error (String -> GLenum) -> String -> GLenum
forall a b. (a -> b) -> a -> b
$ "invalid value" String -> ShowS
forall a. [a] -> [a] -> [a]
++ fba -> String
forall a. Show a => a -> String
show fba
fba) (fba -> Maybe GLenum
forall a. FramebufferAttachment a => a -> Maybe GLenum
marshalAttachment fba
fba)