Cleanup in/outplacements

src/Dodge/Layout.hs

@@ -42,8 +42,8 @@ generateLevelFromRoomList gr' w = over gWorld initWallZoning
     . over gWorld setupWorldBounds
     . placeWires
     . doAfterPlacements
-    . doPartialPlacements
-    . doExtendedPlacements
+    . doInPlacements
+    . doOutPlacements
     . doIndividualPlacements
     . setFloors
     . worldToGenWorld rs'
@@ -127,33 +127,27 @@ doAfterPlacement pmntis gw = gRandify gw $ do
     let (newgw,rm) = fst $ placeSpot (gw,_gRooms gw IM.! i) pmnt
     return $ newgw & gRooms . ix i .~ rm
 
-doPartialPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld
-doPartialPlacements (im,w) = let (gw,rms) = mapAccumR (doPartialPlacement im) w (_gRooms w)
+doInPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld
+doInPlacements (im,w) = let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_gRooms w)
     in gw {_gRooms = rms}
 
-doPartialPlacement :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
-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
+doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
+doRoomInPlacements im w rm = foldr f (w,rm) $ _rmInPmnt rm
+  where
+    f (InPlacement plf i) (w',r') = fst $ placeSpot (w',r') (plf $ im IM.! i)
 
-doExtendedPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld)
-doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (IM.empty,w) (_gRooms w)
+doOutPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld)
+doOutPlacements w = let ((pmnts,gw),rms) = mapAccumR doRoomOutPlacements (IM.empty,w) (_gRooms w)
     in (pmnts,gw{_gRooms = rms})
 
-doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) 
+doRoomOutPlacements :: (IM.IntMap [Placement], GenWorld) 
     -> Room 
     -> ( (IM.IntMap [Placement], GenWorld) , Room )
-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
+doRoomOutPlacements imw r = foldr f ( imw, r ) $ _rmOutPmnt r
+  where
+    f (OutPlacement pl i) ( (im,w) , rm ) = 
+        let ((neww,newrm),plmnts) = placeSpot (w,rm) pl
+        in ((IM.insert i plmnts im, neww) , newrm )
 
 doIndividualPlacements :: GenWorld -> GenWorld
 doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_gRooms gw)