Move shader compilation over to raw opengl, errors display incorrect

src/Shader/Compile.hs

@@ -1,10 +1,16 @@
 module Shader.Compile
     ( makeShader
+    , makeShader'
     , makeByteStringShader
+    , makeByteStringShader'
     , makeByteStringShaderUsingVAO
+    , makeByteStringShaderUsingVAO'
     , makeShaderSized
+    , makeShaderSized'
     , makeShaderUsingShaderVAO
+    , makeShaderUsingShaderVAO'
     , makeShaderUsingVAO
+    , makeShaderUsingVAO'
     , makeSourcedShader
     , setupVAO
     , setupVertexAttribPointer 
@@ -39,6 +45,22 @@ makeShader s shaderlist sizes pm = do
         , _shadTex  = Nothing
         , _shadUnis = mempty
         }
+makeShader' 
+    :: String       -- ^ First part of the name of the shader
+    -> [GLenum] -- ^ shader types
+    -> [Int]   -- ^ The input vertex sizes
+    -> EPrimitiveMode 
+    -> IO FullShader'
+makeShader' s shaderlist sizes pm = do
+    prog <- makeSourcedShader' s shaderlist
+    vaob <- setupVAO sizes
+    return $ FullShader'
+        { _shadProg' = prog
+        , _shadVAO'  = vaob
+        , _shadPrim' = pm
+        , _shadTex'  = Nothing
+        , _shadUnis' = mempty
+        }
 
 makeByteStringShader'
     :: String       -- ^ (Arbitrary) name of the shader
@@ -88,6 +110,21 @@ makeByteStringShaderUsingVAO s shaderlist pm fs = do
         , _shadUnis = mempty
         }
 
+makeByteStringShaderUsingVAO'
+    :: String       -- ^ (Arbitrary) name of the shader
+    -> [(GLenum,BS.ByteString)] -- ^ Filetype extensions and shader data
+    -> EPrimitiveMode 
+    -> FullShader'
+    -> IO FullShader'
+makeByteStringShaderUsingVAO' s shaderlist pm fs = do
+    prog <- makeShaderProgram' s shaderlist
+    return $ fs 
+        { _shadProg' = prog
+        , _shadPrim' = pm
+        , _shadTex'  = Nothing
+        , _shadUnis' = mempty
+        }
+
 -- | Takes the VAO from elsewhere
 makeShaderUsingVAO
     :: String       -- ^ First part of the name of the shader
@@ -104,6 +141,21 @@ makeShaderUsingVAO s shaderlist pm theVAO = do
         , _shadTex  = Nothing
         , _shadUnis = mempty
         }
+makeShaderUsingVAO'
+    :: String       -- ^ First part of the name of the shader
+    -> [GLenum] -- ^ shader types
+    -> EPrimitiveMode
+    -> VAO
+    -> IO FullShader'
+makeShaderUsingVAO' s shaderlist pm theVAO = do
+    prog <- makeSourcedShader' s shaderlist
+    return $ FullShader' 
+        { _shadProg' = prog
+        , _shadVAO' = theVAO
+        , _shadPrim' = pm
+        , _shadTex'  = Nothing
+        , _shadUnis' = mempty
+        }
 
 -- | Takes the VAO from another shader
 makeShaderUsingShaderVAO
@@ -120,6 +172,20 @@ makeShaderUsingShaderVAO s shaderlist pm fs = do
         , _shadTex  = Nothing
         , _shadUnis = mempty
         }
+makeShaderUsingShaderVAO'
+    :: String       -- ^ First part of the name of the shader
+    -> [GLenum]     -- ^ shader types
+    -> EPrimitiveMode
+    -> FullShader'
+    -> IO FullShader'
+makeShaderUsingShaderVAO' s shaderlist pm fs = do
+    prog <- makeSourcedShader' s shaderlist
+    return $ fs 
+        { _shadProg' = prog
+        , _shadPrim' = pm
+        , _shadTex'  = Nothing
+        , _shadUnis' = mempty
+        }
 {- | 
 Compiles a full shader found within the shader directory.
 The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
@@ -141,6 +207,23 @@ makeShaderSized s shaderlist sizes ndraw pm = do
         , _shadTex  = Nothing
         , _shadUnis = mempty
         }
