Make windows render over walls

This commit is contained in:
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 :: World -> Picture
fixedCoordPictures w = pictures fixedCoordPictures w = pictures
-- [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
[ scaler $ hudDrawings w [ scaler $ hudDrawings w
, scaler $ onLayer MenuLayer menuScreen , scaler $ onLayer MenuLayer menuScreen
--, onLayer InvLayer $ activeObjectText w
, onLayer InvLayer $ closeObjectTexts w , onLayer InvLayer $ closeObjectTexts w
] ]
where scaler = scale (2 / _windowX w) (2 / _windowY 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 where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
worldPictures :: World -> Picture worldPictures :: World -> Picture
worldPictures w worldPictures w
= pictures $ concat [ decPicts = pictures $ concat [ decPicts
@@ -87,7 +84,7 @@ worldPictures w
clPicts = map clDraw $ IM.elems $ _clouds w clPicts = map clDraw $ IM.elems $ _clouds w
smokeShadows = map (drawSmokeShadow w) $ _smoke w smokeShadows = map (drawSmokeShadow w) $ _smoke w
wlPicts = map drawWallFloor (wallFloorsToDraw 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)) itFloorPicts = map drawItem (IM.elems (_floorItems w))
yourPos = _crPos $ you w yourPos = _crPos $ you w
yourRot = _crDir $ you w yourRot = _crDir $ you w
@@ -307,16 +304,16 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
where sp = screenPolygon w where sp = screenPolygon w
sps = zip sp (tail sp ++ [head sp]) sps = zip sp (tail sp ++ [head sp])
drawWall :: World -> Wall -> Drawing drawWallFace :: World -> Wall -> Drawing
drawWall w wall drawWallFace w wall
| isRHS sightFrom x y = blank | isRHS sightFrom x y = blank
| otherwise = colorAndLayer $ polygon $ points | otherwise = colorAndLayer $ polygon $ points
where where
colorAndLayer | _wlIsSeeThrough wall = setLayer 2 colorAndLayer | _wlIsSeeThrough wall = setLayer 2
. onLayerL [levLayer ShadowLayer] . onLayerL [levLayer ShadowLayer,2]
. color (withAlpha 0.2 $ _wlColor wall) . color (withAlpha 0.2 $ _wlColor wall)
| otherwise = setLayer 2 | otherwise = setLayer 2
. onLayerL [levLayer ShadowLayer,2] . onLayerL [levLayer ShadowLayer]
. color (_wlColor wall) . color (_wlColor wall)
(x:y:_) = _wlLine wall (x:y:_) = _wlLine wall
ps = linePointsBetween x y ps = linePointsBetween x y