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

Separate out concrete part of world

Browse Source
This commit is contained in:
justin
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block.hs
+14 -14
View File
@@ -28,14 +28,14 @@ splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardC
(weakenMatS bm) (_blPos bl)
where
bm = fromMaybe Stone $ do
wlids <- w ^? blocks . ix (_blID bl) . blWallIDs
wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
(wlid,_) <- IS.minView wlids
w ^? walls . ix wlid . wlMaterial
w ^? cWorld . walls . ix wlid . wlMaterial
unshadowBlock :: Int -> World -> World
unshadowBlock wlid w = case w ^? walls . ix wlid of
unshadowBlock wlid w = case w ^? cWorld . walls . ix wlid of
Just wl -> w
& walls . ix wlid . wlUnshadowed .~ True
& cWorld . walls . ix wlid . wlUnshadowed .~ True
& insertWallInZones (wl & wlUnshadowed .~ True)
Nothing -> w
@@ -50,13 +50,13 @@ destroyBlock bl w = w
& makeBlockDebris bl
& deleteWallIDs wlids
& maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
& blocks %~ IM.delete (_blID bl)
& cWorld . blocks %~ IM.delete (_blID bl)
-- & matDesSound (_blMaterial bl) pos
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
where
wlids = _blWallIDs bl
awl = _walls w IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids
awl = _walls (_cWorld w) IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
-- this does not handle eg doors blocking the path as well
@@ -67,20 +67,20 @@ maybeClearPath :: World -> (Int,Int,PathEdge) -> World
maybeClearPath w (x,y,pe)
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w
= w
| otherwise = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles .~ mempty) . FGL.delEdge (x,y)
| otherwise = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles .~ mempty) . FGL.delEdge (x,y)
destroyDoor :: Door -> World -> World
destroyDoor dr w = w
& doDrWdWd (_drDeath dr) dr
& deleteWallIDs wlids
& doors %~ IM.delete (_drID dr)
& cWorld . doors %~ IM.delete (_drID dr)
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
& stopPushing (_drPushes dr)
& destroyMounts (_drMounts dr)
where
wlids = _drWallIDs dr
awl = _walls w IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids
awl = _walls (_cWorld w) IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
destroyMounts :: [MountedObject] -> World -> World
@@ -89,11 +89,11 @@ destroyMounts mos w = foldr destroyMount w mos
destroyMount :: MountedObject -> World -> World
destroyMount mo = case mo of
MountedLS lsid -> destroyLS lsid
MountedProp prid -> props . at prid .~ Nothing
MountedProp prid -> cWorld . props . at prid .~ Nothing
stopPushing :: Maybe Int -> World -> World
stopPushing mdrid w = fromMaybe w $ do
drid <- mdrid
dr <- w ^? doors . ix drid
return $ w & doors . ix drid . drMech .~ DrWdId
dr <- w ^? cWorld . doors . ix drid
return $ w & cWorld . doors . ix drid . drMech .~ DrWdId
& stopPushing (_drPushes dr)