3 files changed, 52 insertions, 33 deletions
diff --git a/Graphics/Glyph/ExtendedGL.hs b/Graphics/Glyph/ExtendedGL.hs
index 7742ba8..86258e1 100644
--- a/Graphics/Glyph/ExtendedGL.hs
+++ b/Graphics/Glyph/ExtendedGL.hs
@@ -1,6 +1,7 @@
 module Graphics.Glyph.ExtendedGL where
 
-import Graphics.Rendering.OpenGL
+import Graphics.Rendering.OpenGL hiding (Points,Lines,Triangles)
+import qualified Graphics.Rendering.OpenGL as GL
 import Graphics.Rendering.OpenGL.Raw.Core31
 import Graphics.Rendering.OpenGL.Raw.ARB
 
@@ -12,20 +13,33 @@ import Foreign.C.Types
 import System.IO.Unsafe
 import Control.Monad
 
-marshalPrimitiveMode :: PrimitiveMode -> GLenum
-marshalPrimitiveMode x = case x of
-   Points -> 0x0
-   Lines -> 0x1
-   LineLoop -> 0x2
-   LineStrip -> 0x3
-   Triangles -> 0x4
-   TriangleStrip -> 0x5
-   TriangleFan -> 0x6
-   Quads -> 0x7
-   QuadStrip -> 0x8
-   Polygon -> 0x9
-
-drawArraysInstanced :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> GLsizei -> IO ()
+data ExPrimitiveMode = Points | Triangles | Lines | Patches deriving (Show,Enum)
+
+class IsPrimitiveModeMarshallable a where
+    marshalPrimitiveMode :: a -> GLuint
+
+instance IsPrimitiveModeMarshallable ExPrimitiveMode where
+    marshalPrimitiveMode x = case x of
+        Points    -> gl_POINTS
+        Triangles -> gl_TRIANGLES
+        Lines     -> gl_LINES
+        Patches   -> gl_PATCHES
+
+instance IsPrimitiveModeMarshallable 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
+
+drawArraysInstanced :: 
+    (IsPrimitiveModeMarshallable a) => a -> ArrayIndex -> NumArrayIndices -> GLsizei -> IO ()
 drawArraysInstanced = glDrawArraysInstanced . marshalPrimitiveMode
 
 vertexAttributeDivisor :: AttribLocation -> SettableStateVar GLuint
diff --git a/Graphics/Glyph/GlyphObject.hs b/Graphics/Glyph/GlyphObject.hs
index a000aa7..29d25bb 100644
--- a/Graphics/Glyph/GlyphObject.hs
+++ b/Graphics/Glyph/GlyphObject.hs
@@ -33,7 +33,7 @@ module Graphics.Glyph.GlyphObject (
 import Graphics.Glyph.BufferBuilder
 import Graphics.Glyph.Util
 import Graphics.Rendering.OpenGL
-import Graphics.Glyph.ExtendedGL
+import Graphics.Glyph.ExtendedGL as Ex
 import Data.Setters
 
 import Control.Monad
@@ -55,7 +55,7 @@ data GlyphObject a = GlyphObject {
     setupRoutine :: (Maybe (GlyphObject a -> IO ())), -- Setup
     setupRoutine2 :: (Maybe (GlyphObject a -> IO ())), -- Setup
     teardownRoutine :: (Maybe (GlyphObject a -> IO ())), -- Tear down
-    primitiveMode :: PrimitiveMode,
+    primitiveMode :: ExPrimitiveMode,
     numInstances :: Int
 }
 
@@ -87,7 +87,7 @@ getSetupRoutine = setupRoutine
 getTeardownRoutine :: GlyphObject a -> (Maybe (GlyphObject a -> IO ()))
 getTeardownRoutine = teardownRoutine
 
-getPrimitiveMode :: GlyphObject a -> PrimitiveMode
+getPrimitiveMode :: GlyphObject a -> ExPrimitiveMode
 getPrimitiveMode = primitiveMode
 
 newGlyphObject :: BuilderM GLfloat x ->
@@ -98,7 +98,7 @@ newGlyphObject :: BuilderM GLfloat x ->
     a ->
     Maybe (GlyphObject a -> IO ()) ->
     Maybe (GlyphObject a -> IO ()) ->
-    PrimitiveMode ->
+    ExPrimitiveMode ->
     IO (GlyphObject a)
 
 newGlyphObject builder vertAttr normAttr colorAttr textureAttr res setup tear mode = do
@@ -164,7 +164,7 @@ newDefaultGlyphObject builder resources =
                                        resources
                                        Nothing -- setup
                                        Nothing -- teardown
-                                       Triangles -- primitive
+                                       Ex.Triangles -- primitive
 
 newDefaultGlyphObjectWithClosure :: BuilderM GLfloat x -> a -> (GlyphObject a -> IO ()) -> IO (GlyphObject a)
 newDefaultGlyphObjectWithClosure builder res func =
diff --git a/Graphics/Glyph/Shaders.hs b/Graphics/Glyph/Shaders.hs
index c11886d..296e4a8 100644
--- a/Graphics/Glyph/Shaders.hs
+++ b/Graphics/Glyph/Shaders.hs
@@ -18,26 +18,31 @@ class IsShaderSource a where
     loadShader :: ShaderType -> a -> IO (String, Maybe Shader)
 
 instance IsShaderSource FilePath where
-    loadShader typ path = loadShader typ =<< BS.readFile path
+    loadShader typ path = loadShaderBS path typ =<< BS.readFile path
 
 instance IsShaderSource BS.ByteString where
-    loadShader typ src = do
-        shader <- createShader typ
-        shaderSourceBS shader $= src
-        compileShader shader
-    
-        ok <- get (compileStatus shader)
-        infoLog <- get (shaderInfoLog shader)
-    
-        unless ok $
-            deleteObjectNames [shader]
-    
-        return ( infoLog, if not ok then Nothing else Just shader );
+    loadShader = loadShaderBS "Inlined"
 
 instance IsShaderSource BSL.ByteString where
     loadShader typ = loadShader typ . toStrict
         where toStrict = BS.concat . BSL.toChunks
 
+loadShaderBS :: String -> ShaderType -> BS.ByteString -> IO (String, Maybe Shader)
+loadShaderBS ctx typ src = do
+    shader <- createShader typ
+    shaderSourceBS shader $= src
+    compileShader shader
+
+    ok <- get (compileStatus shader)
+    infoLog <- get (shaderInfoLog shader)
+
+    unless ok $
+        deleteObjectNames [shader]
+
+    if not ok then
+        return ( unlines $ map ((ctx ++ " " ++ show typ ++ ": ")++) $ lines infoLog, Nothing )
+        else return ( infoLog, Just shader );
+
 
 {- Load multiple shaders -}
 loadShaders :: (IsShaderSource a) => [(ShaderType,a)] -> IO [(String, Maybe Shader)]