justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor shaders, vbos and vaos

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