Correct projected wall shadows when there is an offset camera

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 
-          sstls = ss . _tlsPos 
+          ssls = _lsPos 
+          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