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
, _barrelShader :: (FullShader,VBO)
, _grayscaleShader :: FullShader
, _shapeShader :: (FullShader,VBO)
, _shapeShader :: FullShader
, _shapeEBO :: EBO
, _silhouetteEBO :: EBO
, _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
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]))
src/Dodge/Render/Shadow.hs
+5 -5
View File
@@ -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 ()
src/Preload/Render.hs
+20 -27
View File
@@ -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
src/Preload/Update.hs
+1 -1
View File
@@ -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})
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
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)
src/Shader.hs
+3 -3
View File
@@ -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)
src/Shader/Bind.hs
+27 -27
View File
@@ -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
src/Shader/Compile.hs
+60 -6
View File
@@ -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 ->
src/Shader/Data.hs
+4 -6
View File
@@ -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
src/Shader/Poke.hs
+11 -10
View File
@@ -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)