Start translating shader compilation and linking to openglraw

src/Framebuffer/Update.hs

@@ -81,18 +81,18 @@ resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
     deleteObjectName oldto2
     to1 <- genObjectName
     to2 <- genObjectName
---    textureBinding Texture2DArray $= Just to1
+    textureBinding Texture2DArray $= Just to1
---    glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10
+    glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10
---    textureFilter Texture2DArray $= minMagFilter
+    textureFilter Texture2DArray $= minMagFilter
---    glFramebufferTexture GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 (unTexture to1) 0
+    glFramebufferTexture GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 (unTexture to1) 0
---    textureBinding Texture2DArray $= Just to2
+    textureBinding Texture2DArray $= Just to2
---    glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10
+    glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10
---    textureFilter Texture2DArray $= minMagFilter
+    textureFilter Texture2DArray $= minMagFilter
---    glFramebufferTexture GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0
+    glFramebufferTexture GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0
---    fboStatus <- framebufferStatus Framebuffer
+    fboStatus <- framebufferStatus Framebuffer
---    case fboStatus of
+    case fboStatus of
---        Complete -> return ()
+        Complete -> return ()
---        _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
+        _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
     return (fboname,(to1,to2))
 
 unTexture :: TextureObject -> GLuint

src/Shader.hs

@@ -43,7 +43,6 @@ drawShader fs i = do
     case _shadTex fs of 
         Just ShaderTexture{_textureObject = TextureObject txo
                 , _textureTarget = tt }
---            -> textureBinding Texture2D $= Just txo
             -> glBindTexture tt txo
         _   -> return ()
     glDrawArrays 

src/Shader/Compile.hs

@@ -14,9 +14,11 @@ import Shader.Parameters
 
 import Foreign
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Unsafe as BU
 import Control.Monad
 --import Control.Lens
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
+import Graphics.GL.Core43
 {- | 
 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.
@@ -37,6 +39,24 @@ makeShader s shaderlist sizes pm = do
         , _shadTex  = Nothing
         , _shadUnis = mempty
         }
+
+makeByteStringShader'
+    :: String       -- ^ (Arbitrary) name of the shader
+    -> [(GLenum,BS.ByteString)] -- ^ Filetype extensions and shader data
+    -> [Int]        -- ^ The input vertex sizes
+    -> EPrimitiveMode 
+    -> IO FullShader'
+makeByteStringShader' s shaderlist sizes pm = do
+    prog <- makeShaderProgram' s shaderlist
+    vaob <- setupVAO sizes
+    return $ FullShader' 
+        { _shadProg' = prog
+        , _shadVAO'  = vaob
+        , _shadPrim' = pm
+        , _shadTex'  = Nothing
+        , _shadUnis' = mempty
+        }
+
 makeByteStringShader
     :: String       -- ^ (Arbitrary) name of the shader
     -> [(ShaderType,BS.ByteString)] -- ^ Filetype extensions and shader data
@@ -136,6 +156,7 @@ shaderTypeExt GeometryShader = ".geom"
 shaderTypeExt FragmentShader = ".frag"
 shaderTypeExt _ = undefined
 
+-- I think that this requires that the correct shader program is bound...
 setupVAO :: [Int] -> IO VAO
 setupVAO sizes = do
     theVAO <- genObjectName
@@ -217,6 +238,33 @@ setupVertexAttribPointer loc siz strd off = do
     fi' = fromIntegral
     fi'' = fromIntegral
 
+makeShaderProgram' :: String 
+    -> [(GLenum,BS.ByteString)] -- list of shaders
+    -> IO GLuint
+makeShaderProgram' str srcs = do
+    theprog <- glCreateProgram
+    shaders <- mapM (compileAndCheckShader' str) srcs
+    glLinkProgram theprog
+    glCheckError str glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS
+    mapM (glDetachShader theprog) shaders
+    mapM glDeleteShader shaders
+    return theprog
+    
+glCheckError str f g x statustype =
+    alloca $ \statusPtr -> do
+        f x statustype statusPtr
+        status <- peek $ castPtr statusPtr
+        if status == GL_FALSE
+            then do
+                alloca $ \ptr -> do
+                    f x GL_INFO_LOG_LENGTH ptr
+                    len <- peek ptr -- we may have to use this length more intelligently
+                    alloca $ \charPtr -> do
+                        g x len nullPtr charPtr
+                        char <- peek charPtr
+                        error $ str ++ show char
+            else return ()
+
 makeShaderProgram :: String -> [(ShaderType,BS.ByteString)] -> IO Program
 makeShaderProgram str sources = do
     theShaderProgram <- createProgram
@@ -241,5 +289,25 @@ compileAndCheckShader str (theShaderType,sourceCode) = do
         putStrLn $ str ++ ": Shader compile: " ++ show theShaderType ++ " :\n" ++ infoLog
     return theShader
 
+compileAndCheckShader' :: String -> (GLenum,BS.ByteString) -> IO GLuint
+compileAndCheckShader' str (theShaderType,sourceCode) = do
+    theShader <- glCreateShader theShaderType
+    setShaderSource theShader sourceCode
+    glCompileShader theShader
+    glCheckError str glGetShaderiv glGetShaderInfoLog theShader GL_COMPILE_STATUS
+    return theShader
+            
+setShaderSource :: GLuint -> BS.ByteString -> IO ()
+setShaderSource si src =
+    withByteString src $ \srcPtr srcLength ->
+        with srcPtr $ \srcPtrBuf ->
+            with srcLength $ \srcLengthBuf ->
+                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 bs act = 
+    BU.unsafeUseAsCStringLen bs $ \(ptr, size) ->
+        act (castPtr ptr) (fromIntegral size)
+
 bufferOffset :: Integral a => a -> Ptr b
 bufferOffset = plusPtr nullPtr . (* floatSize) . fromIntegral

src/Shader/Data.hs

@@ -6,6 +6,7 @@ module Shader.Data
     , VBO (..)
     , EBO (..)
     , FullShader (..)
+    , FullShader' (..)
     , ShaderTexture (..)
     , EPrimitiveMode (..)
 -- | Lens functions
@@ -22,6 +23,12 @@ module Shader.Data
     , vboStride
     , ebo
     , eboPtr
+
+    , shadProg'
+    , shadVAO'
+    , shadPrim'
+    , shadTex'
+    , shadUnis'
 -- | Synonyms
     , vert
     , geom
@@ -39,6 +46,13 @@ data FullShader = FullShader
     , _shadTex  :: Maybe ShaderTexture
     , _shadUnis :: Vector UniformLocation
     }
+data FullShader' = FullShader'
+    { _shadProg' :: GLuint
+    , _shadVAO'  :: VAO
+    , _shadPrim' :: EPrimitiveMode
+    , _shadTex'  :: Maybe ShaderTexture
+    , _shadUnis' :: Vector UniformLocation
+    }
 {- | Vertex array object: contains the reference to the object,
 and its buffer targets.  -}
 data VAO = VAO
@@ -85,4 +99,5 @@ frag = FragmentShader
 makeLenses ''VAO
 makeLenses ''VBO
 makeLenses ''FullShader
+makeLenses ''FullShader'
 makeLenses ''EBO