Separate out concrete part of world

This commit is contained in:
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
+6 -6
View File
@@ -20,9 +20,9 @@ makeDoorDebris dr w = w & makeDebris mt col p
where
p = uncurry midPoint (_drPos dr)
(mt,col) = fromMaybe (Stone,greyN 0.5) $ do
wlids <- w ^? doors . ix (_drID dr) . drWallIDs
wlids <- w ^? cWorld . doors . ix (_drID dr) . drWallIDs
(wlid,_) <- IS.minView wlids
wl <- w ^? walls . ix wlid
wl <- w ^? cWorld . walls . ix wlid
return (_wlMaterial wl,_wlColor wl)
makeBlockDebris :: Block -> World -> World
@@ -32,9 +32,9 @@ makeBlockDebris bl w = foldr (makeDebris mt col) w ps
dsize = debrisSize mt
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
(mt,col) = fromMaybe (Stone,greyN 0.5) $ do
wlids <- w ^? blocks . ix (_blID bl) . blWallIDs
wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
(wlid,_) <- IS.minView wlids
wl <- w ^? walls . ix wlid
wl <- w ^? cWorld . walls . ix wlid
return (_wlMaterial wl,_wlColor wl)
makeDebrisToHeight :: Float -> Material -> Color -> Point2 -> World -> World
@@ -46,7 +46,7 @@ makeDebris = makeDebrisDirected 1 2 (2*pi) 0
makeDebrisDirectedHeight :: Float -> Float -> Float -> Float -> Float -> Material
-> Color -> Point2 -> World -> World
makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w
& flip (foldl' (flip $ plNew props prID)) thedebris
& flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris
& randGen .~ newg
& originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
where
@@ -75,7 +75,7 @@ makeDebrisDirected :: Float
-> Point2
-> World -> World
makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
& flip (foldl' (flip $ plNew props prID)) thedebris
& flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris
& randGen .~ newg
& originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
where