From 5c23e0a348fe5c8011e32922afe33f5a58b80b57 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Mon, 22 Mar 2021 00:46:54 +0100
Subject: [PATCH] Stop bullets drawing over extended top of walls

---
 src/Dodge/Base.hs      |  3 ---
 src/Dodge/Rendering.hs | 12 ++++++------
 src/Loop.hs            |  7 -------
 3 files changed, 6 insertions(+), 16 deletions(-)

diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs
index 75f18a58f..b9de94f81 100644
--- a/src/Dodge/Base.hs
+++ b/src/Dodge/Base.hs
@@ -724,9 +724,6 @@ crInPolygon cr xs = errorPointInPolygon 3 (_crPos cr) xs
 onLayer :: Layer -> Picture -> Picture
 onLayer l = setDepth $ 1 - fromIntegral (levLayer l) / 100
 
---onLayer :: Layer -> Picture -> [(Picture, [Int])]
---onLayer l p = [(p, [levLayer l])]
-
 onLayerL :: [Int] -> Picture -> Picture
 onLayerL is = setDepth (1 - (sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..]))
 
diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs
index b9b36ea25..6ef26d65c 100644
--- a/src/Dodge/Rendering.hs
+++ b/src/Dodge/Rendering.hs
@@ -67,11 +67,11 @@ worldPictures w
                         , ptPicts'
                         , afterPtPicts'
                         , wlPicts
+                        , map (color $ withAlpha 0 black) wlPicts'
                         , smokeShadows
                         , ppLabels
                         , btLabels
                         , testPic w
-                        , wallsToSetDepth
                         ]
     where
           decPicts      = IM.elems $ _decorations w
@@ -83,8 +83,8 @@ worldPictures w
           crPicts       = map crDraw $ IM.elems $ _creatures w
           clPicts       = map clDraw $ IM.elems $ _clouds w
           smokeShadows  = map (drawSmokeShadow w) $ _smoke w
+          wlPicts'      = map (drawWallFace w) (wallShadowsToDraw w)
           wlPicts       = map drawWallFloor (wallFloorsToDraw w)
-          wallsToSetDepth = map (drawWallFace w) (wallShadowsToDraw w)
           itFloorPicts  = map drawItem (IM.elems (_floorItems w))
           yourPos = _crPos $ you w
           yourRot = _crDir $ you w
@@ -241,7 +241,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
         
 drawWallFloor :: Wall -> Picture
 drawWallFloor wl = if _wlIsSeeThrough wl
-                   then onLayerL [0] $ color c $ polygon [x,x +.+ n2,y+.+n2, y]
+                   then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y]
                    else blank
     where 
         (x:y:_) = _wlLine wl
@@ -300,7 +300,7 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
 drawWallFace :: World -> Wall -> Picture
 drawWallFace w wall
     | isRHS sightFrom x y || _wlIsSeeThrough wall = blank
-    | otherwise = setLayer 3 . setDepth (-1) . polygon $ points
+    | otherwise = setDepth (-0.1) . polygon $ points
     where 
         (x:y:_) = _wlLine wall 
         points = extendConeToScreenEdge w sightFrom (x,y)
@@ -311,7 +311,7 @@ drawWallFace w wall
 -- it is not obvious which will be returned
 intersectLinefromScreen :: World -> Point2 -> Point2 -> Maybe Point2
 intersectLinefromScreen w a b = listToMaybe 
-        . mapMaybe (\(x,y) -> intersectSegLineext x y a b)
+        . mapMaybe (\(x,y) -> intersectSegLineFrom' x y b (b +.+ b -.- a))
         . makeLoopPairs 
         $ screenPolygon w
 
@@ -319,7 +319,7 @@ extendConeToScreenEdge :: World -> Point2 -> (Point2,Point2) -> [Point2]
 extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
     where borderPs = mapMaybe (intersectLinefromScreen w c) [x,y]
           cornerPs = filter (pointIsInCone c (x,y)) $ screenPolygon w
-          wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg' x y) 
+          wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg' y ((2*.*y) -.- x)) 
                                     . makeLoopPairs $ screenPolygon w
 
 displayInv :: Int -> World -> Picture
diff --git a/src/Loop.hs b/src/Loop.hs
index ce1d724a9..5e747b77b 100644
--- a/src/Loop.hs
+++ b/src/Loop.hs
@@ -85,17 +85,10 @@ doLoop setup window startWorld
     newParams <- worldSideEffects (setup & currentTime .~ startLoopTicks) startWorld
     glSwapWindow window
     endSideTicks <- ticks
-    --worldSideEffects setup updatedWorld
     events <- pollEvents
-    --let-- maybeUpdatedWorld :: Maybe (WorldView world0)
-    --    maybeUpdatedWorld = applyEvents eventFn startWorld events worldUpdate
     maybeUpdatedWorld <- applyEventsIO eventFn startWorld events
     case maybeUpdatedWorld >>= worldUpdate of
         Just updatedWorld -> do 
-            --GL.clear [GL.ColorBuffer,GL.DepthBuffer]
-            --worldSideEffects setup updatedWorld
-            --glSwapWindow window
-            --GL.flush
             endSimTicks <- ticks
             performGC
             endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic)