Project wall shadows onto other walls

shader/wallShadow.geom

@@ -1,26 +1,81 @@
 #version 430 core
 layout (points) in;
-layout (triangle_strip, max_vertices = 4) out;
+layout (triangle_strip, max_vertices = 12) out;
 
 uniform vec2 lightPos;
 uniform mat4 worldMat;
 
+vec4 shift (vec4 p)
+{ return vec4 (p.xy + (200 * (p.xy-lightPos)), 0 , 1);
+}
+float isLHS (vec2 startV, vec2 testV)
+{
+    return sign( -startV.x * testV.y + startV.y * testV.x);
+}
 void emitLine (vec2 pa)
 {
     gl_Position = vec4 (pa, 0, 1);
     EmitVertex();
-    gl_Position = vec4 (pa + (200 * (pa - lightPos)), 0 , 1);
+    gl_Position = shift (vec4 (pa,0,1)); //vec4 (pa + (200 * (pa - lightPos)), 0 , 1);
     EmitVertex();
 }
 
+mat4 perspective =  
+    mat4 (1,0,0,0
+         ,0,1,0,0
+         ,0,0,1,1
+         ,0,0,0,1
+         ) ;
+// construct a box with opening on bottom face
+
 void main()
 {
-  vec4 frontL4 = worldMat * vec4(gl_in[0].gl_Position.xy, 0 ,1);
+vec4 p1 = worldMat * vec4 (gl_in[0].gl_Position.xy,0,1);
-  vec4 frontR4 = worldMat * vec4(gl_in[0].gl_Position.zw, 0 ,1);
+vec4 p2 = worldMat * vec4 (gl_in[0].gl_Position.zw,0,1);
-  vec2 frontL = frontL4.xy;
+if (isLHS (p1.xy - lightPos, p2.xy - lightPos) < 0)
-  vec2 frontR = frontR4.xy;
+{
-
+vec4 p3 = vec4 (p1.xy,-0.5,1);
-    emitLine (frontR);
+vec4 p4 = vec4 (p2.xy,-0.5,1);
-    emitLine (frontL);
+vec4 p5 = shift(p1);
+vec4 p6 = shift(p2);
+vec4 p7 = vec4 (p6.xy,-0.5,1);
+vec4 p8 = vec4 (p5.xy,-0.5,1);
+  gl_Position = perspective * p4; EmitVertex();
+  gl_Position = perspective * p3; EmitVertex();
+  gl_Position = perspective * p7; EmitVertex();
+  gl_Position = perspective * p8; EmitVertex();
+  gl_Position = perspective * p5; EmitVertex();
+  gl_Position = perspective * p3; EmitVertex();
+  gl_Position = perspective * p1; EmitVertex();
+  gl_Position = perspective * p4; EmitVertex();
+  gl_Position = perspective * p2; EmitVertex();
+  gl_Position = perspective * p7; EmitVertex();
+  gl_Position = perspective * p6; EmitVertex();
+  gl_Position = perspective * p5; EmitVertex();
   EndPrimitive();
+} else {}
 }
+
+//  //  void main()
+//  //  {
+//  //    vec4 frontL4 = worldMat * vec4(gl_in[0].gl_Position.xy, 0 ,1);
+//  //    vec4 frontR4 = worldMat * vec4(gl_in[0].gl_Position.zw, 0 ,1);
+//  //    vec2 frontL = frontL4.xy;
+//  //    vec2 frontR = frontR4.xy;
+//  //  
+//  //      emitLine (frontR);
+//  //      emitLine (frontL);
+//  //    EndPrimitive();
+//  //  }
+//  gl_Position = perspective * worldMat * p4; EmitVertex();
+//  gl_Position = perspective * worldMat * p3; EmitVertex();
+//  gl_Position = perspective * worldMat * p7; EmitVertex();
+//  gl_Position = perspective * worldMat * p8; EmitVertex();
+//  gl_Position = perspective * worldMat * p5; EmitVertex();
+//  gl_Position = perspective * worldMat * p3; EmitVertex();
+//  gl_Position = perspective * worldMat * p1; EmitVertex();
+//  gl_Position = perspective * worldMat * p4; EmitVertex();
+//  gl_Position = perspective * worldMat * p2; EmitVertex();
+//  gl_Position = perspective * worldMat * p7; EmitVertex();
+//  gl_Position = perspective * worldMat * p6; EmitVertex();
+//  gl_Position = perspective * worldMat * p5; EmitVertex();

src/Dodge/Rendering.hs

@@ -467,43 +467,14 @@ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
                     scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show
                     $ _crHP $ _creatures w IM.! n
 
-wallsForGloom :: World -> [(Point2,Point2,Point2,Point2)]
+wallsForGloom :: World -> [(Point2,Point2)]
 wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough)
                         $ filter wallCastsShadow
                         $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
-    where linePairs (x:y:z:w:_) = (x,y,z,w)
+    where linePairs (x:y:_) = (x,y)
-          linePairs (x:y:_) = (x,y,x,y)
           wallCastsShadow wl = case wl ^? wlCastShadow of
                                 Just b  -> b
                                 Nothing -> True
