diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index c07b739d4..11ad1431d 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -35,7 +35,7 @@ data RenderData = RenderData , _colorBlurShader :: FullShader , _barrelShader :: (FullShader,VBO) , _grayscaleShader :: FullShader - , _shapeShader :: (FullShader,VBO) + , _shapeShader :: FullShader , _shapeEBO :: EBO , _silhouetteEBO :: EBO , _pictureShaders :: MV.MVector (PrimState IO) (FullShader,VBO) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 1aae255ed..7ea73779f 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -88,9 +88,9 @@ doDrawing' win pdata u = do ) -- bind wall points, silhouette data, surface geometry bindShaderLayers shadV layerCounts - uncurry bindShaderBuffers $ + uncurry (zipWithM_ bufferPokedVBO) $ unzip - [ ((pdata ^. vboWalls), nWalls) + [ (pdata ^. vboWalls, nWalls) , (_vboShapes pdata, nShapeVs) , (pdata ^. vboWindows, nWins) , (snd $ _textureArrayShader pdata, nFls) @@ -121,7 +121,7 @@ doDrawing' win pdata u = do glUseProgram (pdata ^. lightingWallShadShader . shadName) glUniform3f (pdata ^?! lightingWallShadShader . shadUnis' . ix 0) vfx vfy 20 glUniform1f (pdata ^?! lightingWallShadShader . shadUnis' . ix 1) 100 - glBindVertexArray $ pdata ^. lightingWallShadShader . shadVAO' . vaoName + glBindVertexArray $ pdata ^. lightingWallShadShader . shadVAO . vaoName unless (debugOn Remove_LOS cfig) $ glDrawArrays (marshalEPrimitiveMode $ pdata ^. lightingWallShadShader . shadPrim') @@ -136,10 +136,10 @@ doDrawing' win pdata u = do renderLayer BottomLayer shadV layerCounts --draw object shapes onto base buffer let fs = _shapeShader pdata - glUseProgram (_shadName $ fst fs) - glBindVertexArray $ fs ^. _1 . shadVAO' . vaoName + glUseProgram (_shadName $ fs) + glBindVertexArray $ fs ^. shadVAO . vaoName glDrawElements - (marshalEPrimitiveMode $ _shadPrim' $ fst fs) + (marshalEPrimitiveMode $ _shadPrim' $ fs) (fromIntegral nIndices) GL_UNSIGNED_SHORT nullPtr @@ -260,7 +260,7 @@ doDrawing' win pdata u = 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 [snd $ _barrelShader pdata] [1] + bufferPokedVBO (snd $ _barrelShader pdata) 1 drawShader (fst $ _barrelShader pdata) 1 fboList = take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata])) diff --git a/src/Dodge/Render/Shadow.hs b/src/Dodge/Render/Shadow.hs index bd4cbac0b..4b72643e5 100644 --- a/src/Dodge/Render/Shadow.hs +++ b/src/Dodge/Render/Shadow.hs @@ -6,14 +6,14 @@ module Dodge.Render.Shadow where import Control.Lens import Data.Preload.Render import qualified Data.Vector as V -import qualified Data.Vector.Fusion.Stream.Monadic as VFSM +--import qualified Data.Vector.Fusion.Stream.Monadic as VFSM import Foreign import Geometry -import Graphics.GL.Core45 +--import Graphics.GL.Core45 import Linear.V3 (cross) -import Shader.Data -import Shader.ExtraPrimitive -import Shader.Parameters +--import Shader.Data +--import Shader.ExtraPrimitive +--import Shader.Parameters import Shape.Data drawCPUShadows :: RenderData -> Shape -> Point3 -> Float -> IO () diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 91592113c..31fbeefa2 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -47,7 +47,7 @@ preloadRender = do ( fromIntegral $ floatSize * numDrawableWalls * 8) nullPtr GL_STREAM_DRAW - let wpVBO = VBO{_vboName = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8} + let wpVBO = VBO{_vboName = wpVBOname, _vboPtr = wpVBOptr, _vboVertexSize = 8} -- wpVAOname <- genObjectName -- bindVertexArrayObject $= Just wpVAOname wpVAOname <- mglCreate glCreateVertexArrays @@ -68,7 +68,7 @@ preloadRender = do ( fromIntegral $ floatSize * numDrawableWalls * 8) nullPtr GL_STREAM_DRAW - let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8} + let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboVertexSize = 8} --winColVAOname <- genObjectName --bindVertexArrayObject $= Just winColVAOname winColVAOname <- mglCreate glCreateVertexArrays @@ -86,37 +86,29 @@ preloadRender = do nullPtr GL_STREAM_DRAW let shEBO = EBO{_eboName = shEBOname, _eboPtr = shEBOptr} - shVBOname <- mglCreate glCreateBuffers - shVBOptr <- mallocArray (7 * numDrawableElements) - glNamedBufferData shVBOname - ( fromIntegral $ floatSize * numDrawableElements * 7) - nullPtr - GL_STREAM_DRAW - let shVBO = VBO{_vboName = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8} - --shPosColVAOname <- genObjectName - --bindVertexArrayObject $= Just shPosColVAOname - shPosColVAOname <- mglCreate glCreateVertexArrays - glBindVertexArray shPosColVAOname - setupVertexAttribPointer shPosColVAOname shVBOname 0 3 7 0 - setupVertexAttribPointer shPosColVAOname shVBOname 1 4 7 3 - --bindBuffer ElementArrayBuffer $= Just shEBOname - glVertexArrayElementBuffer shPosColVAOname shEBOname + shVBO <- trueSetupVBO 8 +-- shPosColVAOname <- mglCreate glCreateVertexArrays +-- glBindVertexArray shPosColVAOname +-- setupVertexAttribPointer shPosColVAOname (shVBO ^. vboName) 0 3 7 0 +-- setupVertexAttribPointer shPosColVAOname (shVBO ^. vboName) 1 4 7 3 +-- --bindBuffer ElementArrayBuffer $= Just shEBOname +-- glVertexArrayElementBuffer shPosColVAOname shEBOname --shPosVAOname <- genObjectName --bindVertexArrayObject $= Just shPosVAOname shPosVAOname <- mglCreate glCreateVertexArrays glBindVertexArray shPosVAOname - setupVertexAttribPointer shPosVAOname shVBOname 0 3 7 0 + setupVertexAttribPointer shPosVAOname (shVBO ^. vboName) 0 4 8 0 --bindBuffer ElementArrayBuffer $= Just shEBOname glVertexArrayElementBuffer shPosVAOname shEBOname - let shPosColVAO = VAO - {_vaoName = shPosColVAOname, _vaoAttribSizes = [3,4], _vaoStride = 7} + let --shPosColVAO = VAO + -- {_vaoName = shPosColVAOname, _vaoAttribSizes = [3,4], _vaoStride = 7} shPosVAO = VAO{_vaoName = shPosVAOname, _vaoAttribSizes = [3], _vaoStride = 7} --setup silhouette edge VAO --shEdgeVAOname <- genObjectName --bindVertexArrayObject $= Just shEdgeVAOname shEdgeVAOname <- mglCreate glCreateVertexArrays glBindVertexArray shEdgeVAOname - setupVertexAttribPointer shEdgeVAOname shVBOname 0 3 7 0 + setupVertexAttribPointer shEdgeVAOname (shVBO ^. vboName) 0 4 8 0 --setup ebo for silhouette edges silEBOname <- mglCreate glCreateBuffers silEBOptr <- mallocArray numDrawableElements @@ -158,13 +150,14 @@ preloadRender = do positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] ETriangles -- 2D draw shaders bslist <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] ETriangles - bslista <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] ETriangles + bslista <- makeShader' "shape/basic" [vert, frag] [4, 4] ETriangles shVBO + glVertexArrayElementBuffer (bslista ^. shadVAO . vaoName) shEBOname aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] ETriangles eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] ETriangles bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] ETriangleStrip cslist <- makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] ETriangles - >>= (_1 (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 @@ -176,7 +169,7 @@ preloadRender = do -- could possibly use an indirect draw call pokeArray (shadVBOptr fsShad) $ concat cornerList - let fsshadvao = fsShad ^. _1 . shadVAO' + let fsshadvao = fsShad ^. _1 . shadVAO bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip fsshadvao colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip fsshadvao @@ -199,7 +192,7 @@ preloadRender = do >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png" -- >>= addTextureArray "data/texture/ayene_wooden_floor.png" -- bind fixed vertex data - bindShaderBuffers [snd fsShad] [4, 4] + bufferPokedVBO (snd fsShad) 4 framebuf2 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600 @@ -245,7 +238,7 @@ preloadRender = do return $ RenderData { _pictureShaders = shadV - , _shapeShader = bslista & _1 . shadVAO' .~ shPosColVAO + , _shapeShader = bslista -- & shadVAO' .~ shPosColVAO , _shapeEBO = shEBO , _silhouetteEBO = silEBO , _lightingCapShader = lightingCapShad @@ -259,7 +252,7 @@ preloadRender = do , _positionalBlankShader = positionalBlankShad , _wallBlankShader = wallBlankShad , _wallTextureShader = wallTextureShad - , _windowShader = wallBlankShad{_shadVAO' = winColVAO} + , _windowShader = wallBlankShad{_shadVAO = winColVAO} , _textureArrayShader = textArrayShad , _fullscreenShader = fsShad , _lightingTextureShader = lightingTextureShad diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index 600a10f9b..28187b5d1 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 . _1 . shadVAO') + (rdata ^. fullscreenShader . _1 . shadVAO) return (rdata'{_bloomBlurShader = bbShad}) diff --git a/src/Render.hs b/src/Render.hs index ade63e02a..fe70be159 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -84,7 +84,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra glUniform3f (_shadUnis' ltextShad V.! 0) x y z glUniform4f (_shadUnis' ltextShad V.! 1) r g b rad --bindVertexArrayObject $= ltextShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad) - glBindVertexArray $ ltextShad ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad) + glBindVertexArray $ ltextShad ^. shadVAO . vaoName -- Just (_vao $ _shadVAO ltextShad) glDrawArrays (marshalEPrimitiveMode (_shadPrim' ltextShad)) 0 @@ -135,7 +135,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra glUseProgram (_shadName lwallShad) glUniform3f (_shadUnis' lwallShad V.! 0) x y z glUniform1f (_shadUnis' lwallShad V.! 1) rad - glBindVertexArray $ lwallShad ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad) + glBindVertexArray $ lwallShad ^. shadVAO . vaoName -- Just (_vao $ _shadVAO lwallShad) glDrawArrays (marshalEPrimitiveMode $ _shadPrim' lwallShad) 0 @@ -147,7 +147,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra glUseProgram (_shadName llinesShad) glUniform3f (_shadUnis' llinesShad V.! 0) x y z glUniform1f (_shadUnis' llinesShad V.! 1) rad - glBindVertexArray (_vaoName $ _shadVAO' llinesShad) + glBindVertexArray (_vaoName $ _shadVAO llinesShad) glDrawElements (marshalEPrimitiveMode $ _shadPrim' llinesShad) (fromIntegral nSils) @@ -159,7 +159,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra glCullFace GL_FRONT glUseProgram (_shadName lcapShad) glUniform3f (_shadUnis' lcapShad V.! 0) x y z - glBindVertexArray $ lcapShad ^. shadVAO' . vaoName --Just (_vao $ _shadVAO lcapShad) + glBindVertexArray $ lcapShad ^. shadVAO . vaoName --Just (_vao $ _shadVAO lcapShad) glDrawElements (marshalEPrimitiveMode $ _shadPrim' lcapShad) (fromIntegral nCaps) @@ -179,7 +179,7 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos dra glUniform3f (_shadUnis' ltextShad V.! 0) x y z glUniform4f (_shadUnis' ltextShad V.! 1) r g b rad --bindVertexArrayObject $= ltextShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad) - glBindVertexArray $ ltextShad ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad) + glBindVertexArray $ ltextShad ^. shadVAO . vaoName -- Just (_vao $ _shadVAO ltextShad) glDrawArrays (marshalEPrimitiveMode (_shadPrim' ltextShad)) 0 @@ -247,14 +247,14 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do glStencilFunc GL_ALWAYS 0 255 --draw wall shadows glUseProgram $ pdata ^. shadowWallShader . shadName - glBindVertexArray $ pdata ^. shadowWallShader . shadVAO' . vaoName + glBindVertexArray $ pdata ^. shadowWallShader . shadVAO . vaoName glDrawArrays (marshalEPrimitiveMode $ pdata ^. shadowWallShader . shadPrim') 0 (fromIntegral nWalls) --draw silhouette shadows glUseProgram $ pdata ^. shadowEdgeShader . shadName - glBindVertexArray $ pdata ^. shadowEdgeShader . shadVAO' . vaoName + glBindVertexArray $ pdata ^. shadowEdgeShader . shadVAO . vaoName glDrawElements (marshalEPrimitiveMode $ pdata ^. shadowEdgeShader . shadPrim') (fromIntegral nSils) @@ -265,7 +265,7 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do glCullFace GL_BACK --glCullFace GL_FRONT glUseProgram (_shadName lcapShad) - glBindVertexArray $ lcapShad ^. shadVAO' . vaoName + glBindVertexArray $ lcapShad ^. shadVAO . vaoName glDrawElements (marshalEPrimitiveMode $ _shadPrim' lcapShad) (fromIntegral nCaps) diff --git a/src/Shader.hs b/src/Shader.hs index 91d755682..0ad752ed7 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -26,7 +26,7 @@ drawShaderLay l countsVector shadIn fs = do i <- UMV.read countsVector shadIn --currentProgram $= Just (_shadProg' fs) glUseProgram (_shadName $ fst fs) - glBindVertexArray $ fs ^. _1 . shadVAO' . vaoName + glBindVertexArray $ fs ^. _1 . shadVAO . vaoName --bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs) case _shadTex' $ fst fs of Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt} @@ -44,7 +44,7 @@ drawShader :: FullShader -> Int -> IO () drawShader fs i = do --currentProgram $= Just (_shadProg fs) glUseProgram (_shadName fs) - glBindVertexArray $ fs ^. shadVAO' . vaoName + glBindVertexArray $ fs ^. shadVAO . vaoName --bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs) case _shadTex' fs of Just ShaderTexture{_textureObject = txo @@ -67,7 +67,7 @@ pokeBindFoldable -> IO () pokeBindFoldable shadV counts m = do pokeVerxs shadV counts m - bindShader shadV counts + bufferShaderVector shadV counts pokeBindFoldableLayer :: MV.MVector (PrimState IO) (FullShader,VBO) diff --git a/src/Shader/Bind.hs b/src/Shader/Bind.hs index 84efca006..c5c0dd65d 100644 --- a/src/Shader/Bind.hs +++ b/src/Shader/Bind.hs @@ -1,25 +1,27 @@ -module Shader.Bind - ( bindShaderLayers - , bindShaderBuffers - , bindShader - ) where +module Shader.Bind ( + bindShaderLayers, + --, bindShaderBuffers + bufferPokedVBO, + bufferShaderVector, +) where + +import Control.Monad.Primitive +import qualified Data.Vector.Fusion.Stream.Monadic as VFSM +import qualified Data.Vector.Mutable as MV +import qualified Data.Vector.Unboxed.Mutable as UMV +import Foreign hiding (rotate) +--import Control.Monad +import Graphics.GL.Core45 import Shader.Data import Shader.Parameters -import Foreign hiding (rotate) -import qualified Data.Vector.Unboxed.Mutable as UMV -import qualified Data.Vector.Mutable as MV -import qualified Data.Vector.Fusion.Stream.Monadic as VFSM -import Control.Monad.Primitive -import Control.Monad -import Graphics.GL.Core45 - -bindArrayBuffers :: Int -> VBO -> IO () -{-# INLINABLE bindArrayBuffers #-} -bindArrayBuffers numVs theVBO = glNamedBufferSubData - (_vboName theVBO) - 0 - (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) +bufferPokedVBO :: VBO -> Int -> IO () +{-# INLINEABLE bufferPokedVBO #-} +bufferPokedVBO theVBO numVs = + glNamedBufferSubData + (_vboName theVBO) + 0 + (fromIntegral $ floatSize * numVs * _vboVertexSize theVBO) (_vboPtr theVBO) bindShaderLayers :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO () @@ -27,7 +29,7 @@ bindShaderLayers shads counts = MV.imapM_ f shads where f i shad = do let theVBO = snd shad - stride = sum $ _vboAttribSizes theVBO + stride = _vboVertexSize theVBO VFSM.mapM_ (g stride theVBO) $ VFSM.enumFromStepN 0 1 6 -- [0..5] where g stride theVBO lay = do @@ -41,12 +43,10 @@ bindShaderLayers shads counts = MV.imapM_ f shads glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO () glNamedBufferSubDataH = glNamedBufferSubData -bindShader :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> IO () -bindShader shads counts = MV.imapM_ f shads +bufferShaderVector :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO () +bufferShaderVector shads counts = MV.imapM_ f shads where - f i shad = UMV.read counts i >>= flip bindArrayBuffers (snd shad) + f i shad = UMV.read counts i >>= bufferPokedVBO (snd shad) -bindShaderBuffers :: [VBO] -> [Int] -> IO () -bindShaderBuffers = zipWithM_ f - where - f fs i = bindArrayBuffers i fs +--bindShaderBuffers :: [VBO] -> [Int] -> IO () +--bindShaderBuffers = zipWithM_ bufferPokedVBO diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index e4716e9d5..8d679c760 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -1,5 +1,7 @@ module Shader.Compile ( + trueSetupVBO, makeShader, + makeShader', makeByteStringShaderUsingVAO, makeShaderSized, makeShaderUsingVAO, @@ -16,6 +18,7 @@ import GLHelp import Graphics.GL.Core45 import Shader.Data import Shader.Parameters +--import Graphics.GL.Core45 {- | Compiles a full shader found within the shader directory. @@ -35,13 +38,45 @@ makeShader s shaderlist sizes pm = do (vao,vbo) <- setupVAO sizes return ( FullShader { _shadName = prog - , _shadVAO' = vao + , _shadVAO = vao , _shadPrim' = pm , _shadTex' = Nothing , _shadUnis' = mempty } , vbo) +makeShader' :: + -- | First part of the name of the shader + String -> + -- | shader types + [GLenum] -> + -- | The input vertex sizes + [Int] -> + EPrimitiveMode -> + VBO -> + IO FullShader +makeShader' s shaderlist sizes pm vbo = do + prog <- makeSourcedShader s shaderlist + vao <- setupVAOvbo sizes vbo + return $ FullShader + { _shadName = prog + , _shadVAO = vao + , _shadPrim' = pm + , _shadTex' = Nothing + , _shadUnis' = mempty + } + +trueSetupVBO :: Int -> IO VBO +trueSetupVBO vertexsize = do + vboname <- mglCreate glCreateBuffers + thePtr <- mallocArray (vertexsize * numDrawableElements) + -- Allocate space + glNamedBufferData vboname + ( fromIntegral $ floatSize * numDrawableElements * vertexsize) + nullPtr + GL_STREAM_DRAW + return VBO {_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize} + makeByteStringShaderUsingVAO :: -- | (Arbitrary) name of the shader String -> @@ -55,7 +90,7 @@ makeByteStringShaderUsingVAO s shaderlist pm vao = do return $ FullShader { _shadName = prog - , _shadVAO' = vao + , _shadVAO = vao , _shadPrim' = pm , _shadTex' = Nothing , _shadUnis' = mempty @@ -75,7 +110,7 @@ makeShaderUsingVAO s shaderlist pm theVAO = do return $ FullShader { _shadName = prog - , _shadVAO' = theVAO + , _shadVAO = theVAO , _shadPrim' = pm , _shadTex' = Nothing , _shadUnis' = mempty @@ -101,7 +136,7 @@ makeShaderSized s shaderlist sizes ndraw pm = do (vao,vbo) <- setupVAOSized ndraw sizes return ( FullShader { _shadName = prog - , _shadVAO' = vao + , _shadVAO = vao , _shadPrim' = pm , _shadTex' = Nothing , _shadUnis' = mempty @@ -127,6 +162,17 @@ shaderTypeExt' _ = undefined setupVAO :: [Int] -> IO (VAO,VBO) setupVAO = setupVAOSized numDrawableElements +setupVAOvbo :: [Int] -> VBO -> IO VAO +setupVAOvbo sizes vbo = do + vaoname <- mglCreate glCreateVertexArrays + glBindVertexArray vaoname + setupVertexAttribs vbo vaoname sizes + return $ VAO + { _vaoName = vaoname + , _vaoAttribSizes = sizes + , _vaoStride = sum sizes + } + setupVAOSized :: Int -> [Int] -> IO (VAO,VBO) setupVAOSized ndraw sizes = do vaoname <- mglCreate glCreateVertexArrays @@ -156,13 +202,21 @@ setupVBOSized ndraw vao sizes = do VBO { _vboName = vboname , _vboPtr = thePtr - , _vboAttribSizes = sizes - , _vboStride = sum sizes + , _vboVertexSize = sum sizes } where strd = sum sizes offs = scanl (+) 0 sizes +setupVertexAttribs :: VBO -> GLuint -> [Int] -> IO () +setupVertexAttribs vbo vao sizes = do + let vboname = _vboName vbo + forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do + setupVertexAttribPointer vao vboname loc siz strd off + where + strd = sum sizes + offs = scanl (+) 0 sizes + -- | Assumes the correct VBO is bound setupVertexAttribPointer :: GLuint -> diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 771e69aa4..a6e9e14b2 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -17,13 +17,12 @@ module Shader.Data , vboName , vboPtr - , vboAttribSizes - , vboStride + , vboVertexSize , eboName , eboPtr , shadName - , shadVAO' + , shadVAO , shadPrim' , shadTex' , shadUnis' @@ -39,7 +38,7 @@ import Control.Lens {- | Datatype containing the necessary information for a single shader. -} data FullShader = FullShader { _shadName :: GLuint -- should be shaderID - , _shadVAO' :: VAO + , _shadVAO :: VAO , _shadPrim' :: EPrimitiveMode , _shadTex' :: Maybe ShaderTexture , _shadUnis' :: Vector GLint @@ -59,8 +58,7 @@ Vertex attributes are interleaved within the vbo. -} data VBO = VBO { _vboName :: GLuint , _vboPtr :: Ptr Float - , _vboAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not - , _vboStride :: Int + , _vboVertexSize :: Int -- add int for AMOUNT of data poked! } data EBO = EBO diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 7a663b485..9e47a9c47 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -171,18 +171,19 @@ pokeJustV :: Ptr Float -> IO Int {-# INLINE pokeJustV #-} pokeJustV ptr nv sh = do - pokeElemOff ptr (off 0) a - pokeElemOff ptr (off 1) b - pokeElemOff ptr (off 2) c - pokeElemOff ptr (off 3) d - pokeElemOff ptr (off 4) e - pokeElemOff ptr (off 5) f - pokeElemOff ptr (off 6) g + pokeElemOff ptr (off 0) x + pokeElemOff ptr (off 1) y + pokeElemOff ptr (off 2) z + pokeElemOff ptr (off 3) 0 + pokeElemOff ptr (off 4) r + pokeElemOff ptr (off 5) g + pokeElemOff ptr (off 6) b + pokeElemOff ptr (off 7) a return (nv + 1) where - off i = nv*7 + i - V3 a b c = _svPos sh - V4 d e f g = _svCol sh + off i = nv*8 + i + V3 x y z = _svPos sh + V4 r g b a = _svCol sh pokeLayVerxs :: MV.MVector (PrimState IO) (FullShader ,VBO)