Upload wall geometry once per frame (can improve for fixed geometry)

2021-07-11 17:32:23 +02:00
parent 37d3e0ce63
commit 26c6c3e426
4 changed files with 77 additions and 57 deletions
@@ -54,7 +54,10 @@ doDrawing pdata w = do
        --viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
        viewFroms = _cameraViewFrom w
        pic = worldPictures w
-        wallPoints = map fst wallPointsCol
+
+    -- bind wall points and colors to vbo
+    nWalls <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol)
+    bindShaderBuffers [_wallTextureShader pdata] [nWalls]
    -- set the coordinate uniform ready for drawing elements using world coordinates
    bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
    bindFramebuffer Framebuffer $= (fst $ _fboBase pdata)
@@ -62,8 +65,8 @@ doDrawing pdata w = do
    clear [ColorBuffer,DepthBuffer]
    depthFunc $= Just Less
    if w ^. config . wall_textured
-        then renderTextureWalls pdata wallPointsCol
-        else renderBlankWalls pdata wallPointsCol
+        then renderTextureWalls pdata nWalls
+        else renderBlankWalls pdata nWalls
 --    _ <- setWallDepth pdata wallPoints (viewFromx,viewFromy)
    _ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic $ foregroundPics w)
    _ <- renderFoldable pdata $ picToLTree (Just 0) pic
@@ -108,8 +111,8 @@ doDrawing pdata w = do

    bindFramebuffer Framebuffer $= (fst $ _fboLighting pdata)
    let scPol = screenPolygon w
-    createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints
-        (foregroundPics w) scPol
+    createLightMap pdata (w ^. config . shadow_resolution) lightPoints
+        (foregroundPics w) scPol nWalls
    colorMask $= Color4 Enabled Enabled Enabled Enabled
    clearColor $= Color4 0 0 0 0

@@ -136,7 +139,7 @@ doDrawing pdata w = do

    depthFunc $= Just Lequal
    _ <- renderFoldable pdata $ picToLTree (Just 2) pic
-    renderBlankWalls pdata windowPoints
+    renderWindows pdata windowPoints

    depthFunc $= Just Always
    blendFunc $= (One,Zero)
@@ -208,11 +211,21 @@ bufferUBO mat = withArray mat $ \ptr ->
    bufferSubData UniformBuffer WriteToBuffer 0 64 ptr

 renderBlankWalls 
+    :: RenderData 
+    -> Int -- ^ number of walls
+--    -> GLmatrix GLfloat 
+    -> IO ()
+renderBlankWalls pdata nWalls = do
+    cullFace $= Just Back
+    drawShader (_wallBlankShader pdata) nWalls
+    cullFace $= Nothing
+
+renderWindows 
    :: RenderData 
    -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
 --    -> GLmatrix GLfloat 
    -> IO ()
-renderBlankWalls pdata wps = do
+renderWindows pdata wps = do
    n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
    bindShaderBuffers [_wallBlankShader pdata] [n]
    currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
@@ -222,12 +235,9 @@ renderBlankWalls pdata wps = do

 renderTextureWalls 
    :: RenderData 
-    -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
+    -> Int   -- ^ number of walls
    -> IO ()
-renderTextureWalls pdata wps = do
-    n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps)
-    bindShaderBuffers [_wallTextureShader pdata] [n]
-    currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
+renderTextureWalls pdata nWalls = do
    cullFace $= Just Back
-    drawShader (_wallTextureShader pdata) n
+    drawShader (_wallTextureShader pdata) nWalls
    cullFace $= Nothing
@@ -10,6 +10,7 @@ import Shader
 import Shader.Data
 import Shader.Compile
 import Shader.AuxAddition
+import Shader.Parameters
 import Data.Preload.Render

 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
@@ -19,22 +20,39 @@ import Foreign

 preloadRender :: IO RenderData
 preloadRender = do
-
    -- set up uniform buffer object
    theUBO <- genObjectName
    bindBuffer UniformBuffer $= Just theUBO
    bufferData UniformBuffer $= (64, nullPtr, DynamicDraw)
    bindBufferBase IndexedUniformBuffer 0 $= Just theUBO
