1 files changed, 117 insertions, 0 deletions
diff --git a/Graphics/Glyph/ExtendedGL/Base.hs b/Graphics/Glyph/ExtendedGL/Base.hs
new file mode 100644
index 0000000..48f61a5
--- /dev/null
+++ b/Graphics/Glyph/ExtendedGL/Base.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Graphics.Glyph.ExtendedGL.Base where
+
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Graphics.Rendering.OpenGL.Raw.ARB
+
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+
+import System.IO.Unsafe
+import Control.Monad
+
+import Data.StateVar
+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) => 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
+
+drawArraysInstanced ::
+ (IsPrimitiveModeMarshallable a) => 
+    a -> GL.ArrayIndex ->
+    GL.NumArrayIndices ->
+    GLsizei -> IO ()
+drawArraysInstanced = glDrawArraysInstanced . marshalPrimitiveMode
+
+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
+            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)