Cleanup in/outplacements

src/Dodge/Default/Room.hs

@@ -21,8 +21,8 @@ defaultRoom = Room
     , _rmShift      = (V2 0 0 , 0)
     , _rmViewpoints = []
     , _rmRandPSs    = []
-    , _rmLabel      = Nothing
-    , _rmTakeFrom   = Nothing
+--    , _rmLabel      = Nothing
+--    , _rmTakeFrom   = Nothing
     , _rmStartWires = IM.empty
     , _rmEndWires   = IM.empty
     , _rmConnectsTo = S.member OutLink

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)

src/Dodge/LevelGen/Data.hs

@@ -85,8 +85,6 @@ data Room = Room
     , _rmShift      :: (Point2, Float)
     , _rmViewpoints :: [Point2]
     , _rmRandPSs    :: [State StdGen (Point2,Float)]
-    , _rmLabel      :: Maybe Int
-    , _rmTakeFrom   :: Maybe Int
     , _rmStartWires :: IM.IntMap RoomWire
     , _rmEndWires   :: IM.IntMap RoomWire
     , _rmConnectsTo :: S.Set RoomLinkType -> Bool

src/Dodge/Room/LasTurret.hs

@@ -69,14 +69,14 @@ lightSensByDoor outplid rm = rm
 
 lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
 lasSensorTurretTest n = do
-    cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur & rmLabel ?~ n
-    let doorroom = switchDoorRoom n & rmTakeFrom ?~ n
+    cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
+    let doorroom = switchDoorRoom n
     return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
 
 lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room)
 lasCenSensEdge n = do
-    cenroom <- shuffleLinks $ (lightSensByDoor n cenLasTur) {_rmLabel = Just n}
-    let doorroom = (switchDoorRoom n) {_rmTakeFrom = Just n}
+    cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
+    let doorroom = switchDoorRoom n
     return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom) 
         [ treeFromPost [PassDown doorroom] (UseAll door)
         , treeFromPost [PassDown door]     (UseLabel 0 corridor)

src/Dodge/Room/RunPast.hs

@@ -58,10 +58,9 @@ runPastRoom i = do
         critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1
         aswitchroom = corridorWallN
             {_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i]
-            ,_rmLabel = Just i
             ,_rmPmnts = []
             }
-        switchdoor = switchDoorRoom i & rmTakeFrom ?~ i
+        switchdoor = switchDoorRoom i 
         n = length $ filter theedgetest $ map lnkPosDir $ _rmLinks cenroom
         controom = treeFromPost [PassDown switchdoor,PassDown linkcor] (UseAll door)
         critrooms :: [SubCompTree Room]