diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 61b2b0327..58a657f4e 100644 --- a/src/Data/Preload/Render.hs +++ b/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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index e01726bf7..775959c30 100644 --- a/src/Dodge/Render.hs +++ b/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 diff --git a/src/GLHelp.hs b/src/GLHelp.hs index ab6a92511..f7ca748a7 100644 --- a/src/GLHelp.hs +++ b/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 = do +checkGLError :: String -> IO () +checkGLError s = do err <- glGetError case err of 0 -> return () - i -> error $ "OpenGL error: " ++ show i + i -> error $ "OpenGL error: " ++ show i ++ " - " ++ s diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index e630d3e8c..34c2271fa 100644 --- a/src/Preload/Render.hs +++ b/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) - winvbo <- setupVBO' (floatSize * 8) + wallvbo <- setupVBO (floatSize * wallverxstrd) + 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] - 1 + [VertexAttribute 1 GL_BYTE GL_FALSE 0] + ([1] :: [GLbyte]) pmPoints shadowcombineshader <- makeShaderUsingVAO "shadow/combine" [vert, geom, frag] pmPoints - (shadowlightshader ^. _1 . shaderVAO) - poke (shadVBOptr shadowlightshader) 1 + (shadowlightshader ^. shaderVAO) 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 diff --git a/src/Render.hs b/src/Render.hs index dba2fe071..fa58ed74b 100644 --- a/src/Render.hs +++ b/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 diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index e5b62871f..e375a57f1 100644 --- a/src/Shader/Compile.hs +++ b/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' vertexsize = do +setupVBO :: Int -> IO VBO +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 - [Int] -> - -- | Number of vertexes that can be poked - Int -> + [VertexAttribute] -> + [a] -> PrimitiveMode -> - IO (Shader, VBO) -makeShaderFixedVertices s shaderlist sizes ndraw pm = do + IO Shader +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 sizes = do +setupVBOVAO :: [VertexAttribute] -> IO (VAO, VBO) +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 diff --git a/src/Shader/Parameters.hs b/src/Shader/Parameters.hs index 4c9e3ba1c..eb5055397 100644 --- a/src/Shader/Parameters.hs +++ b/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