Fix block wall rendering
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user