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)