-----------------------------------------------------------------------------
-- |
-- 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
t p :: PixellikeObjectGetPName
p = GettableStateVar GLint -> GettableStateVar GLint
forall a. IO a -> IO a
makeGettableStateVar (t -> GLenum -> GettableStateVar GLint
forall t.
PixellikeObjectTarget t =>
t -> GLenum -> GettableStateVar GLint
pixObjTarQueryFunc t
t (GLenum -> GettableStateVar GLint)
-> GLenum -> GettableStateVar GLint
forall a b. (a -> b) -> a -> b
$ t -> PixellikeObjectGetPName -> GLenum
forall t.
PixellikeObjectTarget t =>
t -> PixellikeObjectGetPName -> GLenum
marshalPixellikeOT t
t PixellikeObjectGetPName
p)

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

data FramebufferTargetAttachment =
    FramebufferTargetAttachment FramebufferTarget FramebufferObjectAttachment

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

data TextureTargetFull t = TextureTargetFull t Level

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