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

Use explicit out and in placements with ids

Browse Source
This commit is contained in:
justin
2022-03-11 12:55:59 +00:00
parent 219e4e15ee
commit 5d43fc8244
6 changed files with 33 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+14 -11
View File
@@ -132,11 +132,13 @@ doPartialPlacements (im,w) = let (gw,rms) = mapAccumR (doPartialPlacement im) w
in gw {_gRooms = rms}
doPartialPlacement :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
doPartialPlacement im w rm = case _rmPartPmnt rm of
Nothing -> (w, rm)
Just fi -> case _rmTakeFrom rm of
Nothing -> (w, rm)
Just i -> fst $ placeSpot (w,rm) (fi (im IM.! i))
doPartialPlacement im w rm = case _rmInPmnt rm of
[] -> (w, rm)
(InPlacement f i:xs) ->
let (w',r') = fst $ placeSpot (w,rm) (f (im IM.! i))
in doPartialPlacement im w' (r' & rmInPmnt %~ tail)
-- TODO rather than explicitly recursing and changing the room, this should be done
-- with a fold over the list of in placements
doExtendedPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld)
doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (IM.empty,w) (_gRooms w)
@@ -145,12 +147,13 @@ doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (I
doExtendedPlacement :: (IM.IntMap [Placement], GenWorld)
-> Room
-> ( (IM.IntMap [Placement], GenWorld) , Room )
doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of
Nothing -> ( (im,w) , rm )
Just plmnt -> case _rmLabel rm of
Nothing -> ( (im,w) , rm )
Just i -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
in ( (IM.insert i plmnts im, neww) , newrm )
doExtendedPlacement (im,w) rm = case _rmOutPmnt rm of
[] -> ( (im,w) , rm )
(OutPlacement plmnt i:xs) ->
let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
in doExtendedPlacement (IM.insert i plmnts im, neww) (newrm & rmOutPmnt %~ tail)
-- TODO rather than explicitly recursing and changing the room, this should be done
-- with a fold over the list of out placements
doIndividualPlacements :: GenWorld -> GenWorld
doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_gRooms gw)