Project wall shadows onto other walls

src/Picture/Preload.hs

@@ -22,7 +22,7 @@ import qualified Control.Foldl as F
 
 data RenderData = RenderData
     { _lightSourceShader :: FullShader (Float,Float,Float,Float)
-    , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
+    , _wallShadowShader  :: FullShader (Point2,Point2)
     , _wallLightShader  :: FullShader (Point3)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader  :: FullShader ()
@@ -171,8 +171,8 @@ vert = VertexShader
 geom = GeometryShader
 frag = FragmentShader
 
-pokeWPStrat :: (Point2,Point2,Point2,Point2) -> [[[Float]]]
-pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w]]]
+pokeWPStrat :: (Point2,Point2) -> [[[Float]]]
+pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]]
 
 pokeLightWallStrat :: Point3 -> [[[Float]]]
 pokeLightWallStrat (x,y,z) = [[[x,y,z]]]

src/Picture/Render.hs

@@ -31,7 +31,7 @@ import qualified Data.IntMap.Strict as IM
 import qualified SDL as SDL
 
 renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
+                    [(Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
 renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
     wallPokeStart <- SDL.ticks
 
@@ -53,36 +53,40 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
 -- draw lightmap
 
     bindFramebuffer Framebuffer $= (_spareFBO pdata)
-    depthFunc $= Just Always
     clearColor $= Color4 0 0.5 0 1
-    clearDepth $= (200)
-    clear [ColorBuffer]
---    depthMask $= Enabled
+    depthFunc $= Just Less
+    clearDepth $= 1
+    clear [ColorBuffer,DepthBuffer]
 
---    nBoxWalls <- F.foldM (pokeShader (_wallShader pdata)) $ concat $ mkShadFromWall <$> wallPoints <*> lightPoints
     nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
     bindShaderBuffers [_wallShadowShader pdata] [nWalls]
 
---    let f (x,y) = (x,y,0)
---        h (x,y) = (x,y,-1)
---        g (a,b,_,_) = [f a,f a,h a,f b,h b,h b]
---        wp = concatMap g wallPoints
---    nLightWalls <- F.foldM (pokeShader (_wallLightShader pdata)) wp
---    bindShaderBuffers [_wallLightShader pdata] [nLightWalls]
+    currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
+    uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
+            $= Vector2 (0::Float) 0  -- hopefully this draws as if from the center
+                                     -- it does, but this is not good for when
+                                     -- the camera center is not the player position
+    drawShader (_wallShadowShader pdata) nWalls
 
+    depthMask $= Disabled
+    blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
     stencilTest $= Enabled
     forM_ lightPoints $ \(x,y,r,lum) -> do
-        cullFace $= Just Front
-        clear [DepthBuffer,StencilBuffer]
-
-        stencilOp $= (OpKeep,OpKeep,OpReplace)
-
-        stencilFunc $= (Always, 1, 255)
+        depthFunc $= Just Less
+        clear [StencilBuffer]
+        cullFace $= Just Back
+--        stencilOp $= (OpKeep,OpKeep,OpReplace)
+        stencilOp $= (OpKeep,OpKeep,OpIncr)
+        stencilFunc $= (Always, 0, 255)
 -- currentProgram does get called twice: here and inside drawShader below
         currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
         uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
             $= Vector2 (x) (y)
-        blendFunc $= (Zero,One)
+--        blendFunc $= (Zero,One)
+        drawShader (_wallShadowShader pdata) nWalls
+
+        cullFace $= Just Front
+        stencilOp $= (OpKeep,OpKeep,OpDecr)
         drawShader (_wallShadowShader pdata) nWalls
 
         cullFace $= Nothing
@@ -92,8 +96,8 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
         pokeFourOff lightPtr 0 (x,y,r,lum)
         bindShaderBuffers [_lightSourceShader pdata] [1]
         
-        blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
-        stencilFunc $= (Notequal, 1, 255)
+        stencilFunc $= (Equal, 0, 255)
+        depthFunc $= Just Always
         drawShader (_lightSourceShader pdata) 1
         
 --        currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
@@ -103,6 +107,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
 --        depthFunc $= Just Lequal
 --        drawShader (_wallLightShader pdata) nLightWalls
 
+    depthMask $= Enabled
     cullFace $= Nothing
     stencilTest $= Disabled