Correct projected wall shadows when there is an offset camera

app/Main.hs

@@ -59,6 +59,7 @@ main = do
                                             (_windowX w,_windowY w) 
                                             (wallsForGloom w)
                                             (lightsForGloom' w)
+                                            (_cameraCenter w)
                                             (worldPictures w)
                       blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
                       renderFoldable (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w)

shader/lightmapCircle.geom

@@ -16,13 +16,13 @@ void main()
 
   cenPosT = vec2 ( (cenPos.x + 1) * 0.5 * winSize.x , (cenPos.y + 1) * 0.5 * winSize.y);
 
-  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, 0.9 , 1);
+  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, -0.9 , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, 0.9 , 1);
+  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, -0.9 , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, 0.9 , 1);
+  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, -0.9 , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, 0.9 , 1);
+  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, -0.9 , 1);
   EmitVertex();
 
   EndPrimitive();

shader/wallShadow.geom

@@ -3,10 +3,13 @@ layout (points) in;
 layout (triangle_strip, max_vertices = 12) out;
 
 uniform vec2 lightPos;
+uniform mat4 perpMat;
 uniform mat4 worldMat;
 
+vec2 lightPosa = lightPos;
+
 vec4 shift (vec4 p)
-{ return vec4 (p.xy + (200 * (p.xy-lightPos)), 0 , 1);
+{ return vec4 (p.xy + (200 * (p.xy-lightPosa)), 0 , 1);
 }
 float isLHS (vec2 startV, vec2 testV)
 {
@@ -16,7 +19,7 @@ void emitLine (vec2 pa)
 {
     gl_Position = vec4 (pa, 0, 1);
     EmitVertex();
-    gl_Position = shift (vec4 (pa,0,1)); //vec4 (pa + (200 * (pa - lightPos)), 0 , 1);
+    gl_Position = shift (vec4 (pa,0,1)); //vec4 (pa + (200 * (pa - lightPosa)), 0 , 1);
     EmitVertex();
 }
 
@@ -30,9 +33,9 @@ mat4 perspective =
 
 void main()
 {
-vec4 p1 = worldMat * vec4 (gl_in[0].gl_Position.xy,0,1);
+vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0,1);
-vec4 p2 = worldMat * vec4 (gl_in[0].gl_Position.zw,0,1);
+vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0,1);
-if (isLHS (p1.xy - lightPos, p2.xy - lightPos) < 0)
+if (isLHS (p1.xy - lightPosa, p2.xy - lightPosa) < 0)
 {
 vec4 p3 = vec4 (p1.xy,-0.5,1);
 vec4 p4 = vec4 (p2.xy,-0.5,1);
@@ -40,18 +43,18 @@ 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 = perpMat * p4; EmitVertex();
-  gl_Position = perspective * p3; EmitVertex();
+  gl_Position = perpMat * p3; EmitVertex();
-  gl_Position = perspective * p7; EmitVertex();
+  gl_Position = perpMat * p7; EmitVertex();
-  gl_Position = perspective * p8; EmitVertex();
+  gl_Position = perpMat * p8; EmitVertex();
-  gl_Position = perspective * p5; EmitVertex();
+  gl_Position = perpMat * p5; EmitVertex();
-  gl_Position = perspective * p3; EmitVertex();
+  gl_Position = perpMat * p3; EmitVertex();
-  gl_Position = perspective * p1; EmitVertex();
+  gl_Position = perpMat * p1; EmitVertex();
-  gl_Position = perspective * p4; EmitVertex();
+  gl_Position = perpMat * p4; EmitVertex();
-  gl_Position = perspective * p2; EmitVertex();
+  gl_Position = perpMat * p2; EmitVertex();
-  gl_Position = perspective * p7; EmitVertex();
+  gl_Position = perpMat * p7; EmitVertex();
-  gl_Position = perspective * p6; EmitVertex();
+  gl_Position = perpMat * p6; EmitVertex();
-  gl_Position = perspective * p5; EmitVertex();
+  gl_Position = perpMat * p5; EmitVertex();
   EndPrimitive();
 } else {}
 }

src/Dodge/Rendering.hs

@@ -69,7 +69,7 @@ worldPictures w
                         , ptPicts 
                         , ptPicts'
                         , afterPtPicts'
-                        , wlPicts
+                        , wlPicts'
 --                        , wallShadows
                         , smokeShadows
 --                        , itLabels
@@ -89,6 +89,7 @@ worldPictures w
           wallShadows   = map (drawWallShadow w) $ wallShadowsToDraw w
           smokeShadows  = map (drawSmokeShadow w) $ _smoke w
           wlPicts       = map drawWall (wallsToDraw w)
+          wlPicts'      = map (drawWall' w) (wallsToDraw w)
           itFloorPicts  = map (drawItem) (IM.elems (_floorItems w))
           yourPos = _crPos $ you w
           yourRot = _crDir $ you w
@@ -243,7 +244,6 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
         trap' p' = line [pa' p', pb' p', pbo' p', pao' p',pa' p']
         semiCirc' p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r'
         
-
 drawWall :: Wall -> Drawing
 drawWall (Wall {_wlIsSeeThrough = False, _wlLine = ps, _wlColor = c}) 
         = onLayerL [levLayer WlLayer, 2] $ color c $ polygon $ ps
@@ -311,6 +311,33 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
     where sp = screenPolygon w
           sps = zip sp (tail sp ++ [head sp])
 