+makeShaderSized'
+    :: String       -- ^ First part of the name of the shader
+    -> [GLenum] -- ^ shader types
+    -> [Int]   -- ^ The input vertex sizes
+    -> Int          -- ^ Number of vertexes that can be poked
+    -> EPrimitiveMode
+    -> IO FullShader'
+makeShaderSized' s shaderlist sizes ndraw pm = do
+    prog <- makeSourcedShader' s shaderlist
+    vaob <- setupVAOSized sizes ndraw
+    return $ FullShader' 
+        { _shadProg' = prog
+        , _shadVAO'  = vaob
+        , _shadPrim' = pm
+        , _shadTex'  = Nothing
+        , _shadUnis' = mempty
+        }
 
 -- | Compile shader and get its uniform locations.
 -- supposes the shader code is in the shader folder, with the string names
@@ -150,13 +233,24 @@ makeSourcedShader s sts = do
     sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
     makeShaderProgram s $ zip sts sources
 
+makeSourcedShader' :: String -> [GLenum] -> IO GLuint
+makeSourcedShader' s sts = do
+    sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt' st)
+    makeShaderProgram' s $ zip sts sources
+
 shaderTypeExt :: ShaderType -> String
 shaderTypeExt VertexShader   = ".vert"
 shaderTypeExt GeometryShader = ".geom"
 shaderTypeExt FragmentShader = ".frag"
 shaderTypeExt _ = undefined
 
--- I think that this requires that the correct shader program is bound...
+shaderTypeExt' :: GLenum -> String
+shaderTypeExt' GL_VERTEX_SHADER   = ".vert"
+shaderTypeExt' GL_GEOMETRY_SHADER = ".geom"
+shaderTypeExt' GL_FRAGMENT_SHADER = ".frag"
+shaderTypeExt' _ = undefined
+
+-- I think that this requires that the correct shader program is bound?
 setupVAO :: [Int] -> IO VAO
 setupVAO sizes = do
     theVAO <- genObjectName
@@ -244,12 +338,20 @@ makeShaderProgram' :: String
 makeShaderProgram' str srcs = do
     theprog <- glCreateProgram
     shaders <- mapM (compileAndCheckShader' str) srcs
+    mapM_ (glAttachShader theprog) shaders
     glLinkProgram theprog
-    glCheckError str glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS
-    mapM (glDetachShader theprog) shaders
-    mapM glDeleteShader shaders
+    glCheckError (str ++ " linking ") glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS
+    mapM_ (glDetachShader theprog) shaders
+    mapM_ glDeleteShader shaders
     return theprog
     
+glCheckError :: (Storable t1, Storable a1, Show a1) =>
+                [Char]
+                -> (t2 -> GLenum -> Ptr t1 -> IO ())
+                -> (t2 -> t1 -> Ptr a3 -> Ptr a1 -> IO ())
+                -> t2
+                -> GLenum
+                -> IO ()
 glCheckError str f g x statustype =
     alloca $ \statusPtr -> do
         f x statustype statusPtr
@@ -294,7 +396,7 @@ compileAndCheckShader' str (theShaderType,sourceCode) = do
     theShader <- glCreateShader theShaderType
     setShaderSource theShader sourceCode
     glCompileShader theShader
-    glCheckError str glGetShaderiv glGetShaderInfoLog theShader GL_COMPILE_STATUS
+    glCheckError (str ++ shaderTypeExt' theShaderType) glGetShaderiv glGetShaderInfoLog theShader GL_COMPILE_STATUS
     return theShader
             
 setShaderSource :: GLuint -> BS.ByteString -> IO ()
@@ -305,6 +407,7 @@ setShaderSource si src =
                 glShaderSource si 1 srcPtrBuf srcLengthBuf
 
 -- https://hackage.haskell.org/package/OpenGL-3.0.3.0/docs/src/Graphics.Rendering.OpenGL.GL.ByteString.html#withByteStringP
+withByteString :: Num t => BS.ByteString -> (Ptr b -> t -> IO a) -> IO a
 withByteString bs act = 
     BU.unsafeUseAsCStringLen bs $ \(ptr, size) ->
         act (castPtr ptr) (fromIntegral size)