---(AutoDoor {_wlCastShadow = b}) = b
---          wallCastsShadow _ = True
-
-wallsForGloom' :: World -> [(Point2,Point2)]
-wallsForGloom' w = map (wallPairBack . _wlLine) $ filter (not . _wlIsSeeThrough) 
-                                $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
-
-   -- where wallPairBack (x:y:_) = (ss $ x +.+ n,ss $ y+.+ n)
-    where wallPairBack (x:y:_) = (x +.+ n,y+.+ n)
-            where n = 15 *.* (normalizeV $ vNormal $ y -.- x)
-      --    ss' v = rotateV (0 - _cameraRot w) (v -.- _cameraPos w)
-      --    ss'' (a,b) = (a*2*zoom / _windowX w,b*2*zoom / _windowY w)
-      --    ss = ss'' . ss'
--- the ss transformation would possibly be better done using a matrix in the
--- shader
-          zoom = _cameraZoom w
---wallsForGloom' :: World -> [(Point2,Point2,Point2,Point2)]
---wallsForGloom' w = map (wallPairToFour . _wlLine) $ filter (not . _wlIsSeeThrough) 
---                                $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
---
---    where wallPairToFour (x:y:_) = (ss x,ss y,ss $ x +.+ n,ss $ y+.+ n)
---            where n = 15 *.* (normalizeV $ vNormal $ y -.- x)
---          ss' v = rotateV (0 - _cameraRot w) (v -.- _cameraPos w)
---          ss'' (a,b) = (a*2*zoom / _windowX w,b*2*zoom / _windowY w)
---          ss = ss'' . ss'
----- the ss transformation would possibly be better done using a matrix in the
----- shader
---          zoom = _cameraZoom w
 
 lightsForGloom' :: World -> [(Point4)]
 lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
@@ -516,9 +487,9 @@ lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempL
           sstls = ss . _tlsPos 
           zoom = _cameraZoom w
 
-lightsForGloom :: World -> [(Point2,Float,Float)]
+--lightsForGloom :: World -> [(Point2,Float,Float)]
-lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
+--lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
-    where getLS ls = (screenShift $ _lsPos ls, _lsRad ls * zoom, _lsIntensity ls)
+--    where getLS ls = (screenShift $ _lsPos ls, _lsRad ls * zoom, _lsIntensity ls)
-          getTLS ls = (screenShift $ _tlsPos ls, _tlsRad ls * zoom, _tlsIntensity ls)
+--          getTLS ls = (screenShift $ _tlsPos ls, _tlsRad ls * zoom, _tlsIntensity ls)
-          screenShift x = zoom *.* rotateV (0 - _cameraRot w) (x -.- _cameraPos w)
+--          screenShift x = zoom *.* rotateV (0 - _cameraRot w) (x -.- _cameraPos w)
-          zoom = _cameraZoom w
+--          zoom = _cameraZoom w

src/Dodge/Rooms.hs

@@ -548,7 +548,7 @@ deadEndRoom = Room
                  ]
     , _rmLinks = lnks
     , _rmPath  = []
-    , _rmPS    = [PS (0,-20) 0 basicLS]
+    , _rmPS    = [PS (0,-10) 0 basicLS]
     , _rmBound = rectNSWE 20 (-20) (-30) 30
     }
     where lnks = [((0,30)  ,0)

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 :: (Point2,Point2) -> [[[Float]]]
-pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w]]]
+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)
+    depthFunc $= Just Less
-    clear [ColorBuffer]
+    clearDepth $= 1
---    depthMask $= Enabled
+    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)
+    currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
---        h (x,y) = (x,y,-1)
+    uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
---        g (a,b,_,_) = [f a,f a,h a,f b,h b,h b]
+            $= Vector2 (0::Float) 0  -- hopefully this draws as if from the center
---        wp = concatMap g wallPoints
+                                     -- it does, but this is not good for when
---    nLightWalls <- F.foldM (pokeShader (_wallLightShader pdata)) wp
+                                     -- the camera center is not the player position
---    bindShaderBuffers [_wallLightShader pdata] [nLightWalls]
+    drawShader (_wallShadowShader pdata) nWalls
 
+    depthMask $= Disabled
+    blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
     stencilTest $= Enabled
     forM_ lightPoints $ \(x,y,r,lum) -> do
-        cullFace $= Just Front
+        depthFunc $= Just Less
-        clear [DepthBuffer,StencilBuffer]
+        clear [StencilBuffer]
-
+        cullFace $= Just Back
-        stencilOp $= (OpKeep,OpKeep,OpReplace)
+--        stencilOp $= (OpKeep,OpKeep,OpReplace)
-
+        stencilOp $= (OpKeep,OpKeep,OpIncr)
-        stencilFunc $= (Always, 1, 255)
+        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 $= (Equal, 0, 255)
-        stencilFunc $= (Notequal, 1, 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