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

module Graphics.Glyph.ExtendedGL.Base where

import Control.Monad
import Data.Proxy
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 qualified Graphics.Rendering.OpenGL as GL
import System.IO.Unsafe
import Unsafe.Coerce

data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show, Enum)

class IsBindable a where
  bind :: a -> IO ()

class IsGLEnumMarshallable a where
  toGLEnum :: a -> GLenum

class IsGenerable a where
  generate :: IO a

class IsWrappedPrimitive t a where
  unwrap :: a -> t
  wrap :: t -> a

class HasIntegerParam t a where
  parami :: t -> a -> SettableStateVar GLuint

class HasFloatParam t a where
  paramf :: t -> a -> SettableStateVar GLfloat

class HasParamOfType b t a where
  param :: t -> a -> SettableStateVar b

class IsPrimitiveModeMarshallable a where
  marshalPrimitiveMode :: a -> GLuint

castPrimitive :: forall a b t. (IsWrappedPrimitive t a, IsWrappedPrimitive t b) => Proxy t -> a -> b
castPrimitive _ x = wrap unw
  where
    unw :: t
    unw = unwrap x

instance (IsWrappedPrimitive a a) where
  unwrap = id
  wrap = id

instance (IsWrappedPrimitive GLenum a) => IsGLEnumMarshallable a where
  toGLEnum = unwrap

instance IsPrimitiveModeMarshallable ExPrimitiveMode where
  marshalPrimitiveMode x = case x of
    Points -> GL_POINTS
    Triangles -> GL_TRIANGLES
    Lines -> GL_LINES
    Patches -> GL_PATCHES

instance IsPrimitiveModeMarshallable GL.PrimitiveMode where
  marshalPrimitiveMode x = case x of
    GL.Points -> 0x0
    GL.Lines -> 0x1
    GL.LineLoop -> 0x2
    GL.LineStrip -> 0x3
    GL.Triangles -> 0x4
    GL.TriangleStrip -> 0x5
    GL.TriangleFan -> 0x6
    GL.Quads -> 0x7
    GL.QuadStrip -> 0x8
    GL.Polygon -> 0x9

instance IsPrimitiveModeMarshallable GLuint where
  marshalPrimitiveMode = id

vertexAttributeDivisor :: GL.AttribLocation -> SettableStateVar GLuint
vertexAttributeDivisor (GL.AttribLocation loc) =
  makeSettableStateVar $ \val ->
    glVertexAttribDivisor loc val

{- Sets the number of vertices per patch
 - for OpenGL -}
patchVertices :: (Integral a) => SettableStateVar a
patchVertices =
  makeSettableStateVar $ \val ->
    glPatchParameteri GL_PATCH_VERTICES $ fromIntegral val

{- Returns the maximum number of patches
 - for a tessilation shader -}
maxPatchVertices :: IO CInt
maxPatchVertices =
  alloca $ \ptr -> do
    glGetIntegerv GL_MAX_PATCH_VERTICES ptr
    fromIntegral <$> peek ptr

getGLVersion :: IO String
getGLVersion =
  let lift2 (a, b) = do
        x <- a
        y <- b
        return (x, y)
   in alloca $ \ptr1 -> alloca $ \ptr2 -> do
        glGetIntegerv GL_MAJOR_VERSION ptr1
        glGetIntegerv GL_MINOR_VERSION ptr2
        (v1, v2) <- lift2 (peek ptr1, peek ptr2)
        return ("OpenGL " ++ show v1 ++ "." ++ show v2)

coerced :: a
coerced = unsafeCoerce (0 :: Int)