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

Add in "linear" lWorld to separate time reversable worlds

Browse Source
This commit is contained in:
justin
2022-10-28 12:24:51 +01:00
parent 5f6bd43599
commit 7e790b7153
130 changed files with 827 additions and 980 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block.hs
+16 -14
View File
@@ -31,15 +31,15 @@ splinterBlock bl w =
(_blPos bl)
where
bm = fromMaybe Stone $ do
wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
(wlid, _) <- IS.minView wlids
w ^? cWorld . walls . ix wlid . wlMaterial
w ^? cWorld . lWorld . walls . ix wlid . wlMaterial
unshadowBlock :: World -> Int -> World
unshadowBlock w wlid = case w ^? cWorld . walls . ix wlid of
unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of
Just wl ->
w
& cWorld . walls . ix wlid . wlUnshadowed .~ True
& cWorld . lWorld . walls . ix wlid . wlUnshadowed .~ True
& insertWallInZones (wl & wlUnshadowed .~ True)
Nothing -> w
@@ -55,13 +55,14 @@ destroyBlock bl w =
& makeBlockDebris bl
& deleteWallIDs wlids
& maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
& cWorld . blocks %~ IM.delete (_blID bl)
& cWorld . lWorld . blocks %~ IM.delete (_blID bl)
-- & matDesSound (_blMaterial bl) pos
& flip (foldl' $ flip (wlDustAt awl)) (map (pos +.+) ps)
where
wlids = _blWallIDs bl
awl = _walls (_cWorld w) IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
--awl = _walls (_cWorld w) IM.! IS.findMin wlids
awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
pos = fst . _wlLine $ awl
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
-- this does not handle eg doors blocking the path as well
@@ -72,21 +73,22 @@ maybeClearPath :: World -> PathEdgeNodes -> World
maybeClearPath w (PathEdgeNodes x y pe)
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
w
| otherwise = w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y)
| otherwise = w & cWorld . lWorld . 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
& cWorld . doors %~ IM.delete (_drID dr)
& cWorld . lWorld . doors %~ IM.delete (_drID dr)
& flip (foldl' (flip $ wlDustAt awl)) (map (pos +.+) ps)
& stopPushing (_drPushes dr)
& destroyMounts (_drMounts dr)
where
wlids = _drWallIDs dr
awl = _walls (_cWorld w) IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
--awl = _walls (_cWorld w) IM.! IS.findMin wlids
awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
pos = fst . _wlLine $ awl
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
destroyMounts :: [MountedObject] -> World -> World
@@ -95,12 +97,12 @@ destroyMounts mos w = foldl' (flip destroyMount) w mos
destroyMount :: MountedObject -> World -> World
destroyMount mo = case mo of
MountedLS lsid -> destroyLS lsid
MountedProp prid -> cWorld . props . at prid .~ Nothing
MountedProp prid -> cWorld . lWorld . props . at prid .~ Nothing
stopPushing :: Maybe Int -> World -> World
stopPushing mdrid w = fromMaybe w $ do
drid <- mdrid
dr <- w ^? cWorld . doors . ix drid
dr <- w ^? cWorld . lWorld . doors . ix drid
return $
w & cWorld . doors . ix drid . drMech .~ DrWdId
w & cWorld . lWorld . doors . ix drid . drMech .~ DrWdId
& stopPushing (_drPushes dr)