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

Interleave vertex buffer data

Browse Source
This commit is contained in:
jgk
2021-06-12 00:50:59 +02:00
parent 1f87dca6ec
commit 5aab790806
4 changed files with 62 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render.hs
+2 -2
View File
@@ -136,7 +136,7 @@ renderBlankWalls
-> GLmatrix GLfloat
-> IO ()
renderBlankWalls pdata wps pmat = do
n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
n <- F.foldM (pokeShader' $ _wallBlankShader pdata) (map Render22x4 wps)
bindShaderBuffers [_wallBlankShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
uniform (_shaderMatrixUniform $ _wallBlankShader pdata) $= pmat
@@ -150,7 +150,7 @@ renderTextureWalls
-> GLmatrix GLfloat
-> IO ()
renderTextureWalls pdata wps pmat = do
n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps)
n <- F.foldM (pokeShader' $ _wallTextureShader pdata) (map Render22x4 wps)
bindShaderBuffers [_wallTextureShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
uniform (_shaderMatrixUniform $ _wallTextureShader pdata) $= pmat
src/Picture/Preload.hs
+10 -6
View File
@@ -38,8 +38,8 @@ makeLenses ''RenderData
preloadRender :: IO RenderData
preloadRender = do
-- lighting shaders
lightningFloorShad <- makeShader "lighting/floor" [vert,geom,frag] [4] Points
(return . return . flat4 . _unRender1111)
lightingFloorShad <- makeShader "lighting/floor" [vert,geom,frag] [4] Points
pokeLightingFloorStrat
wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] Points pokeWPStrat
>>= addUniforms ["lightPos"]
wlLightShad
@@ -62,21 +62,21 @@ preloadRender = do
,[[-1,-1],[0,0]]
,[[ 1,-1],[1,0]]
]
_ <- F.foldM (pokeShader fsShad) [RenderConst] -- fix fullscreen vertex positions now
_ <- F.foldM (pokeShader' fsShad) [RenderConst] -- fix fullscreen vertex positions now
boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const
[[[-1, 1],[0,1]]
,[[ 1, 1],[1,1]]
,[[-1,-1],[0,0]]
,[[ 1,-1],[1,0]]
]
_ <- F.foldM (pokeShader boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now
_ <- F.foldM (pokeShader' boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now
grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const
[[[-1, 1],[0,1]]
,[[ 1, 1],[1,1]]
,[[-1,-1],[0,0]]
,[[ 1,-1],[1,0]]
]
_ <- F.foldM (pokeShader grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now
_ <- F.foldM (pokeShader' grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now
-- background shader
bgShad <- makeShader "background" [vert,geom,frag] [4,2] Points pokeBGStrat
>>= addTexture "data/texture/marbleSlabs.png"
@@ -99,7 +99,7 @@ preloadRender = do
bindFramebuffer Framebuffer $= defaultFramebufferObject
return $ RenderData
{ _pictureShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
, _lightingFloorShader = lightningFloorShad
, _lightingFloorShader = lightingFloorShad
, _lightingOccludeShader = wsShad
, _lightingWallShader = wlLightShad
, _wallBlankShader = wlBlank
@@ -193,6 +193,10 @@ pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType
pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> [flat3 p,flat4 co]) vs
pokeTriStrat _ = []
pokeLightingFloorStrat :: RenderType -> [[[Float]]]
pokeLightingFloorStrat Render1111{_unRender1111=x} = [[flat4 x]]
pokeLightingFloorStrat _ = undefined
pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> [flat3 a, flat4 b, flat3 c]) vs
pokeCharStrat _ = []
src/Picture/Render.hs
+7 -7
View File
@@ -34,7 +34,7 @@ setWallDepth
setWallDepth pdata wallPoints (viewFromx,viewFromy) _ = do
startTicks <- SDL.ticks
colorMask $= Color4 Disabled Disabled Disabled Disabled
nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
nWalls <- F.foldM (pokeShader' $ _lightingOccludeShader pdata) (map Render22 wallPoints)
bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
@@ -76,9 +76,9 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
bindFramebuffer Framebuffer $= _spareFBO pdata
-- store wall and light positions into buffer
nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) (map Render22 wallPoints)
nWallLights <- F.foldM (pokeShader' $ _lightingWallShader pdata) (map Render22 wallPoints)
bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
nWalls <- F.foldM (pokeShader' $ _lightingOccludeShader pdata) (map Render22 wallPoints)
bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
-- set uniforms for shader that draws lights
currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
@@ -114,8 +114,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
stencilTest $= Enabled
forM_ lightPoints $ \(x,y,r,lum) -> do
-- bind buffer for floor light circle
let lightPtr = (\(_,ptr,_) -> ptr) $ head
$ _vaoBufferTargets $ _shaderVAO $ _lightingFloorShader pdata
let lightPtr = _vboPointer $ _vaoVBO $ _shaderVAO $ _lightingFloorShader pdata
pokeFourOff lightPtr 0 (x,y,r,lum)
-- stencil out walls
colorMask $= Color4 Disabled Disabled Disabled Disabled
@@ -200,7 +199,8 @@ renderBackground pdata rot camZoom (tranx,trany) (winx,winy) = do
-- set drawing for on top
--blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
-- draw background
bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
--bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
bindArrayBuffers' 1 $ _vaoVBO $ _shaderVAO $ _backgroundShader pdata
currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
@@ -248,7 +248,7 @@ renderShader
-> IO Word32
renderShader shad dat = do
sticks <- SDL.ticks
i <- F.foldM (pokeShader shad) dat
i <- F.foldM (pokeShader' shad) dat
bindShaderBuffers [shad] [i]
drawShader shad i
eticks <- SDL.ticks
src/Shader.hs
+43 -6
View File
@@ -3,8 +3,10 @@ module Shader
, addTexture
, addUniforms
, pokeShaders
, pokeShader
, bindArrayBuffers
--, pokeShader
, pokeShader'
--, bindArrayBuffers
, bindArrayBuffers'
, bindShaderBuffers
, makeSourcedShader
, setupVAO
@@ -41,7 +43,8 @@ extractProgAndUnis :: FullShader -> (Program,UniformLocation)
extractProgAndUnis s = (_shaderProgram s, _shaderMatrixUniform s)
pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int]
pokeShaders = traverse pokeShader
pokeShaders = traverse pokeShader'
--pokeShaders = traverse pokeShader
pokeShader :: FullShader -> F.FoldM IO RenderType Int
pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss)) (return 0) return
@@ -49,13 +52,39 @@ pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss)) (return 0) return
(_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets $ _shaderVAO fs
fls = _shaderPokeStrategy fs
pokeShader' :: FullShader -> F.FoldM IO RenderType Int
pokeShader' fs = F.FoldM (pokeRender' fls ptr stride) (return 0) return
where
theVBO = _vaoVBO $ _shaderVAO fs
ptr = _vboPointer theVBO
stride = sum $ _vboAttribSizes theVBO
fls = _shaderPokeStrategy fs
pokeRender :: (RenderType -> [[[Float]]])
-> [(Ptr Float,Int)] -> Int -> RenderType -> IO Int
pokeRender toFs ptrs n rt = pokeList ptrs n (toFs rt)
pokeRender'
:: (RenderType
-> [[[Float]]])
-> Ptr Float
-> Int -- ^ stride
-> Int
-> RenderType
-> IO Int
pokeRender' toFs ptr stride n rt = pokeList' ptr stride n (toFs rt)
pokeList :: [(Ptr Float,Int)] -> Int -> [[[Float]]] -> IO Int
pokeList ptrs = foldM (pokePtrs ptrs)
pokeList' :: Ptr Float -> Int -> Int -> [[[Float]]] -> IO Int
pokeList' ptr stride = foldM (pokePtrs' ptr stride)
pokePtrs' :: Ptr Float -> Int -> Int -> [[Float]] -> IO Int
pokePtrs' ptr stride n fss = do
pokeArrayOff ptr (stride * n) (concat fss)
return $ n + 1
pokePtrs :: [(Ptr Float,Int)] -> Int -> [[Float]] -> IO Int
pokePtrs ptrIs n fss = do
zipWithM_ f ptrIs fss
@@ -73,10 +102,18 @@ bindArrayBuffers numVs ps = do
bindBuffer ArrayBuffer $= Just bo
bufferData ArrayBuffer $= (fromIntegral $ floatSize * numVs * i, ptr, DynamicDraw)
bindArrayBuffers' :: Int -> VBO -> IO ()
bindArrayBuffers' numVs theVBO = do
bindBuffer ArrayBuffer $= Just (_vbo theVBO)
bufferData ArrayBuffer $=
(fromIntegral $ floatSize * numVs * (sum $ _vboAttribSizes theVBO), _vboPointer theVBO, DynamicDraw)
bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
bindShaderBuffers = zipWithM_ f
where
f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs
--f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs
f fs i = bindArrayBuffers' i $ _vaoVBO $ _shaderVAO fs
drawShaders :: [FullShader] -> [Int] -> IO ()
drawShaders = zipWithM_ drawShader
@@ -137,7 +174,7 @@ floatSize = sizeOf (0.5 :: GLfloat)
{-# INLINE floatSize #-}
bufferOffset :: Integral a => a -> Ptr b
bufferOffset = plusPtr nullPtr . fromIntegral
bufferOffset = plusPtr nullPtr . (* floatSize) . fromIntegral
numDrawableElements :: Int
{-# INLINE numDrawableElements #-}
@@ -147,9 +184,9 @@ setupVAO :: [Int] -> IO VAO
setupVAO sizes = do
theVAO <- genObjectName
bindVertexArrayObject $= Just theVAO
theVBO <- setupVBO $ sizes
vbos <- forM (zip (map fromIntegral [(0::Int)..]) sizes) setupArrayBuffer
ptrs <- forM (zip vbos sizes) setupVBOPointers
theVBO <- setupVBO $ sizes
return $ VAO
{ _vao = theVAO
, _vaoBufferTargets = ptrs