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

Improve debris

Browse Source
This commit is contained in:
justin
2026-04-01 17:01:25 +01:00
parent 97134e2652
commit ac32ebba2b
4 changed files with 108 additions and 98 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
+10 -4
View File
@@ -55,15 +55,21 @@ blColor :: Block -> Color
blColor _ = orange
makeBlockDebris :: Block -> World -> World
makeBlockDebris bl w = foldl' (flip $ makeDebris (BlockDebris $ blColor bl) mt) w ps
makeBlockDebris bl w = foldl' (flip $ makeDebris (blockDebrisType mwl bl) mt) w ps
where
dsize = debrisSize mt
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
mt = fromMaybe Stone $ do
mt = fromMaybe Stone $ mwl ^? _Just . wlMaterial
mwl = do
wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
(wlid, _) <- IS.minView wlids
wl <- w ^? cWorld . lWorld . walls . ix wlid
return $ _wlMaterial wl
w ^? cWorld . lWorld . walls . ix wlid
blockDebrisType :: Maybe Wall -> Block -> DebrisType
blockDebrisType wl bl = case wl ^? _Just . wlMaterial of
Just Glass -> GlassDebris
Just Metal -> MetalDebris red
_ -> BlockDebris $ blColor bl
-- makeDebris :: Material -> Color -> Point2 -> World -> World
makeDebris :: DebrisType -> Material -> Point2 -> World -> World