+drawWall' :: World -> Wall -> Drawing
+drawWall' w wall
+    | isRHS sightFrom x y = blank
+    | otherwise = colorAndLayer $ polygon $ points
+    where 
+        colorAndLayer | _wlIsSeeThrough wall = setLayer 2
+                                                . onLayerL [levLayer ShadowLayer] 
+                                                . color (withAlpha 0.2 $ _wlColor wall)
+                      | otherwise = setLayer 2 
+                                        . onLayerL [levLayer ShadowLayer,2]
+                                        . color (_wlColor wall)
+        (x:y:_) = _wlLine wall 
+        ps = linePointsBetween x y
+        ds = map (\p -> safeNormalizeV (p -.- sightFrom)) ps
+        p's = zipWith (\d x -> (15 *.* d) +.+ x) ds ps
+        sightFrom = _cameraCenter w
+        corns = screenPolygon w
+        borders = filter g $ zip corns (tail corns ++ [head corns])
+        g (a,b) = isLHS a b sightFrom
+        borderps = mapMaybe f borders ++ mapMaybe f' borders ++ shadowedCorners
+        coneTop = nub $ concatMap (\(a,b) -> [a,b]) $ borders
+        shadowedCorners = filter isShadowed coneTop
+        isShadowed p = isLHS sightFrom x p && isRHS sightFrom y p
+        f (bpa,bpb) = intersectSegLineFrom' bpa bpb x (head p's)
+        f' (bpa,bpb) = intersectSegLineFrom' bpa bpb y (last p's)
+        points = orderPolygon (borderps ++ ps)
+        --points = orderPolygon (borderps ++ p's)
 
 drawWallShadow :: World -> Wall -> Drawing
 drawWallShadow w wall
@@ -483,13 +510,8 @@ lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempL
           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'
-          ssls = ss . _lsPos 
+          ssls = _lsPos 
-          sstls = ss . _tlsPos 
+          sstls = _tlsPos 
+--          ssls = ss . _lsPos 
+--          sstls = ss . _tlsPos 
           zoom = _cameraZoom w
-
---lightsForGloom :: World -> [(Point2,Float,Float)]
---lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
---    where getLS ls = (screenShift $ _lsPos ls, _lsRad ls * zoom, _lsIntensity ls)
---          getTLS ls = (screenShift $ _tlsPos ls, _tlsRad ls * zoom, _tlsIntensity ls)
---          screenShift x = zoom *.* rotateV (0 - _cameraRot w) (x -.- _cameraPos w)
---          zoom = _cameraZoom w

src/Picture/Preload.hs

@@ -46,7 +46,7 @@ preloadRender = do
                                 "data/texture/smudgedDirt.png"
 
     wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4)] Points pokeWPStrat
-                ["lightPos"]
+                ["lightPos","perpMat"]
 
     wlLightShad <- makeShaderCustomUnis "wallLight" [vert,frag] [(0,3)] TriangleStrip pokeLightWallStrat
                     ["lightPosRadLum"]

src/Picture/Render.hs

@@ -8,6 +8,7 @@ module Picture.Render
     where
 
 import Shader
+import MatrixHelper
 
 import Control.Lens
 import Control.Monad
@@ -31,8 +32,10 @@ import qualified Data.IntMap.Strict as IM
 import qualified SDL as SDL
 
 renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
+                    [(Point2,Point2)] -> [Point4] ->
-renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
+                    (Float,Float) -> Picture -> IO (Word32,Word32)
+renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
+                    (viewFromx,viewFromy) pic = do
     wallPokeStart <- SDL.ticks
 
 -- setting the depth function to less, instead of lequal, 
@@ -61,18 +64,25 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
     nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
     bindShaderBuffers [_wallShadowShader pdata] [nWalls]
 
+    let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
+
     currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
     uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
-            $= Vector2 (0::Float) 0  -- hopefully this draws as if from the center
+            $= Vector2 viewFromx viewFromy  -- hopefully this draws as if from the center
-                                     -- it does, but this is not good for when
+                                     -- it does, but this is not correct when
                                      -- the camera center is not the player position
+    pmat <- (newMatrix RowMajor 
+                $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
+            ) :: IO (GLmatrix GLfloat)
+    uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 1)
+            $= pmat
     drawShader (_wallShadowShader pdata) nWalls
 
     depthMask $= Disabled
     blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
     stencilTest $= Enabled
     forM_ lightPoints $ \(x,y,r,lum) -> do
-        depthFunc $= Just Less
+--        depthFunc $= Just Less
         clear [StencilBuffer]
         cullFace $= Just Back
 --        stencilOp $= (OpKeep,OpKeep,OpReplace)
@@ -93,11 +103,13 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
         
         let lightPtr = (\(_,ptr,_) -> ptr) $ head 
                             $ _vaoBufferTargets $ _shaderVAO $ _lightSourceShader pdata
-        pokeFourOff lightPtr 0 (x,y,r,lum)
+            (x',y') = zTran $ rotateV (0 - rot) $ (x,y) -.- (tranx,trany)
+            zTran (a,b) = (a*2*zoom / winx, b*2*zoom / winy)
+        pokeFourOff lightPtr 0 (x',y',r,lum)
         bindShaderBuffers [_lightSourceShader pdata] [1]
         
         stencilFunc $= (Equal, 0, 255)
-        depthFunc $= Just Always
+--        depthFunc $= Just Always
         drawShader (_lightSourceShader pdata) 1
         
 --        currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
@@ -228,6 +240,9 @@ renderFoldable pdata rot zoom (tranx,trany) (winx,winy) tree = do
     pokeEndTicks <- SDL.ticks
     return $ pokeEndTicks - pokeStartTicks
 
+------------------------------end renderFoldable
+
+
 pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
 {-# INLINE pokeTwoOff #-}
 pokeTwoOff ptr n (x,y) = do