justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Fix block wall rendering

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
-9
View File
@@ -573,17 +573,8 @@ data Wall
, _wlIsSeeThrough :: Bool , _wlIsSeeThrough :: Bool
, _blVisible :: Bool , _blVisible :: Bool
, _blDegrades :: [Int] , _blDegrades :: [Int]
, _wlCastShadow :: Bool
, _blShadows :: [Int] , _blShadows :: [Int]
} }
| MultiBlock
{ _wlLine :: [Point2]
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
, _subWalls :: [Wall]
}
data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int
, _ffColor :: Color , _ffColor :: Color
src/Dodge/LevelGen.hs
-1
View File
@@ -181,7 +181,6 @@ putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
, _blVisible = seen , _blVisible = seen
, _blShadows = shadows , _blShadows = shadows
, _blDegrades = degradeHP , _blDegrades = degradeHP
, _wlCastShadow = False
} }
f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
in over walls f w in over walls f w
src/Dodge/LevelGen/Block.hs
-2
View File
@@ -97,7 +97,6 @@ addBlockNoShadow (p:ps) hp col isSeeThrough degradability hasAllShadows w
, _blVisible = True , _blVisible = True
, _blShadows = [] , _blShadows = []
, _blDegrades = degradability , _blDegrades = degradability
, _wlCastShadow = bool
} }
) is lines shadowList ) is lines shadowList
wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize 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 , _blVisible = True
, _blShadows = [] , _blShadows = []
, _blDegrades = degradability , _blDegrades = degradability
, _wlCastShadow = True
} }
) is lines ) is lines
wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize
src/Dodge/Rendering.hs
-12
View File
@@ -367,10 +367,6 @@ drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
&& hasLOS (_btPos bt) (_crPos (you w)) w && hasLOS (_btPos bt) (_crPos (you w)) w
&& _btState bt /= BtNoLabel && _btState bt /= BtNoLabel
= pictures = 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)]
, 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 drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
&& hasLOS (_flItPos flIt) (_crPos (you w)) w && hasLOS (_flItPos flIt) (_crPos (you w)) w
= pictures = 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)]
, 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 :: World -> [(Point2,Point2)]
wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough) wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough)
$ filter wallCastsShadow
$ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
where linePairs (x:y:_) = (x,y) where linePairs (x:y:_) = (x,y)
wallCastsShadow wl = case wl ^? wlCastShadow of
Just b -> b
Nothing -> True
lightsForGloom' :: World -> [(Point4)] lightsForGloom' :: World -> [(Point4)]
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w) lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)