From f19f879945941bc6868548d538a4a0b8b03c4648 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Mon, 22 Mar 2021 00:05:24 +0100
Subject: [PATCH] Fix wall depth rendering

---
 src/Dodge/Base.hs      |  4 ++--
 src/Dodge/Rendering.hs |  6 +++---
 src/Picture.hs         |  2 +-
 src/Picture/Render.hs  | 10 ++--------
 4 files changed, 8 insertions(+), 14 deletions(-)

diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs
index 900188f08..75f18a58f 100644
--- a/src/Dodge/Base.hs
+++ b/src/Dodge/Base.hs
@@ -722,13 +722,13 @@ crInPolygon :: Creature -> [Point2] -> Bool
 crInPolygon cr xs = errorPointInPolygon 3 (_crPos cr) xs
 
 onLayer :: Layer -> Picture -> Picture
-onLayer l = setDepth (fromIntegral (levLayer l) / 100)
+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 ((sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..]))
+onLayerL is = setDepth (1 - (sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..]))
 
 levLayer :: Layer -> Int
 levLayer BgLayer            = 20
diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs
index f8e2f8f22..b9b36ea25 100644
--- a/src/Dodge/Rendering.hs
+++ b/src/Dodge/Rendering.hs
@@ -29,9 +29,9 @@ fixedCoordPictures :: World -> Picture
 fixedCoordPictures w = pictures
              [ scaler $ hudDrawings w
              , scaler $ onLayer MenuLayer menuScreen
-             , setDepth 1 $ closeObjectTexts w
+             , setDepth (-1) $ closeObjectTexts w
              ]
-    where scaler = setDepth 1 . scale (2 / _windowX w) (2 / _windowY w)
+    where scaler = setDepth (-1) . scale (2 / _windowX w) (2 / _windowY w)
           menuScreen :: Picture
           menuScreen = case _menuState w of
                         InGame -> blank 
@@ -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 = setLayer 3 . setDepth (-1) . polygon $ points
     where 
         (x:y:_) = _wlLine wall 
         points = extendConeToScreenEdge w sightFrom (x,y)
diff --git a/src/Picture.hs b/src/Picture.hs
index 373703619..a75a6593a 100644
--- a/src/Picture.hs
+++ b/src/Picture.hs
@@ -132,7 +132,7 @@ translate x y pic = OverPic (translate3 x y) id 0 id pic
 
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
-setDepth d pic = OverPic (\(x,y,_) -> (x,y,-d)) id 0 id pic
+setDepth d pic = OverPic (\(x,y,_) -> (x,y,d)) id 0 id pic
 
 setLayer :: Int -> Picture -> Picture
 {-# INLINE setLayer #-}
diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs
index 5f61c9937..44b637987 100644
--- a/src/Picture/Render.hs
+++ b/src/Picture/Render.hs
@@ -53,14 +53,6 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
 
     renderWalls pdata wallPointsCol pmat
 
-    renderWalls pdata windowPoints pmat
-
--- hack: the walls are drawn with a continuous depth from 0 to -1
--- the following call is aimed at setting the depth buffer over all the walls to
--- at most -0.9
-    colorMask $= (Color4 Disabled Disabled Disabled Disabled)
-    renderFoldable pdata $ picToLTree (Just 3) pic
-    colorMask $= (Color4 Enabled Enabled Enabled Enabled)
 
     depthFunc $= Just Lequal
 
@@ -76,6 +68,8 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
 
     renderFoldable pdata $ picToLTree (Just 2) pic
 
+    renderWalls pdata windowPoints pmat
+
     resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
     endTicks <- SDL.ticks
     return (ticksAfterLighting, endTicks - startTicks)