+    -- setup wall points VBO, VAOs and shaders
+    wpVBOname <- genObjectName
+    wpVBOptr <- mallocArray (8 * numDrawableElements)
+    bindBuffer ArrayBuffer $= Just wpVBOname
+    bufferData ArrayBuffer $=
+        (fromIntegral $ floatSize * numDrawableElements * 8
+        , nullPtr
+        , DynamicDraw
+        )
+    let wpVBO = VBO {_vbo = wpVBOname, _vboPointer = wpVBOptr, _vboAttribSizes = [4,4]}
+    wpVAOname <- genObjectName
+    bindVertexArrayObject $= Just wpVAOname
+    bindBuffer ArrayBuffer $= Just wpVBOname
+    setupVertexAttribPointer 0 4 8 0
+    wpColVAOname <- genObjectName
+    bindVertexArrayObject $= Just wpColVAOname
+    bindBuffer ArrayBuffer $= Just wpVBOname
+    setupVertexAttribPointer 0 4 8 0
+    setupVertexAttribPointer 1 4 8 4
+    let wpVAO = VAO {_vao = wpVAOname, _vaoVBO = wpVBO}
+        wpColVAO = VAO {_vao = wpColVAOname, _vaoVBO = wpVBO}

-- lighting shaders
+    -- lighting shaders
    wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] EPoints pokeWPStrat
                >>= addUniforms ["lightPos"]
    wlLightShad 
         <- makeShaderUsingShaderVAO "lighting/wall" [vert,geom,frag] EPoints wsShad
                >>= addUniforms ["lightPos","radLum"]
--    wlLightShad 
--         <- makeShader "lighting/wall" [vert,geom,frag] [4] EPoints pokeWPStrat
--                >>= addUniforms ["lightPos","radLum"]
    lightingSurfaceShad
         <- makeShader "lighting/surface" [vert,frag] [3] ETriangles poke3
                >>= addUniforms ["lightPos","radLum"]
@@ -58,12 +76,9 @@ preloadRender = do
    fsShad <- makeShader "texture/simple" [vert,frag] [2,2] ETriangleStrip $ const cornerList
    -- note we directly poke the shader vertex data here
    pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fsShad) $ concat cornerList
-    bloomBlurShad <- makeShader "texture/bloomBlur" [vert,frag] [2,2] ETriangleStrip $ const cornerList
-    pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO bloomBlurShad) $ concat cornerList
-    colorBlurShad <- makeShader "texture/colorBlur" [vert,frag] [2,2] ETriangleStrip $ const cornerList
-    pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO colorBlurShad) $ concat cornerList
-    grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] ETriangleStrip $ const cornerList
-    pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO grayscaleShad) $ concat cornerList
+    bloomBlurShad <- makeShaderUsingShaderVAO "texture/bloomBlur" [vert,frag] ETriangleStrip fsShad
+    colorBlurShad <- makeShaderUsingShaderVAO "texture/colorBlur" [vert,frag] ETriangleStrip fsShad
+    grayscaleShad <- makeShaderUsingShaderVAO "texture/grayscale" [vert,frag] ETriangleStrip fsShad
    barrelShad <- makeShader "texture/barrel" [vert,geom,frag] [2,2,2,1] EPoints pokeRadDist
 -- blank wallShader
    wlBlank <- makeShader "wall/blank" [vert,geom,frag] [4,4] EPoints pokeWPColStrat
@@ -77,7 +92,7 @@ preloadRender = do
    textArrayShad <- makeShader "texture/array" [vert,frag] [3,3] ETriangles poke33
        >>= addTextureArray "data/texture/ayene_wooden_floor.png"
    -- bind fixed vertex data
