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

Simplify room out/in placements

Browse Source
This commit is contained in:
justin
2025-09-23 10:14:19 +01:00
parent d1bb8a985b
commit 5ee78ceffc
4 changed files with 25 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+8 -8
View File
@@ -78,20 +78,20 @@ shuffleRoomPos rm = do
newPos <- shuffle $ _rmPos rm
return $ rm & rmPos .~ newPos
doInPlacements :: (IM.IntMap [Placement], GenWorld) -> GenWorld
doInPlacements (im, w) =
let (gw, rms) = mapAccumR (doRoomInPlacements im) w (_genRooms w)
doInPlacements :: GenWorld -> GenWorld
doInPlacements w =
let (gw, rms) = mapAccumR doRoomInPlacements w (_genRooms w)
in gw & genRooms .~ rms
doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
doRoomInPlacements im w rm = foldr f (w, rm) $ _rmInPmnt rm
doRoomInPlacements :: GenWorld -> Room -> (GenWorld, Room)
doRoomInPlacements w rm = foldr f (w, rm) $ _rmInPmnt rm
where
f (InPlacement plf i) (w', r') = fst $ placeSpot (w', r') (plf (w') $ im IM.! i)
f plf (w', r') = fst $ placeSpot (w', r') (plf (w'))
doOutPlacements :: GenWorld -> (IM.IntMap [Placement], GenWorld)
doOutPlacements :: GenWorld -> GenWorld
doOutPlacements w =
let ((pmnts, gw), rms) = mapAccumR doRoomOutPlacements (IM.empty, w) (_genRooms w)
in (pmnts, gw & genRooms .~ rms)
in gw & genRooms .~ rms & genPmnt .~ pmnts
doRoomOutPlacements ::
(IM.IntMap [Placement], GenWorld) ->