Add in "linear" lWorld to separate time reversable worlds

This commit is contained in:
2022-10-28 12:24:51 +01:00
parent 5f6bd43599
commit 7e790b7153
130 changed files with 827 additions and 980 deletions
+8 -8
View File
@@ -27,7 +27,7 @@ plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
plBlock (p : ps) bl wl w =
(,) blid $
w
& cWorld . blocks . at blid
& cWorld . lWorld . blocks . at blid
?~ bl
{ _blID = blid
, _blWallIDs = IS.fromList is
@@ -36,9 +36,9 @@ plBlock (p : ps) bl wl w =
}
& insertWalls blid wls
where
blid = IM.newKey $ _blocks (_cWorld w)
blid = IM.newKey $ w ^. cWorld . lWorld . blocks
lns = zip (p : ps) (ps ++ [p])
i = IM.newKey $ _walls (_cWorld w)
i = IM.newKey $ w ^. cWorld . lWorld . walls
is = [i .. i + length lns -1]
wls =
zipWith
@@ -72,12 +72,12 @@ plLineBlock basePane blwidth a b gw =
cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
cornersAt p = fmap ((p +.+) . rotateV (argV (b -.- a))) cornerPoints
linesAt p = loopPairs $ cornersAt p
wlid = IM.newKey $ _walls (_cWorld gw)
blid = IM.newKey $ _blocks (_cWorld gw)
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
blid = IM.newKey $ gw ^. cWorld . lWorld . blocks
insertBlock (i, p) =
insertWalls (i + blid) (makeWallAt p i)
. over
(cWorld . blocks)
(cWorld . lWorld . blocks)
( IM.insert
(i + blid)
Block
@@ -115,11 +115,11 @@ plLineBlock basePane blwidth a b gw =
-- | Must be done after inserting the block
insertWalls :: Int -> [Wall] -> World -> World
insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ Set.unions paths
insertWalls blid wls w = w' & cWorld . lWorld . blocks . ix blid . blObstructs .~ Set.unions paths
where
(w', paths) = mapAccumR (flip insertWall) w wls
insertWall :: Wall -> World -> (World, Set PathEdgeNodes)
insertWall wl =
uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
. (cWorld . walls . at (_wlID wl) ?~ wl)
. (cWorld . lWorld . walls . at (_wlID wl) ?~ wl)