Continue shader refactor

src/Data/Preload/Render.hs

@@ -20,7 +20,7 @@ data RenderData = RenderData
     , _shadowEdgeShader :: Shader
     , _shadowCapShader :: Shader
     , _shadowWallShader :: Shader
-    , _shadowLightShader :: (Shader,VBO)
+    , _shadowLightShader :: Shader
     , _shadowCombineShader :: Shader
     , _windowShader :: Shader
     , _fullscreenShader :: Shader

src/Dodge/Render.hs

@@ -46,7 +46,7 @@ doTestDrawing _ _ = do
 doDrawing' :: SDL.Window -> RenderData -> Universe -> IO ()
 doDrawing' win pdata u = do
     --sTicks <- SDL.ticks
-    checkGLError
+    checkGLError "during drawing"
     let w = _uvWorld u
         cfig = _uvConfig u
         rot = w ^. wCam . camRot

src/GLHelp.hs

@@ -14,9 +14,9 @@ mglCreate f = do
 mglDelete :: (GLsizei -> Ptr GLuint -> IO ()) -> GLuint -> IO ()
 mglDelete f i = with i $ \ptr -> f 1 ptr
 
-checkGLError :: IO ()
+checkGLError :: String -> IO ()
-checkGLError = do
+checkGLError s = do
     err <- glGetError
     case err of
         0 -> return ()
-        i -> error $ "OpenGL error: " ++ show i
+        i -> error $ "OpenGL error: " ++ show i ++ " - " ++ s

src/Preload/Render.hs

@@ -15,7 +15,6 @@ import Foreign
 import Framebuffer.Setup
 import GLHelp
 import Graphics.GL.Core45
-import Shader
 import Shader.AuxAddition
 import Shader.Compile
 import Shader.Data
@@ -68,7 +67,7 @@ preloadRender = do
 
     -- setup shape geometry/cap VBO and two VAOs
     putStrLn "Setup shape VBO, VAO, EBO"
-    shVBO <- setupVBO' (floatSize * nShapeVerxComp)
+    shVBO <- setupVBO (floatSize * nShapeVerxComp)
     shPosVAO <- setupVAOUsingVBO [VertexAttribute 4 GL_FLOAT GL_FALSE 0] shVBO
     shEBO <- setupEBO shPosVAO
     -- note the shape shader vao is distinct from the position vao, but they
@@ -83,8 +82,8 @@ preloadRender = do
 
     putStrLn "Setup wall/windows VBO, VAO, EBO, shader"
     let wallverxstrd = 8
-    wallvbo <- setupVBO' (floatSize * wallverxstrd)
+    wallvbo <- setupVBO (floatSize * wallverxstrd)
-    winvbo <- setupVBO' (floatSize * 8)
+    winvbo <- setupVBO (floatSize * 8)
     windowshader <- makeShaderUsingVBO "wall/blank" [vert, geom, frag] (toFloatVAs [4, 4]) pmPoints winvbo
     wallshader <- makeShaderUsingVBO "wall/basic" [vert, geom, frag] (toFloatVAs [4, 4]) pmPoints wallvbo
     putStrLn "Setup lighting shaders"
@@ -101,15 +100,14 @@ preloadRender = do
     shadowwallshader <-
         makeShaderUsingVBO "shadow/wallShadow" [vert, geom] (toFloatVAs [4]) pmPoints wallvbo
     shadowlightshader <-
-        makeShaderFixedVertices
+        makeStaticShader
             "shadow/light"
             [vert, geom, frag]
-            [1]
+            [VertexAttribute 1 GL_BYTE GL_FALSE 0]
-            1
+            ([1] :: [GLbyte])
             pmPoints
     shadowcombineshader <- makeShaderUsingVAO "shadow/combine" [vert, geom, frag] pmPoints 
-        (shadowlightshader ^. _1 . shaderVAO)
+        (shadowlightshader ^. shaderVAO)
-    poke (shadVBOptr shadowlightshader) 1
 
     putStrLn "Setup 2D shaders"
     bslist <- makeShaderVBO "dualTwoD/basic" [vert, frag] [3, 4] pmTriangles
@@ -143,7 +141,7 @@ preloadRender = do
 
     putStrLn "Setup cloud VBO, shader"
     let cloudverxsizes = [4, 4, 4, 4]
-    cloudvbo <- setupVBO' (floatSize * sum cloudverxsizes)
+    cloudvbo <- setupVBO (floatSize * sum cloudverxsizes)
     (cloudshader, cloudebo) <-
         makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes pmTriangles cloudvbo
     framebuf2 <- newTextureFramebuffer

src/Render.hs

@@ -339,12 +339,12 @@ instanceLightMap cfig nWalls nSils nCaps toPos tanormals lightPoints pdata = do
     glDepthFunc GL_ALWAYS
     glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
     glStencilFunc GL_EQUAL 0 255
-    glUseProgram (pdata ^. shadowLightShader . _1 . shaderUINT)
+    glUseProgram (pdata ^. shadowLightShader . shaderUINT)
     -- bind world position texture
     glBindTextureUnit 0 (toPos ^. unTO)
     glBindTextureUnit 1 (tanormals ^. unTO)
     glDrawArrays
-        (_unPrimitiveMode $ pdata ^. shadowLightShader . _1 . shaderPrimitive)
+        (_unPrimitiveMode $ pdata ^. shadowLightShader . shaderPrimitive)
         0
         1
     glDisable GL_CULL_FACE

