From 378af69ca5cbc58b56333df77863a19d3ec96ff3 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 14 Mar 2023 14:11:14 +0000 Subject: [PATCH] Continue render refactor --- src/Data/Preload/Render.hs | 21 ++++++++++++--------- src/Dodge/Render.hs | 38 ++++++++++++++++++++------------------ src/Dodge/Render/Shadow.hs | 33 +++++++++++++++++---------------- src/Preload/Render.hs | 34 +++++++++++++++++++--------------- src/Preload/Update.hs | 2 +- src/Render.hs | 10 +++++----- src/Shader.hs | 27 +++++++++++---------------- src/Shader/AuxAddition.hs | 7 ++++--- src/Shader/Bind.hs | 12 ++++++------ src/Shader/Compile.hs | 29 ++++++++++++++--------------- src/Shader/Data.hs | 5 +++-- src/Shader/Poke.hs | 12 ++++++------ 12 files changed, 118 insertions(+), 112 deletions(-) diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index c3d7fd549..c07b739d4 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -22,23 +22,23 @@ data RenderData = RenderData , _shadowEdgeShader :: FullShader , _shadowCapShader :: FullShader , _shadowWallShader :: FullShader - , _shadowLightShader :: FullShader - , _shadowCombineShader :: FullShader - , _positionalBlankShader :: FullShader + , _shadowLightShader :: (FullShader,VBO) + , _shadowCombineShader :: (FullShader,VBO) + , _positionalBlankShader :: (FullShader,VBO) , _wallBlankShader :: FullShader , _windowShader :: FullShader , _wallTextureShader :: FullShader - , _textureArrayShader :: FullShader - , _fullscreenShader :: FullShader - , --, _fullscreenAlphaHalveShader :: FullShader + , _textureArrayShader :: (FullShader,VBO) + , _fullscreenShader :: (FullShader,VBO) + , --, _fullscreenAlphaHalveShader :: (FullShader,VBO) _bloomBlurShader :: FullShader , _colorBlurShader :: FullShader - , _barrelShader :: FullShader + , _barrelShader :: (FullShader,VBO) , _grayscaleShader :: FullShader - , _shapeShader :: FullShader + , _shapeShader :: (FullShader,VBO) , _shapeEBO :: EBO , _silhouetteEBO :: EBO - , _pictureShaders :: MV.MVector (PrimState IO) FullShader + , _pictureShaders :: MV.MVector (PrimState IO) (FullShader,VBO) , _fbo2 :: (FBO, TO) , _fbo3 :: (FBO, TO) , _fboHalf1 :: (FBO, TO) @@ -56,6 +56,9 @@ data RenderData = RenderData , _matUBO :: GLuint -- BufferObject id , _isoMatUBO :: GLuint -- BufferObject id , _lightsUBO :: GLuint -- BufferObject id + , _vboWalls :: VBO + , _vboWindows :: VBO + , _vboShapes :: VBO } makeLenses ''RenderData diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index de6b78d8d..1aae255ed 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -70,15 +70,17 @@ doDrawing' win pdata u = do wp ) ( pokeWallsWindowsFloor - (shadVBOptr $ _wallTextureShader pdata) - (shadVBOptr $ _windowShader pdata) + --(shadVBOptr $ _wallTextureShader pdata) + --(shadVBOptr $ _windowShader pdata) + ( pdata ^. vboWalls . vboPtr) + ( pdata ^. vboWindows . vboPtr) (shadVBOptr $ _textureArrayShader pdata) wallPointsCol windowPoints (w ^. cWorld . floorTiles) ) ( pokeShape - (_vboPtr $ _vaoVBO $ _shadVAO' $ _shapeShader pdata) + (_vboPtr $ _vboShapes pdata) (_eboPtr $ _shapeEBO pdata) (_eboPtr $ _silhouetteEBO pdata) (0, 0, 0) @@ -88,10 +90,10 @@ doDrawing' win pdata u = do bindShaderLayers shadV layerCounts uncurry bindShaderBuffers $ unzip - [ (_wallTextureShader pdata, nWalls) - , (_shapeShader pdata, nShapeVs) - , (_windowShader pdata, nWins) - , (_textureArrayShader pdata, nFls) + [ ((pdata ^. vboWalls), nWalls) + , (_vboShapes pdata, nShapeVs) + , (pdata ^. vboWindows, nWins) + , (snd $ _textureArrayShader pdata, nFls) ] glNamedBufferSubData (_eboName $ _shapeEBO pdata) @@ -134,15 +136,15 @@ doDrawing' win pdata u = do renderLayer BottomLayer shadV layerCounts --draw object shapes onto base buffer let fs = _shapeShader pdata - glUseProgram (_shadName fs) - glBindVertexArray $ fs ^. shadVAO' . vaoName + glUseProgram (_shadName $ fst fs) + glBindVertexArray $ fs ^. _1 . shadVAO' . vaoName glDrawElements - (marshalEPrimitiveMode $ _shadPrim' fs) + (marshalEPrimitiveMode $ _shadPrim' $ fst fs) (fromIntegral nIndices) GL_UNSIGNED_SHORT nullPtr --draw floor onto base buffer - drawShader (_textureArrayShader pdata) nFls + drawShader (fst $ _textureArrayShader pdata) nFls --draw lightmap into its own buffer createLightMap cfig @@ -161,7 +163,7 @@ doDrawing' win pdata u = do glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO) glEnable GL_BLEND glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR - drawShader (_fullscreenShader pdata) 4 + drawShader (fst $ _fullscreenShader pdata) 4 with GL_COLOR_ATTACHMENT0 $ \ptr -> glInvalidateNamedFramebufferData (pdata ^. fboLighting . _1 . unFBO) @@ -231,7 +233,7 @@ doDrawing' win pdata u = do glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata) glEnable GL_BLEND glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE - drawShader (_fullscreenShader pdata) 4 + drawShader (fst $ _fullscreenShader pdata) 4 glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA -- bind base buffer for drawing bloom then clouds glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata))) @@ -239,11 +241,11 @@ doDrawing' win pdata u = do glEnable GL_BLEND glBlendFunc GL_SRC_ALPHA GL_ONE glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata) - drawShader (_fullscreenShader pdata) 4 + drawShader (fst $ _fullscreenShader pdata) 4 glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA --draw shadowed clouds onto base buffer glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata) - drawShader (_fullscreenShader pdata) 4 + drawShader (fst $ _fullscreenShader pdata) 4 --set viewport for radial distortion setViewportSize (round winx) (round winy) glDepthFunc GL_ALWAYS @@ -253,13 +255,13 @@ doDrawing' win pdata u = do [] -> do bindTO $ fst $ snd $ _fboBase pdata glBindFramebuffer GL_FRAMEBUFFER 0 - drawShader (_fullscreenShader pdata) 4 + drawShader (fst $ _fullscreenShader pdata) 4 rds -> do let bindDrawDist :: Distortion -> IO () bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g] - bindShaderBuffers [_barrelShader pdata] [1] - drawShader (_barrelShader pdata) 1 + bindShaderBuffers [snd $ _barrelShader pdata] [1] + drawShader (fst $ _barrelShader pdata) 1 fboList = take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata])) ++ [FBO 0] diff --git a/src/Dodge/Render/Shadow.hs b/src/Dodge/Render/Shadow.hs index bfd61f2cc..bd4cbac0b 100644 --- a/src/Dodge/Render/Shadow.hs +++ b/src/Dodge/Render/Shadow.hs @@ -17,22 +17,23 @@ import Shader.Parameters import Shape.Data drawCPUShadows :: RenderData -> Shape -> Point3 -> Float -> IO () -drawCPUShadows pdata s pos rad = do - let theshad = pdata ^. positionalBlankShader - theptr = _vboPtr $ _vaoVBO $ _shadVAO' theshad - i <- VFSM.foldlM' (pokeShapeShad pos rad theptr) 0 $ VFSM.fromList s - glBufferSubData - (theshad ^. shadVAO' . vaoVBO . vboName) - 0 - (fromIntegral $ floatSize * i) - (theshad ^. shadVAO' . vaoVBO . vboPtr) - glUseProgram (theshad ^. shadName) - glBindVertexArray . _vaoName $ _shadVAO' theshad - glDrawArrays - (marshalEPrimitiveMode $ _shadPrim' theshad) - 0 - (fromIntegral i) - return () +drawCPUShadows _ _ _ _ = return () +--drawCPUShadows pdata s pos rad = do +-- let theshad = pdata ^. positionalBlankShader +-- theptr = _vboPtr $ _vaoVBO $ _shadVAO' theshad +-- i <- VFSM.foldlM' (pokeShapeShad pos rad theptr) 0 $ VFSM.fromList s +-- glBufferSubData +-- (theshad ^. shadVAO' . vaoVBO . vboName) +-- 0 +-- (fromIntegral $ floatSize * i) +-- (theshad ^. shadVAO' . vaoVBO . vboPtr) +-- glUseProgram (theshad ^. shadName) +-- glBindVertexArray . _vaoName $ _shadVAO' theshad +-- glDrawArrays +-- (marshalEPrimitiveMode $ _shadPrim' theshad) +-- 0 +-- (fromIntegral i) +-- return () pokeShapeShad :: Point3 -> Float -> Ptr Float -> Int -> ShapeObj -> IO Int pokeShapeShad pos r theptr i so = do diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 4eb305c72..91592113c 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -59,8 +59,8 @@ preloadRender = do glBindVertexArray wpColVAOname setupVertexAttribPointer wpColVAOname wpVBOname 0 4 8 0 setupVertexAttribPointer wpColVAOname wpVBOname 1 4 8 4 - let wpVAO = VAO{_vaoName = wpVAOname, _vaoVBO = wpVBO, _vaoAttribSizes = [4], _vaoStride = 8} - wpColVAO = VAO{_vaoName = wpColVAOname, _vaoVBO = wpVBO, _vaoAttribSizes = [4,4], _vaoStride = 8} + let wpVAO = VAO{_vaoName = wpVAOname, _vaoAttribSizes = [4], _vaoStride = 8} + wpColVAO = VAO{_vaoName = wpColVAOname, _vaoAttribSizes = [4,4], _vaoStride = 8} -- setup window points VBO, VAOs and shaders winVBOname <- mglCreate glCreateBuffers winVBOptr <- mallocArray (8 * numDrawableWalls) @@ -76,7 +76,7 @@ preloadRender = do setupVertexAttribPointer winColVAOname winVBOname 0 4 8 0 setupVertexAttribPointer winColVAOname winVBOname 1 4 8 4 let winColVAO = VAO - {_vaoName = winColVAOname, _vaoVBO = winVBO, _vaoAttribSizes = [4,4], _vaoStride = 8} + {_vaoName = winColVAOname, _vaoAttribSizes = [4,4], _vaoStride = 8} -- setup shape geometry/cap VBO and two VAOs shEBOptr <- mallocArray numDrawableElements shEBOname <- mglCreate glCreateBuffers @@ -109,8 +109,8 @@ preloadRender = do --bindBuffer ElementArrayBuffer $= Just shEBOname glVertexArrayElementBuffer shPosVAOname shEBOname let shPosColVAO = VAO - {_vaoName = shPosColVAOname, _vaoVBO = shVBO, _vaoAttribSizes = [3,4], _vaoStride = 7} - shPosVAO = VAO{_vaoName = shPosVAOname, _vaoVBO = shVBO, _vaoAttribSizes = [3], _vaoStride = 7} + {_vaoName = shPosColVAOname, _vaoAttribSizes = [3,4], _vaoStride = 7} + shPosVAO = VAO{_vaoName = shPosVAOname, _vaoAttribSizes = [3], _vaoStride = 7} --setup silhouette edge VAO --shEdgeVAOname <- genObjectName --bindVertexArrayObject $= Just shEdgeVAOname @@ -129,7 +129,7 @@ preloadRender = do nullPtr GL_STREAM_DRAW let silEBO = EBO{_eboName = silEBOname, _eboPtr = silEBOptr} - shEdgeVAO = VAO{_vaoName = shEdgeVAOname, _vaoVBO = shVBO, _vaoAttribSizes = [3], _vaoStride = 7} + shEdgeVAO = VAO{_vaoName = shEdgeVAOname, _vaoAttribSizes = [3], _vaoStride = 7} -- shEdgeVAO is unecessary? -- lighting shaders lightingWallShadShad <- @@ -152,7 +152,7 @@ preloadRender = do [1] 1 EPoints shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 EPoints - poke (shadVBOptr' shadowlightshader) 1 + poke (shadVBOptr shadowlightshader) 1 -- positional shader positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] ETriangles @@ -164,7 +164,7 @@ preloadRender = do bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] ETriangleStrip cslist <- makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] ETriangles - >>= vaddTextureNoFilter "data/texture/charMap.png" + >>= (_1 (vaddTextureNoFilter "data/texture/charMap.png")) -- this should really be a 2d texture array basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] ETriangles -- fullscreen shaders @@ -174,9 +174,9 @@ preloadRender = do fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip -- note we directly poke the shader vertex data here -- could possibly use an indirect draw call - pokeArray (shadVBOptr' fsShad) $ concat cornerList + pokeArray (shadVBOptr fsShad) $ concat cornerList - let fsshadvao = fsShad ^. shadVAO' + let fsshadvao = fsShad ^. _1 . shadVAO' bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip fsshadvao colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip fsshadvao @@ -199,7 +199,7 @@ preloadRender = do >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png" -- >>= addTextureArray "data/texture/ayene_wooden_floor.png" -- bind fixed vertex data - bindShaderBuffers [fsShad] [4, 4] + bindShaderBuffers [snd fsShad] [4, 4] framebuf2 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600 @@ -245,7 +245,7 @@ preloadRender = do return $ RenderData { _pictureShaders = shadV - , _shapeShader = bslista{_shadVAO' = shPosColVAO} + , _shapeShader = bslista & _1 . shadVAO' .~ shPosColVAO , _shapeEBO = shEBO , _silhouetteEBO = silEBO , _lightingCapShader = lightingCapShad @@ -284,6 +284,9 @@ preloadRender = do , _matUBO = theUBO , _isoMatUBO = isoUBO , _lightsUBO = lightsubo + , _vboWalls = wpVBO + , _vboWindows = winVBO + , _vboShapes = shVBO } --------------------end preloadRender @@ -309,8 +312,9 @@ initializeGLState = do glEnable GL_DEPTH_TEST cleanUpRenderPreload :: RenderData -> IO () -cleanUpRenderPreload pd = do +cleanUpRenderPreload _ = return () +--cleanUpRenderPreload pd = do -- TODO fix this --mapM_ freeShaderPointers $ _pictureShaders pd - freeShaderPointers' $ _lightingWallShadShader pd - freeShaderPointers' $ _fullscreenShader pd + --freeShaderPointers' $ _lightingWallShadShader pd + --freeShaderPointers' $ _fullscreenShader pd diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index b3405d227..600a10f9b 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -52,5 +52,5 @@ renderDataResizeUpdate xsize ysize xfull yfull rdata = do "bloomBlur" [(vert, bbVert), (frag, bbFrag')] ETriangleStrip - (rdata ^. fullscreenShader . shadVAO') + (rdata ^. fullscreenShader . _1 . shadVAO') return (rdata'{_bloomBlurShader = bbShad}) diff --git a/src/Render.hs b/src/Render.hs index 9bd21be35..ade63e02a 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -275,12 +275,12 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do glDepthFunc GL_ALWAYS glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glStencilFunc GL_EQUAL 0 255 - glUseProgram (pdata ^. shadowLightShader . shadName) + glUseProgram (pdata ^. shadowLightShader . _1 . shadName) -- bind world position texture bindTO toPos -- glBindVertexArray $ pdata ^. shadowLightShader . shadVAO' . vaoName glDrawArrays - (marshalEPrimitiveMode $ pdata ^. shadowLightShader . shadPrim') + (marshalEPrimitiveMode $ pdata ^. shadowLightShader . _1 . shadPrim') 0 1 glDisable GL_CULL_FACE @@ -292,7 +292,7 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do glBindTexture GL_TEXTURE_2D_ARRAY (pdata ^. fboShadow . _2 . _1 . unTO) glEnable GL_BLEND glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR - glUseProgram (pdata ^. shadowCombineShader . shadName) + glUseProgram (pdata ^. shadowCombineShader . _1 . shadName) glDrawArrays (marshalEPrimitiveMode EPoints) 0 @@ -322,7 +322,7 @@ pingPongBetween (fb1, to1) (fb2, to2) fs = do drawShader fs 4 renderFoldable :: - MV.MVector (PrimState IO) FullShader -> + MV.MVector (PrimState IO) (FullShader,VBO) -> Picture -> IO () renderFoldable shadV struct = do @@ -333,7 +333,7 @@ renderFoldable shadV struct = do ------------------------------end renderFoldable renderLayer :: Layer -> - MV.MVector (PrimState IO) FullShader -> + MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> IO () renderLayer layer shads counts = do diff --git a/src/Shader.hs b/src/Shader.hs index da384eba1..91d755682 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -2,7 +2,6 @@ module Shader ( freeShaderPointers' , drawShaderLay , shadVBOptr - , shadVBOptr' , drawShader , pokeBindFoldable , pokeBindFoldableLayer @@ -21,22 +20,22 @@ import Control.Monad.Primitive import Foreign import Graphics.GL.Core45 -drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> IO () +drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (FullShader,VBO) -> IO () {-# INLINE drawShaderLay #-} drawShaderLay l countsVector shadIn fs = do i <- UMV.read countsVector shadIn --currentProgram $= Just (_shadProg' fs) - glUseProgram (_shadName fs) - glBindVertexArray $ fs ^. shadVAO' . vaoName + glUseProgram (_shadName $ fst fs) + glBindVertexArray $ fs ^. _1 . shadVAO' . vaoName --bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs) - case _shadTex' fs of + case _shadTex' $ fst fs of Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt} -- -> textureBinding Texture2D $= Just txo -- -> glBindTexture tt txo -> glBindTextureUnit 0 txo _ -> return () glDrawArrays - (marshalEPrimitiveMode $ _shadPrim' fs) + (marshalEPrimitiveMode $ _shadPrim' $ fst fs) (fromIntegral $ l*numSubElements) (fromIntegral i) @@ -58,11 +57,11 @@ drawShader fs i = do 0 (fromIntegral i) -freeShaderPointers' :: FullShader -> IO () -freeShaderPointers' = free . _vboPtr . _vaoVBO . _shadVAO' +freeShaderPointers' :: (FullShader,VBO) -> IO () +freeShaderPointers' = free . _vboPtr . snd pokeBindFoldable - :: MV.MVector (PrimState IO) FullShader + :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> Picture -> IO () @@ -71,7 +70,7 @@ pokeBindFoldable shadV counts m = do bindShader shadV counts pokeBindFoldableLayer - :: MV.MVector (PrimState IO) FullShader + :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> Picture -> IO () @@ -79,10 +78,6 @@ pokeBindFoldableLayer shadV counts m = do pokeLayVerxs shadV counts m bindShaderLayers shadV counts -shadVBOptr :: FullShader -> Ptr Float +shadVBOptr :: (FullShader,VBO) -> Ptr Float {-# INLINE shadVBOptr #-} -shadVBOptr = _vboPtr . _vaoVBO . _shadVAO' - -shadVBOptr' :: FullShader -> Ptr Float -{-# INLINE shadVBOptr' #-} -shadVBOptr' = _vboPtr . _vaoVBO . _shadVAO' +shadVBOptr = _vboPtr . snd diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 3e72520f4..581f872c3 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -62,8 +62,8 @@ addTexture2D nlev minfilt magfilt texpath shad = do -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into -- an image that was directly readable by glTexSubImage3D, used the -- transformation tilesToLine 8 128 on the underlying pixels. -addTextureArray :: String -> FullShader -> IO FullShader -addTextureArray texturePath shad = do +addTextureArray :: String -> (FullShader,VBO) -> IO (FullShader,VBO) +addTextureArray texturePath (shad,vbo) = do err <- glGetError print err Right cmap <- readImage texturePath @@ -75,8 +75,9 @@ addTextureArray texturePath shad = do glGenerateTextureMipmap texname glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR) glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR) - return $ shad & shadTex' ?~ ShaderTexture + return (shad & shadTex' ?~ ShaderTexture { _textureObject = texname} + , vbo) -- I am completely unclear on why this works with its current parameters tilesToLine diff --git a/src/Shader/Bind.hs b/src/Shader/Bind.hs index 1b7bff355..84efca006 100644 --- a/src/Shader/Bind.hs +++ b/src/Shader/Bind.hs @@ -22,11 +22,11 @@ bindArrayBuffers numVs theVBO = glNamedBufferSubData (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) (_vboPtr theVBO) -bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () +bindShaderLayers :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO () bindShaderLayers shads counts = MV.imapM_ f shads where f i shad = do - let theVBO = _vaoVBO $ _shadVAO' shad + let theVBO = snd shad stride = sum $ _vboAttribSizes theVBO VFSM.mapM_ (g stride theVBO) $ VFSM.enumFromStepN 0 1 6 -- [0..5] where @@ -41,12 +41,12 @@ bindShaderLayers shads counts = MV.imapM_ f shads glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO () glNamedBufferSubDataH = glNamedBufferSubData -bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () +bindShader :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> IO () bindShader shads counts = MV.imapM_ f shads where - f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shadVAO' $ shad) + f i shad = UMV.read counts i >>= flip bindArrayBuffers (snd shad) -bindShaderBuffers :: [FullShader] -> [Int] -> IO () +bindShaderBuffers :: [VBO] -> [Int] -> IO () bindShaderBuffers = zipWithM_ f where - f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs + f fs i = bindArrayBuffers i fs diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index b4c405f39..e4716e9d5 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -29,18 +29,18 @@ makeShader :: -- | The input vertex sizes [Int] -> EPrimitiveMode -> - IO FullShader + IO (FullShader,VBO) makeShader s shaderlist sizes pm = do prog <- makeSourcedShader s shaderlist - vaob <- setupVAO sizes - return $ - FullShader + (vao,vbo) <- setupVAO sizes + return ( FullShader { _shadName = prog - , _shadVAO' = vaob + , _shadVAO' = vao , _shadPrim' = pm , _shadTex' = Nothing , _shadUnis' = mempty } + , vbo) makeByteStringShaderUsingVAO :: -- | (Arbitrary) name of the shader @@ -95,18 +95,18 @@ makeShaderSized :: -- | Number of vertexes that can be poked Int -> EPrimitiveMode -> - IO FullShader + IO (FullShader,VBO) makeShaderSized s shaderlist sizes ndraw pm = do prog <- makeSourcedShader s shaderlist - vaob <- setupVAOSized ndraw sizes - return $ - FullShader + (vao,vbo) <- setupVAOSized ndraw sizes + return ( FullShader { _shadName = prog - , _shadVAO' = vaob + , _shadVAO' = vao , _shadPrim' = pm , _shadTex' = Nothing , _shadUnis' = mempty } + , vbo) {- | Compile shader and get its uniform locations. supposes the shader code is in the shader folder, with the string names @@ -124,21 +124,20 @@ shaderTypeExt' GL_FRAGMENT_SHADER = ".frag" shaderTypeExt' _ = undefined -- I think that this requires that the correct shader program is bound? -setupVAO :: [Int] -> IO VAO +setupVAO :: [Int] -> IO (VAO,VBO) setupVAO = setupVAOSized numDrawableElements -setupVAOSized :: Int -> [Int] -> IO VAO +setupVAOSized :: Int -> [Int] -> IO (VAO,VBO) setupVAOSized ndraw sizes = do vaoname <- mglCreate glCreateVertexArrays glBindVertexArray vaoname theVBO <- setupVBOSized ndraw vaoname sizes - return $ - VAO + return ( VAO { _vaoName = vaoname , _vaoAttribSizes = sizes , _vaoStride = sum sizes - , _vaoVBO = theVBO } + , theVBO) setupVBOSized :: Int -> GLuint -> [Int] -> IO VBO setupVBOSized ndraw vao sizes = do diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 96d8b57f2..771e69aa4 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -11,7 +11,7 @@ module Shader.Data , EPrimitiveMode (..) -- | Lens functions , vaoName - , vaoVBO +-- , vaoVBO , vaoAttribSizes , vaoStride @@ -50,7 +50,7 @@ data VAO = VAO { _vaoName :: GLuint , _vaoAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not , _vaoStride :: Int - , _vaoVBO :: VBO +-- , _vaoVBO :: VBO } {- | Vertex buffer object: contains the reference to the object, a pointer to a location with space that can be written to the buffer, @@ -61,6 +61,7 @@ data VBO = VBO , _vboPtr :: Ptr Float , _vboAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not , _vboStride :: Int + -- add int for AMOUNT of data poked! } data EBO = EBO { _eboName :: GLuint diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 3ba96ada6..7a663b485 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -25,17 +25,17 @@ import Control.Monad.Primitive --import qualified Control.Monad.Parallel as MP pokeVerxs - :: MV.MVector (PrimState IO) FullShader + :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> Picture -> IO () --pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList -pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +pokeVerx :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do typeOff <- UMV.unsafeRead offsets sn - basePtr <- _vboPtr . _vaoVBO . _shadVAO' <$> MV.unsafeRead vbos sn + basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize) poke34 thePtr thePos theCol pokeArrayOff thePtr 7 ext @@ -185,18 +185,18 @@ pokeJustV ptr nv sh = do V4 d e f g = _svCol sh pokeLayVerxs - :: MV.MVector (PrimState IO) FullShader + :: MV.MVector (PrimState IO) (FullShader ,VBO) -> UMV.MVector (PrimState IO) Int -> Picture -> IO () --pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList -pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +pokeLayVerx :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO () --{-# INLINE pokeLayVerx #-} pokeLayVerx vbos counts vx = do theOff <- UMV.unsafeRead counts vecPos - basePtr <- _vboPtr . _vaoVBO . _shadVAO' <$> MV.unsafeRead vbos sn + basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize) poke34 thePtr thePos theCol pokeArrayOff thePtr 7 (_vxExt vx)