Performance improvements, combine cap and geometry buffer

src/Dodge/Data.hs

@@ -32,6 +32,7 @@ import Sound.Data
 import qualified DoubleStack as DS
 import Dodge.GameRoom
 import Color
+import Shape
 
 import GHC.Generics
 import Control.Lens
@@ -74,6 +75,7 @@ data World = World
     , _sounds               :: M.Map SoundOrigin Sound
     , _playingSounds        :: M.Map SoundOrigin Sound
     , _decorations          :: IM.IntMap Picture
+    , _foregroundShape      :: Shape
     , _foregroundDecorations :: [Polyhedra]
     , _foregroundEdgeVerx   :: [Point3]
     , _corpses              :: Zone [Corpse]

src/Dodge/Default/World.hs

@@ -79,6 +79,7 @@ defaultWorld = World
     , _debugFlags = defaultDebugFlags
     , _inventoryMode = TopInventory
     , _lClickHammer = HammerUp
+    , _foregroundShape = mempty
     , _foregroundDecorations = []
     , _foregroundEdgeVerx = []
     , _radDistortion = []

src/Dodge/Layout.hs

@@ -24,6 +24,7 @@ import Picture.Data
 import Tile
 import Polyhedra
 import Polyhedra.Data
+import Shape
 
 import Control.Monad.State
 import Control.Lens
@@ -78,6 +79,11 @@ setupWorldBounds w = w
 
 setupForegroundEdgeVerxs :: World -> World
 setupForegroundEdgeVerxs w = w & foregroundEdgeVerx .~ polyhedrasToEdges (_foregroundDecorations w)
+    & foregroundShape .~ Shape vs es
+  where
+    vs = shVfromList $ concatMap (polyToTris . map toShape) $ concatMap _pyFaces $ _foregroundDecorations w
+    es = shEfromList $ polyhedrasToEdges (_foregroundDecorations w)
+    toShape (p3,p4) = ShapeV p3 p4
 
 polyhedrasToEdges :: [Polyhedra] -> [Point3]
 polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges

src/Dodge/Render.hs

@@ -59,17 +59,19 @@ doDrawing pdata w = do
     nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) 
         $  VS.fromList
         $ (shEList $ worldShape w)
-        ++ (_foregroundEdgeVerx w)
-    -- poke foreground geometry for caps
-    nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
-        $ VS.fromList
-        $ concatMap polyToGeoRender (foregroundPics w)
-            ++ (fmap _svPos (shVList $ worldShape w))
+--    -- poke foreground geometry for caps
+--    nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
+--        $ VS.fromList
+--            (fmap _svPos (shVList $ worldShape w))
+    numShapeVs <- pokeShapeVs (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) 
+        $ VS.fromList $ shVList $ worldShape w
+    let nCaps = numShapeVs
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
         [ ( _wallTextureShader pdata, nWalls)
         , (_lightingLineShadowShader pdata, nSils)
-        , (_lightingCapShader pdata, nCaps)
+--        , (_lightingCapShader pdata, nCaps)
+        , (_shapeShader pdata, numShapeVs)
         ]
     -- set the coordinate uniform ready for drawing elements using world coordinates
     bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
@@ -93,9 +95,6 @@ doDrawing pdata w = do
     pokeBindFoldableLayer shadV layerCounts $ worldPictures w
     renderLayer 0 shadV layerCounts
 
-    numShapeVs <- pokeShapeVs (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) 
-        $ VS.fromList $ shVList $ worldShape w
-    bindShaderBuffers [_shapeShader pdata] [numShapeVs]
     drawShader (_shapeShader pdata) numShapeVs
 
     --draw floor onto base buffer

src/Dodge/Render/Shape.hs

@@ -9,7 +9,8 @@ import Dodge.Base.Window
 
 import qualified Data.IntMap as IM
 worldShape :: World -> Shape