-    bindShaderBuffers [fsShad,bloomBlurShad,colorBlurShad,fullscreenAlphaHalveShad] [4,4,4,4]
+    bindShaderBuffers [fsShad,fullscreenAlphaHalveShad] [4,4]
 -- framebuffer for lighting
    (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil
    framebuf2 <- setupFramebufferWithStencil
@@ -110,10 +125,10 @@ preloadRender = do
            [bslist,lslist,cslist,aslist,eslist,bezierQuadShader,basicTweakZShad]
        , _lightingSurfaceShader    = lightingSurfaceShad
        , _lightingLineShadowShader = lightingLineShadowShad
-        , _lightingOccludeShader    = wsShad
-        , _lightingWallShader       = wlLightShad
-        , _wallBlankShader          = wlBlank
-        , _wallTextureShader        = wlTexture
+        , _lightingOccludeShader    = wsShad        {_shaderVAO = wpVAO}
+        , _lightingWallShader       = wlLightShad   {_shaderVAO = wpVAO}
+        , _wallBlankShader          = wlBlank { _shaderVAO = wpColVAO }
+        , _wallTextureShader        = wlTexture { _shaderVAO = wpColVAO }
        , _textureShader            = textShad
        , _textureArrayShader       = textArrayShad
        , _fullscreenShader         = fsShad
@@ -22,26 +22,26 @@ import Data.Tuple.Extra
 --import qualified Data.IntMap.Strict as IM
 import qualified SDL

-setWallDepth
-    :: RenderData
-    -> [(Point2,Point2)]    -- ^ Wall points
-    -> (Float,Float)        -- ^ View from point
-    -> IO Word32
-setWallDepth pdata wallPoints (viewFromx,viewFromy) = do
-    startTicks <- SDL.ticks
-    colorMask $= Color4 Disabled Disabled Disabled Disabled
-    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
-    bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
-
-    currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
-    -- reseting this uniform appears to be necessary
-    uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
-            $= Vector2 viewFromx viewFromy  
--    cullFace $= Just Front
-    drawShader (_lightingOccludeShader pdata) nWalls
-    colorMask $= Color4 Enabled Enabled Enabled Enabled
-    endTicks <- SDL.ticks
-    return $ endTicks - startTicks
+--setWallDepth
+--    :: RenderData
+--    -> [(Point2,Point2)]    -- ^ Wall points
+--    -> (Float,Float)        -- ^ View from point
+--    -> IO Word32
+--setWallDepth pdata wallPoints (viewFromx,viewFromy) = do
+--    startTicks <- SDL.ticks
+--    colorMask $= Color4 Disabled Disabled Disabled Disabled
+--    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
+--    bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
+--
+--    currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
+--    -- reseting this uniform appears to be necessary
+--    uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
+--            $= Vector2 viewFromx viewFromy  
+----    cullFace $= Just Front
+--    drawShader (_lightingOccludeShader pdata) nWalls
+--    colorMask $= Color4 Enabled Enabled Enabled Enabled
+--    endTicks <- SDL.ticks
+--    return $ endTicks - startTicks

 divideSize :: Int -> Size -> Size
 divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
@@ -55,12 +55,12 @@ Determine where light is shining in the world.
 createLightMap 
    :: RenderData 
    -> Int                  -- Resolution division
-    -> [(Point2,Point2)]    -- Wall pairs
    -> [(Point3,Float,Float)]             -- Lights
    -> [Polyhedra]          -- foreground geometry
    -> [Point2]
+    -> Int -- ^ number of walls
    -> IO ()
-createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do
+createLightMap pdata resDiv lightPoints fpics scPol nWalls = do
    depthFunc $= Just Less
    -- get viewport size so we can reset it later
    (vppos,vpsize) <- get viewport
@@ -68,11 +68,6 @@ createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do
    let vsize = divideSize resDiv vpsize
    viewport $= (vppos, vsize)
    textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
-    -- store wall and light positions into buffer
--    nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) (map Render22 wallPoints)
--    bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
-    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
-    bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
    -- store foreground silhouette geometry into buffer
    nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) (concatMap polyToRender fpics)
    bindShaderBuffers [_lightingLineShadowShader pdata] [nSils]
@@ -152,7 +147,6 @@ createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do
            $= Vector3 x y z
        uniform (_shaderCustomUnis (_lightingWallShader pdata) !! 1)
            $= Vector2 r lum
-        --drawShader (_lightingWallShader pdata) nWallLights
        drawShader (_lightingWallShader pdata) nWalls
    cullFace $= Nothing
    stencilTest $= Disabled
@@ -3,6 +3,7 @@ module Shader.Compile
    , makeShaderUsingShaderVAO
    , makeSourcedShader
    , setupVAO
+    , setupVertexAttribPointer 
    ) where
 import Shader.Data
 import Shader.Parameters