src/Shader/Compile.hs

@@ -1,11 +1,11 @@
 module Shader.Compile (
-    setupVBO',
+    setupVBO,
     setupVBOStatic,
     makeShaderEBO,
     makeShaderVBO,
     makeShaderUsingVBO,
     makeByteStringShaderUsingVAO,
-    makeShaderFixedVertices,
+    makeStaticShader,
     makeShaderUsingVAO,
     setupVAOUsingVBO,
     setupVAOvbo,
@@ -46,7 +46,7 @@ makeShaderVBO ::
     IO (Shader, VBO)
 makeShaderVBO s shaderlist sizes pm = do
     prog <- makeSourcedShader s shaderlist
-    (vao, vbo) <- setupVBOVAO sizes
+    (vao, vbo) <- setupVBOVAO (toFloatVAs sizes)
     return
         ( Shader
             { _shaderUINT = prog
@@ -89,8 +89,8 @@ makeShaderUsingVBO s shaderlist sizes pm vbo = do
     vao <- setupVAOUsingVBO sizes vbo
     makeShaderUsingVAO s shaderlist pm vao
 
-setupVBO' :: Int -> IO VBO
+setupVBO :: Int -> IO VBO
-setupVBO' vertexsize = do
+setupVBO vertexsize = do
     vboname <- mglCreate glCreateBuffers
     thePtr <- mallocBytes (vertexsize * numDrawableElements)
     -- Allocate space
@@ -175,27 +175,25 @@ makeShaderUsingVAO s shaderlist pm theVAO = do
 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.
 -}
-makeShaderFixedVertices ::
+makeStaticShader ::
+    Storable a =>
     -- | First part of the name of the shader
     String ->
     -- | shader types
     [GLenum] ->
-    -- | The input vertex sizes
+    [VertexAttribute] ->
-    [Int] ->
+    [a] ->
-    -- | Number of vertexes that can be poked
-    Int ->
     PrimitiveMode ->
-    IO (Shader, VBO)
+    IO Shader
-makeShaderFixedVertices s shaderlist sizes ndraw pm = do
+makeStaticShader s shaderlist vas vdata pm = do
     prog <- makeSourcedShader s shaderlist
-    (vao, vbo) <- setupVBOVAO sizes
+    (_, vao) <- setupStaticVBOVAO vas vdata
     return
         ( Shader
             { _shaderUINT = prog
             , _shaderVAO = vao
             , _shaderPrimitive = pm
             }
-        , vbo
         )
 
 {- | Compile shader and get its uniform locations.
@@ -235,26 +233,25 @@ setupVAOUsingVBO vas vbo = do
 
 setupEBO :: VAO -> IO EBO
 setupEBO vao = do
-    eboptr <- mallocArray numDrawableElements
+    eboptr <- mallocArray numGLushort
     eboname <- mglCreate glCreateBuffers
     glNamedBufferData
         eboname
-        (fromIntegral $ glushortSize * numDrawableElements)
+        (fromIntegral $ glushortSize * numGLushort)
         nullPtr
         GL_STREAM_DRAW
     glVertexArrayElementBuffer (vao ^. vaoName) eboname
     return $ EBO eboname eboptr
 
-setupVBOVAO :: [Int] -> IO (VAO, VBO)
+setupVBOVAO :: [VertexAttribute] -> IO (VAO, VBO)
-setupVBOVAO sizes = do
+setupVBOVAO vas = do
     vaoname <- mglCreate glCreateVertexArrays
     glBindVertexArray vaoname
-    vbo <- setupVBO' (floatSize * sum sizes)
+    vbo <- setupVBO strd
     --vao <- setupVAOvbo (toFloatVAs sizes) (sum sizes) (vbo ^. vboName)
-    vao <- setupVAOUsingVBO (toFloatVAs sizes) vbo
+    vao <- setupVAOUsingVBO vas vbo
     return (vao,vbo)
   where
-    vas = toFloatVAs sizes
     strd = vasTightStride vas
 
 toFloatVAs :: [Int] -> [VertexAttribute]
@@ -367,6 +364,7 @@ attribSize x = case x of
 --    GL_INT_2_10_10_10_REV                 -> sizeOf (0 ::  GL_INT_2_10_10_10_REV)
 --    GL_UNSIGNED_INT_2_10_10_10_REV        -> sizeOf (0 ::  GL_UNSIGNED_INT_2_10_10_10_REV)
 --    GL_UNSIGNED_INT_10F_11F_11F_REV       -> sizeOf (0 ::  GL_UNSIGNED_INT_10F_11F_11F_REV)
+    _ -> error "attribSize : unkown GLenum attribute size"
 
 -- 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

src/Shader/Parameters.hs

@@ -3,6 +3,7 @@ module Shader.Parameters
     , numDrawableElements
     , numSubElements
     , glushortSize
+    , numGLushort
     ) where
 import Graphics.GL.Core45
 import Foreign
@@ -19,10 +20,14 @@ glushortSize :: Int
 glushortSize = sizeOf (0 :: GLushort)
 {-# INLINE glushortSize #-}
 
+numGLushort :: Int
+numGLushort = fromIntegral (maxBound :: GLushort) + 1
+{-# INLINE numGLushort #-}
+
 numDrawableElements :: Int
 {-# INLINE numDrawableElements #-}
 numDrawableElements = 6 * numSubElements
 
 numSubElements :: Int
 {-# INLINE numSubElements #-}
-numSubElements = 100000
+numSubElements = 65536