-worldShape w = mconcat (map (crShape w) (IM.elems $ IM.filter crIsClose (_creatures w)))
+worldShape w = _foregroundShape w 
+    <> mconcat (map (crShape w) (IM.elems $ IM.filter crIsClose (_creatures w)))
   where
     crIsClose cr = dist (_crPos cr) camCen < winSize
     winSize = 30 + max (getWindowX w) (getWindowY w)

src/Preload/Render.hs

@@ -66,6 +66,27 @@ preloadRender = do
     setupVertexAttribPointer 0 4 8 0
     setupVertexAttribPointer 1 4 8 4
     let winColVAO = VAO {_vao = winColVAOname, _vaoVBO = winVBO}
+    -- setup shape geometry/cap VBO and two VAOs
+    shVBOname <- genObjectName
+    shVBOptr  <- mallocArray (7 * numDrawableElements)
+    bindBuffer ArrayBuffer $= Just shVBOname
+    bufferData ArrayBuffer $=
+        ( fromIntegral $ floatSize * numDrawableElements * 7
+        , nullPtr
+        , DynamicDraw
+        )
+    let shVBO = VBO {_vbo = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4,4], _vboStride = 8}
+    shPosColVAOname <- genObjectName
+    bindVertexArrayObject $= Just shPosColVAOname
+    bindBuffer ArrayBuffer $= Just shVBOname
+    setupVertexAttribPointer 0 3 7 0
+    setupVertexAttribPointer 1 4 7 3
+    shPosVAOname <- genObjectName
+    bindVertexArrayObject $= Just shPosVAOname
+    bindBuffer ArrayBuffer $= Just shVBOname
+    setupVertexAttribPointer 0 3 7 0
+    let shPosColVAO = VAO { _vao = shPosColVAOname, _vaoVBO = shVBO }
+        shPosVAO    = VAO { _vao = shPosVAOname,    _vaoVBO = shVBO }
     -- lighting shaders
     wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] EPoints
                 >>= addUniforms ["lightPos"]
@@ -113,11 +134,6 @@ preloadRender = do
     framebuf2 <- setupTextureFramebuffer 800 600
     framebuf3 <- setupTextureFramebuffer 800 600
 
-    --rboLightingName <- genObjectName
-    --bindRenderbuffer Renderbuffer $= rboLightingName
-    --renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
-    --fboLightingName <- setupFramebufferGivenStencil rboLightingName
-
     rboBaseBloomName <- genObjectName
     bindRenderbuffer Renderbuffer $= rboBaseBloomName
     renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
@@ -152,8 +168,8 @@ preloadRender = do
 
     return $ RenderData
         { _pictureShaders = shadV
-        , _shapeShader = bslista
-        , _lightingCapShader        = lightingCapShad
+        , _shapeShader = bslista {_shadVAO = shPosColVAO }
+        , _lightingCapShader        = lightingCapShad { _shadVAO = shPosVAO }
         , _lightingLineShadowShader = lightingLineShadowShad
         , _lightingOccludeShader    = wsShad    {_shadVAO = wpVAO}
         , _wallBlankShader          = wlBlank   { _shadVAO = wpColVAO }

src/Shader/Poke.hs

@@ -1,5 +1,5 @@
 --{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE BangPatterns #-}
+--{-# LANGUAGE BangPatterns #-}
 module Shader.Poke
     ( pokeVerxs
     , pokeLayVerxs
@@ -21,7 +21,7 @@ import qualified Data.Vector.Unboxed.Mutable as UMV
 import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Control.Monad.Primitive
-import qualified Data.DList as DL
+--import qualified Data.DList as DL
 
 pokeVerxs 
     :: MV.MVector (PrimState IO) FullShader

src/Shape/Data.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Shape.Data
@@ -18,8 +19,10 @@ instance Semigroup Shape where
 instance Monoid Shape where
     mempty = Shape mempty mempty
 
+shVList :: Shape -> [ShapeV]
 {-# INLINE shVList #-}
 shVList = DL.toList . _shVertices
+shEList :: Shape -> [Point3]
 {-# INLINE shEList #-}
 shEList = DL.toList . _shEdges