Towards working shadows

src/Dodge/Render.hs

@@ -56,16 +56,15 @@ 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,nIndices,nSilIndices) <- pokeShape
+    (nShapeVs,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
         [ ( _wallTextureShader pdata, nWalls)
-        , (_shapeShader pdata, numShapeVs)
+        , (_shapeShader pdata, nShapeVs)
         ]
     bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata)
     bufferSubData
@@ -116,7 +115,7 @@ doDrawing pdata w = do
     drawShader (_textureArrayShader pdata) nTextArrayVs
     --draw lightmap for base buffer
     bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
-    createLightMap pdata lightPoints nWalls nSilIndices numShapeVs (snd $ snd $ _fboBase pdata)
+    createLightMap pdata lightPoints nWalls nSilIndices nIndices (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
@@ -171,7 +170,7 @@ doDrawing pdata w = do
         depthMask $= Disabled
         blend $= Enabled
         bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
-        createLightMap pdata lightPoints nWalls nSilIndices numShapeVs (snd $ snd $ _fboCloud pdata)
+        createLightMap pdata lightPoints nWalls nSilIndices nIndices (snd $ snd $ _fboCloud pdata)
         colorMask $= Color4 Enabled Enabled Enabled Enabled
         clearColor $= Color4 0 0 0 0
     --apply lightmap to cloud buffer

src/Shader/Poke.hs

@@ -22,7 +22,6 @@ import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Control.Monad.Primitive
 import Control.Monad
-import Data.Bifoldable
 --import qualified Data.DList as DL
 
 pokeVerxs 
@@ -91,11 +90,13 @@ pokeTopPrismIndex nv iptr ni ioff = do
 topPrismEdgeIndices :: Int -> [Int]
 topPrismEdgeIndices n = concatMap f [0..n-1]
   where
-    f i = 
-        [ i, (i+2) `mod` n, i+1, (i+4) `mod` n
-        , i, i+1, (i+4) `mod` n, (i+3) `mod` n
-        , i+1, (i+5) `mod` n, i, (i+3) `mod` n
+    f i = map g
+        [ 0 , 2 , 1 , 4
+        , 0 , 1 ,-2 , 3
+        , 1 , 3 ,-1 , 2
         ]
+      where
+        g j = (2 * i + j) `mod` n
 
 topPrismIndices :: Int -> [Int]
 topPrismIndices n = concatMap f [1..n-2]    -- triangles on top face