Fix block wall rendering

This commit is contained in:
jgk
2021-03-21 13:19:38 +01:00
parent 19fa3c1667
commit 8108772894
4 changed files with 0 additions and 24 deletions
-9
View File
@@ -573,17 +573,8 @@ data Wall
, _wlIsSeeThrough :: Bool
, _blVisible :: Bool
, _blDegrades :: [Int]
, _wlCastShadow :: Bool
, _blShadows :: [Int]
}
| MultiBlock
{ _wlLine :: [Point2]
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
, _subWalls :: [Wall]
}
data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int
, _ffColor :: Color
-1
View File
@@ -181,7 +181,6 @@ putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
, _blVisible = seen
, _blShadows = shadows
, _blDegrades = degradeHP
, _wlCastShadow = False
}
f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
in over walls f w
-2
View File
@@ -97,7 +97,6 @@ addBlockNoShadow (p:ps) hp col isSeeThrough degradability hasAllShadows w
, _blVisible = True
, _blShadows = []
, _blDegrades = degradability
, _wlCastShadow = bool
}
) is lines shadowList
wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize
@@ -131,7 +130,6 @@ addBlock (p:ps) hp col isSeeThrough degradability w
, _blVisible = True
, _blShadows = []
, _blDegrades = degradability
, _wlCastShadow = True
}
) is lines
wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize
-12
View File
@@ -367,10 +367,6 @@ drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
&& hasLOS (_btPos bt) (_crPos (you w)) w
&& _btState bt /= BtNoLabel
= pictures
--[ scale (2/_windowX w) (2/_windowY w)
-- . t
-- . translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
-- $ scale 0.1 0.1 $ text $ _btText bt
[ tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
]
@@ -399,10 +395,6 @@ drawItemName :: World -> FloorItem -> Picture
drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
&& hasLOS (_flItPos flIt) (_crPos (you w)) w
= pictures
--[ scale (2/_windowX w) (2/_windowY w)
-- . t
-- . translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
-- $ scale 0.1 0.1 $ text $ nameOfItem
[ tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
]
@@ -466,12 +458,8 @@ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
wallsForGloom :: World -> [(Point2,Point2)]
wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough)
$ filter wallCastsShadow
$ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
where linePairs (x:y:_) = (x,y)
wallCastsShadow wl = case wl ^? wlCastShadow of
Just b -> b
Nothing -> True
lightsForGloom' :: World -> [(Point4)]
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)