Use explicit out and in placements with ids

src/Dodge/Default/Room.hs

@@ -13,8 +13,8 @@ defaultRoom = Room
     , _rmPos    = []
     , _rmPath   = []
     , _rmPmnts  = []
-    , _rmPartPmnt   = Nothing
+    , _rmInPmnt   = []
-    , _rmExtPmnt    = Nothing
+    , _rmOutPmnt    = []
     , _rmBound      = []
     , _rmFloor      = InheritFloor
     , _rmName       = "defaultRoom"

src/Dodge/Layout.hs

@@ -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
+doPartialPlacement im w rm = case _rmInPmnt rm of
-    Nothing -> (w, rm)
+    [] -> (w, rm)
-    Just fi -> case _rmTakeFrom rm of
+    (InPlacement f i:xs) -> 
-        Nothing -> (w, rm)
+        let (w',r') = fst $ placeSpot (w,rm) (f (im IM.! i))
-        Just i  -> fst $ placeSpot (w,rm) (fi (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
+doExtendedPlacement (im,w) rm = case _rmOutPmnt rm of
-    Nothing -> ( (im,w) , rm )
+    [] -> ( (im,w) , rm )
-    Just plmnt -> case _rmLabel rm of
+    (OutPlacement plmnt i:xs) -> 
-        Nothing -> ( (im,w) , rm )
+        let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
-        Just i  -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
+        in doExtendedPlacement (IM.insert i plmnts im, neww) (newrm & rmOutPmnt %~ tail)
-            in ( (IM.insert i plmnts im, neww) , newrm )
+-- 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)

src/Dodge/LevelGen/Data.hs

@@ -77,8 +77,8 @@ data Room = Room
     , _rmPos        :: [RoomPos]
     , _rmPath       :: [(Point2, Point2)]
     , _rmPmnts      :: [Placement]
-    , _rmPartPmnt   :: Maybe ([Placement] -> Placement)
+    , _rmInPmnt     :: [InPlacement]
-    , _rmExtPmnt    :: Maybe Placement
+    , _rmOutPmnt    :: [OutPlacement]
     , _rmBound      :: [ [Point2] ]
     , _rmFloor      :: Floor
     , _rmName       :: String

src/Dodge/Room/Door.hs

@@ -28,12 +28,12 @@ door = defaultRoom
         ,uncurry inLink (V2 20  5,pi)
         ]
 
-switchDoorRoom :: Room
+switchDoorRoom :: Int -> Room
-switchDoorRoom = defaultRoom
+switchDoorRoom inplid = defaultRoom
     { _rmPolys = [rectNSWE 40 0 0 40]
     , _rmLinks = init lnks++ [last lnks]
     , _rmPath  = [(V2 20 35,V2 20 5)]
-    , _rmPartPmnt = Just f
+    , _rmInPmnt = [InPlacement f  inplid]
 -- door extends into side walls (for shadows as rendered 12/03/21)
 -- note no bounds
     }

src/Dodge/Room/LasTurret.hs

@@ -37,14 +37,14 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~
     , mntLightLnkCond unusedLnkToPS
     ]
 
-lightSensInsideDoor :: Room -> Room
+lightSensInsideDoor :: Int -> Room -> Room
-lightSensInsideDoor rm = rm 
+lightSensInsideDoor outplid rm = rm 
     & rmPmnts .:~ psPt atFstLnkOut 
         (PutShape $ colorSH yellow $
         thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
         <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
         <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
-    & rmExtPmnt ?~ lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)
+    & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)) outplid]
 
 lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement
 lasSensLightAboveDoor wth ps = extTrigLitPos 
@@ -54,29 +54,29 @@ lasSensLightAboveDoor wth ps = extTrigLitPos
     upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
         | otherwise = w
 
-lightSensByDoor :: Room -> Room
+lightSensByDoor :: Int -> Room -> Room
-lightSensByDoor rm = rm 
+lightSensByDoor outplid rm = rm 
     & rmPmnts .++~ 
         [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
             $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
         , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
         , heightWallPS (atFstLnkOutShiftInward 100)   30 covershape
         ]
-    & rmExtPmnt ?~ lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)
+    & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)) outplid]
   where
     covershape = rectNSEW 10 (-10) 20 (-20)
     sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
 
 lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
 lasSensorTurretTest n = do
-    cenroom <- shuffleLinks $ lightSensInsideDoor cenLasTur & rmLabel ?~ n
+    cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur & rmLabel ?~ n
-    let doorroom = switchDoorRoom & rmTakeFrom ?~ n
+    let doorroom = switchDoorRoom n & rmTakeFrom ?~ 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 cenLasTur) {_rmLabel = Just n}
+    cenroom <- shuffleLinks $ (lightSensByDoor n cenLasTur) {_rmLabel = Just n}
-    let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
+    let doorroom = (switchDoorRoom n) {_rmTakeFrom = Just n}
     return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom) 
         [ treeFromPost [PassDown doorroom] (UseAll door)
         , treeFromPost [PassDown door]     (UseLabel 0 corridor)

src/Dodge/Room/RunPast.hs

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