{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

module Graphics.Glyph.ExtendedGL.Framebuffers where

import Control.Monad
import Data.StateVar
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import Graphics.GL.Compatibility30
import Graphics.GL.Core43
import Graphics.Glyph.ExtendedGL.Base
import qualified Graphics.Rendering.OpenGL as GL
import Unsafe.Coerce

class
  ( HasParamOfType GLuint FramebufferParameter a,
    HasIntegerParam GLenum a,
    IsGenerable a,
    IsBindable a,
    IsWrappedPrimitive GLuint a
  ) =>
  IsFramebuffer a
  where
  -- this function MUST discard the argument
  getType :: a -> GLenum

framebufferBasicParameteri :: (IsFramebuffer a) => GLenum -> a -> GLenum -> SettableStateVar GLuint
framebufferBasicParameteri typ fb enum =
  makeSettableStateVar
    ( \value -> do
        bind fb
        glFramebufferParameteri typ enum $ fromIntegral value
    )

data Renderbuffer = Renderbuffer GLuint

instance IsWrappedPrimitive GLuint Renderbuffer where
  unwrap (Renderbuffer x) = x

instance IsGenerable Renderbuffer where
  generate = alloca $ \ptr -> do
    glGenRenderbuffers 1 ptr
    liftM Renderbuffer $ peek ptr

instance IsBindable Renderbuffer where
  bind = glBindRenderbuffer GL_RENDERBUFFER . unwrap

data RenderbufferArgument
  = DepthAttachment

instance IsWrappedPrimitive GLenum RenderbufferArgument where
  unwrap DepthAttachment = GL_DEPTH_ATTACHMENT

renderBufferStorageRaw :: (IsGLEnumMarshallable a, IsGLEnumMarshallable b) => a -> b -> Int -> Int -> IO ()
renderBufferStorageRaw typ enum w h =
  glRenderbufferStorage
    (toGLEnum typ)
    (toGLEnum enum)
    (fromIntegral w)
    (fromIntegral h)

renderBufferStorage :: (IsGLEnumMarshallable a) => Renderbuffer -> SettableStateVar (a, Int, Int)
renderBufferStorage buffer = makeSettableStateVar $ \(en, w, h) -> do
  bind buffer
  renderBufferStorageRaw GL_RENDERBUFFER en w h

frameBufferRenderBuffer :: forall a b. (IsFramebuffer a, IsGLEnumMarshallable b) => Renderbuffer -> b -> IO a
frameBufferRenderBuffer rb e = do
  let enum :: GLenum
      enum = getType test
      unw :: GLuint
      unw = unwrap rb
  bind rb
  glFramebufferRenderbuffer enum (toGLEnum e) GL_RENDERBUFFER (unwrap rb)
  return $ wrap unw
  where
    test :: a
    test = coerced

data DrawFramebuffer = DrawFramebuffer GLuint

data FramebufferParameter = DefaultWidth | DefaultHeight

instance IsWrappedPrimitive GLenum FramebufferParameter where
  unwrap p = case p of
    DefaultWidth -> GL_FRAMEBUFFER_DEFAULT_WIDTH
    DefaultHeight -> GL_FRAMEBUFFER_DEFAULT_HEIGHT
  wrap x
    | x == GL_FRAMEBUFFER_DEFAULT_WIDTH = DefaultWidth
    | x == GL_FRAMEBUFFER_DEFAULT_HEIGHT = DefaultHeight
    | otherwise = undefined

instance HasIntegerParam GLenum DrawFramebuffer where
  parami p fb = framebufferBasicParameteri GL_DRAW_FRAMEBUFFER fb p

{- Has parameters of type GLuint which are acessable by the data FramebufferParameter for
 - the type DrawFramebuffer -}
instance HasParamOfType GLuint FramebufferParameter DrawFramebuffer where
  param = parami . toGLEnum

instance IsGenerable DrawFramebuffer where
  generate = alloca $ \ptr -> do
    glGenFramebuffers 1 ptr
    liftM DrawFramebuffer $ peek ptr

instance IsBindable DrawFramebuffer where
  bind (DrawFramebuffer fb) = glBindFramebuffer GL_DRAW_FRAMEBUFFER fb

instance IsWrappedPrimitive GLuint DrawFramebuffer where
  unwrap (DrawFramebuffer fb) = fb
  wrap = DrawFramebuffer

instance IsFramebuffer DrawFramebuffer where
  getType _ = GL_DRAW_FRAMEBUFFER