Draw shape shadows using index buffer

src/Dodge/Creature/Picture.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 {- |
 Drawing of creatures. 
 Takes into account damage etc. -}
@@ -173,9 +174,22 @@ scalp cr
     | oneH   cr = rotateSH 0.5 $ translateSHf (0.25 * crad) 0 fhead
     | otherwise = translateSHf (0.25 * crad) 0 fhead
   where
-    fhead = colorSH (greyN 0.9) . upperPrismPoly 5 . polyCirc 3 $ crad * 0.5
+    --fhead = colorSH (greyN 0.9) . upperPrismPoly 5 . polyCirc 3 $ crad * 0.5
+    fhead = ([ShapeObj TopHexahedron $ map (flip ShapeV (greyN 0.9)) aBox] , mempty)
     crad = _crRad cr
 
+aBox :: [Point3]
+aBox =
+    [ V3 0 0 5
+    , V3 5 0 5
+    , V3 5 5 5
+    , V3 0 5 5
+    , V3 0 0 0
+    , V3 5 0 0
+    , V3 5 5 0
+    , V3 0 5 0
+    ]
+
 oneH :: Creature -> Bool
 oneH cr = crIsAiming' cr && crIt ^? itAimStance == Just OneHand
   where

src/Dodge/Layout.hs

@@ -79,7 +79,7 @@ setupWorldBounds w = w
 
 setupForegroundEdgeVerxs :: World -> World
 setupForegroundEdgeVerxs w = w & foregroundEdgeVerx .~ polyhedrasToEdges (_foregroundDecorations w)
-    & foregroundShape .~ (vs,es)
+    & foregroundShape .~ ([ShapeObj ListV vs],es)
   where
     vs = shVfromList $ map pairToSV $ concatMap polyToTris $ concatMap _pyFaces $ _foregroundDecorations w
     es = shEfromList $ polyhedrasToEdges (_foregroundDecorations w)

src/Dodge/Render.hs

@@ -57,10 +57,11 @@ doDrawing pdata w = do
     -- bind as much data into vbos as feasible at this point
     -- poke wall points and colors
     nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
-    (numShapeVs,nSils) <- pokeShape
+    (numShapeVs,nSils,nIndices,nSilIndices) <- pokeShape
         (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
         (shadVBOptr $ _lightingLineShadowShader pdata) 
         (_eboPtr $ _shapeEBO pdata)
+        (_eboPtr $ _silhouetteEBO pdata)
         $ worldShape w
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
@@ -68,6 +69,20 @@ doDrawing pdata w = do
         , (_lightingLineShadowShader pdata, nSils)
         , (_shapeShader pdata, numShapeVs)
         ]
+    bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata)
+    bufferSubData
+        ElementArrayBuffer
+        WriteToBuffer
+        0
+        (fromIntegral $ glushortSize * nIndices)
+        (_eboPtr $ _shapeEBO pdata)
+    bindBuffer ElementArrayBuffer $= Just (_ebo $ _silhouetteEBO pdata)
+    bufferSubData
+        ElementArrayBuffer
+        WriteToBuffer
+        0
+        (fromIntegral $ glushortSize * nIndices)
+        (_eboPtr $ _silhouetteEBO pdata)
     -- set the coordinate uniform ready for drawing elements using world coordinates
     bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
     setViewportSize (round winx `div` resFact) (round winy `div` resFact)
@@ -90,20 +105,12 @@ doDrawing pdata w = do
     pokeBindFoldableLayer shadV layerCounts $ worldPictures w
     renderLayer 0 shadV layerCounts
 
---    drawShader (_shapeShader pdata) numShapeVs
     let fs = _shapeShader pdata
     currentProgram $= Just (_shadProg fs)
     bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
-    bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata)
-    bufferSubData
-        ElementArrayBuffer
-        WriteToBuffer
-        0
-        (fromIntegral $ glushortSize * numShapeVs)
-        (_eboPtr $ _shapeEBO pdata)
     glDrawElements
         (marshalEPrimitiveMode $ _shadPrim fs) 
-        (fromIntegral numShapeVs)
+        (fromIntegral nIndices)
         (GL_UNSIGNED_SHORT)
         nullPtr
 
@@ -113,8 +120,8 @@ doDrawing pdata w = do
     drawShader (_textureArrayShader pdata) nTextArrayVs
     --draw lightmap for base buffer
     bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
-    --createLightMap pdata lightPoints nWalls nSils numShapeVs (snd $ snd $ _fboBase pdata)
-    createLightMap pdata lightPoints nWalls 0 0 (snd $ snd $ _fboBase pdata)
+    createLightMap pdata lightPoints nWalls nSils numShapeVs (snd $ snd $ _fboBase pdata)
+    --createLightMap pdata lightPoints nWalls 0 0 (snd $ snd $ _fboBase pdata)
     colorMask $= Color4 Enabled Enabled Enabled Enabled
     clearColor $= Color4 0 0 0 0
     --apply lightmap to base buffer