Make windows render over walls

This commit is contained in:
jgk
2021-03-21 13:43:23 +01:00
parent a34c578786
commit 779c858a2c
+5 -8
View File
@@ -27,10 +27,8 @@ import qualified Data.Set as S
-- }}}
fixedCoordPictures :: World -> Picture
fixedCoordPictures w = pictures
-- [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
[ scaler $ hudDrawings w
, scaler $ onLayer MenuLayer menuScreen
--, onLayer InvLayer $ activeObjectText w
, onLayer InvLayer $ closeObjectTexts w
]
where scaler = scale (2 / _windowX w) (2 / _windowY w)
@@ -57,7 +55,6 @@ fixedCoordPictures w = pictures
]
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
worldPictures :: World -> Picture
worldPictures w
= pictures $ concat [ decPicts
@@ -87,7 +84,7 @@ worldPictures w
clPicts = map clDraw $ IM.elems $ _clouds w
smokeShadows = map (drawSmokeShadow w) $ _smoke w
wlPicts = map drawWallFloor (wallFloorsToDraw w)
wlPicts' = map (drawWall w) (wallShadowsToDraw w)
wlPicts' = map (drawWallFace w) (wallShadowsToDraw w)
itFloorPicts = map drawItem (IM.elems (_floorItems w))
yourPos = _crPos $ you w
yourRot = _crDir $ you w
@@ -307,16 +304,16 @@ 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
drawWallFace :: World -> Wall -> Drawing
drawWallFace w wall
| isRHS sightFrom x y = blank
| otherwise = colorAndLayer $ polygon $ points
where
colorAndLayer | _wlIsSeeThrough wall = setLayer 2
. onLayerL [levLayer ShadowLayer]
. onLayerL [levLayer ShadowLayer,2]
. color (withAlpha 0.2 $ _wlColor wall)
| otherwise = setLayer 2
. onLayerL [levLayer ShadowLayer,2]
. onLayerL [levLayer ShadowLayer]
. color (_wlColor wall)
(x:y:_) = _wlLine wall
ps = linePointsBetween x y