-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.PixellikeObject
-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016
-- License     :  BSD3
--
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-----------------------------------------------------------------------------

module Graphics.Rendering.OpenGL.GL.PixellikeObject (
  PixellikeObjectGetPName(..),
  PixellikeObjectTarget(pixellikeObjTarParam),
) where

import Data.StateVar
import Foreign.Marshal.Utils
import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment
import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget
import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.Texturing.Specification
import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
import Graphics.GL

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

data PixellikeObjectGetPName =
     RedSize
   | BlueSize
   | GreenSize
   | AlphaSize
   | DepthSize
   | StencilSize

class PixellikeObjectTarget t where
   --dummy t to include it in the type class
   marshalPixellikeOT :: t -> PixellikeObjectGetPName -> GLenum
   pixObjTarQueryFunc :: t -> GLenum -> IO GLint
   pixellikeObjTarParam :: t -> PixellikeObjectGetPName -> GettableStateVar GLint
   pixellikeObjTarParam t
t PixellikeObjectGetPName
p = forall a. IO a -> IO a
makeGettableStateVar (forall t.
PixellikeObjectTarget t =>
t -> GLenum -> GettableStateVar GLint
pixObjTarQueryFunc t
t forall a b. (a -> b) -> a -> b
$ forall t.
PixellikeObjectTarget t =>
t -> PixellikeObjectGetPName -> GLenum
marshalPixellikeOT t
t PixellikeObjectGetPName
p)

instance PixellikeObjectTarget RenderbufferTarget where
   marshalPixellikeOT :: RenderbufferTarget -> PixellikeObjectGetPName -> GLenum
marshalPixellikeOT RenderbufferTarget
_ PixellikeObjectGetPName
x = case PixellikeObjectGetPName
x of
      PixellikeObjectGetPName
RedSize -> GLenum
GL_RENDERBUFFER_RED_SIZE
      PixellikeObjectGetPName
BlueSize -> GLenum
GL_RENDERBUFFER_BLUE_SIZE
      PixellikeObjectGetPName
GreenSize -> GLenum
GL_RENDERBUFFER_GREEN_SIZE
      PixellikeObjectGetPName
AlphaSize -> GLenum
GL_RENDERBUFFER_ALPHA_SIZE
      PixellikeObjectGetPName
DepthSize -> GLenum
GL_RENDERBUFFER_DEPTH_SIZE
      PixellikeObjectGetPName
StencilSize -> GLenum
GL_RENDERBUFFER_STENCIL_SIZE
   pixObjTarQueryFunc :: RenderbufferTarget -> GLenum -> GettableStateVar GLint
pixObjTarQueryFunc RenderbufferTarget
t = forall a. RenderbufferTarget -> (GLint -> a) -> GLenum -> IO a
getRBParameteriv RenderbufferTarget
t forall a. a -> a
id

data FramebufferTargetAttachment =
    FramebufferTargetAttachment FramebufferTarget FramebufferObjectAttachment

instance PixellikeObjectTarget FramebufferTargetAttachment where
   marshalPixellikeOT :: FramebufferTargetAttachment -> PixellikeObjectGetPName -> GLenum
marshalPixellikeOT FramebufferTargetAttachment
_ PixellikeObjectGetPName
x = case PixellikeObjectGetPName
x of
      PixellikeObjectGetPName
RedSize -> GLenum
GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE
      PixellikeObjectGetPName
BlueSize -> GLenum
GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE
      PixellikeObjectGetPName
GreenSize -> GLenum
GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE
      PixellikeObjectGetPName
AlphaSize -> GLenum
GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE
      PixellikeObjectGetPName
DepthSize -> GLenum
GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE
      PixellikeObjectGetPName
StencilSize -> GLenum
GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE
   pixObjTarQueryFunc :: FramebufferTargetAttachment -> GLenum -> GettableStateVar GLint
pixObjTarQueryFunc (FramebufferTargetAttachment FramebufferTarget
fbt FramebufferObjectAttachment
fba) =
      forall fba a.
FramebufferAttachment fba =>
FramebufferTarget -> fba -> (GLint -> a) -> GLenum -> IO a
getFBAParameteriv FramebufferTarget
fbt FramebufferObjectAttachment
fba forall a. a -> a
id

data TextureTargetFull t = TextureTargetFull t Level

instance QueryableTextureTarget t => PixellikeObjectTarget (TextureTargetFull t) where
   marshalPixellikeOT :: TextureTargetFull t -> PixellikeObjectGetPName -> GLenum
marshalPixellikeOT TextureTargetFull t
_ PixellikeObjectGetPName
x = case PixellikeObjectGetPName
x of
      PixellikeObjectGetPName
RedSize -> GLenum
GL_TEXTURE_RED_SIZE
      PixellikeObjectGetPName
BlueSize -> GLenum
GL_TEXTURE_BLUE_SIZE
      PixellikeObjectGetPName
GreenSize -> GLenum
GL_TEXTURE_GREEN_SIZE
      PixellikeObjectGetPName
AlphaSize -> GLenum
GL_TEXTURE_ALPHA_SIZE
      PixellikeObjectGetPName
DepthSize -> GLenum
GL_TEXTURE_DEPTH_SIZE
      PixellikeObjectGetPName
StencilSize -> GLenum
GL_TEXTURE_STENCIL_SIZE
   pixObjTarQueryFunc :: TextureTargetFull t -> GLenum -> GettableStateVar GLint
pixObjTarQueryFunc (TextureTargetFull t
t GLint
level) GLenum
p =
      forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with GLint
0 forall a b. (a -> b) -> a -> b
$ \Ptr GLint
buf -> do
      forall (m :: * -> *).
MonadIO m =>
GLenum -> GLint -> GLenum -> Ptr GLint -> m ()
glGetTexLevelParameteriv (forall t. QueryableTextureTarget t => t -> GLenum
marshalQueryableTextureTarget t
t) GLint
level GLenum
p Ptr GLint
buf
      forall a b. Storable a => (a -> b) -> Ptr a -> IO b
peek1 forall a. a -> a
id Ptr GLint
buf