Working shadows from foreground, not optimised

src/Render.hs

@@ -6,6 +6,7 @@ import Shader.Poke
 --import MatrixHelper
 import Data.Preload.Render
 import Picture.Data
+import Picture.Tree
 --import Geometry
 import Geometry.Data
 import Polyhedra.Data
@@ -70,7 +71,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
     nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 
-    -- store foreground geometry into buffer
+    -- store foreground silhouette geometry into buffer
     nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) (concatMap polyToRender fpics)
     bindShaderBuffers [_lightingLineShadowShader pdata] [nSils]
 
@@ -86,11 +87,11 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
     drawShader (_lightingOccludeShader pdata) nWalls
 
     cullFace $= Nothing
+
 ---- draw foreground elements to set z buffer
---    forM_ (_pictureShaders pdata) $ \shad -> do
---        currentProgram $= Just (_shaderProgram shad)
---        uniform (_shaderUniforms shad !! 4) $= pmat
---    _ <- renderFoldable pdata $ picToLTree (Just 0) fpics
+    --_ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic fpics)
+    currentProgram $= Just (_shaderProgram $ _lightingSurfaceShader pdata)
+    drawShader (_lightingSurfaceShader pdata) nWallLights
 
 -- for each of the lights: 
 -- stencil out the walls from this light's point of view
@@ -99,8 +100,10 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
     depthMask $= Disabled
     blendFunc $= (Zero, OneMinusSrcAlpha)
     stencilTest $= Enabled
+    --depthFunc $= Just Less
     forM_ lightPoints $ \((x,y,z),r,lum) -> do
 -- stencil out walls
+        depthFunc $= Just Less
         colorMask $= Color4 Disabled Disabled Disabled Disabled
         clear [StencilBuffer]
         cullFace $= Just Back
@@ -124,6 +127,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
 
         currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
         drawShader (_lightingLineShadowShader pdata) nSils
+        depthFunc $= Just Lequal
 -- draw floor light circles
         cullFace $= Nothing
         colorMask $= Color4 Disabled Disabled Disabled Enabled