Work towards cross-room placements

src/Dodge/Default/Room.hs

@@ -3,13 +3,16 @@ module Dodge.Default.Room
 import Geometry.Data
 import Dodge.Room.Data
 
+import qualified Data.IntMap.Strict as IM
 defaultRoom :: Room
 defaultRoom = Room
     { _rmPolys  = []
     , _rmLinks  = []
     , _rmUsedLinks  = []
     , _rmPath   = []
-    , _rmPS     = []
+    , _rmPmnts     = []
+    , _rmPartialPmnts = IM.empty
+    , _rmLabelledPmnts = IM.empty
     , _rmBound  = []
     , _rmFloor  = []
     , _rmName   = "defaultRoom"

src/Dodge/Floor.hs

@@ -15,6 +15,7 @@ import Dodge.Room.Branch
 import Dodge.Room.Boss
 import Dodge.Room.LongDoor
 import Dodge.Room.NoNeedWeapon
+import Dodge.Room.Link
 import Dodge.Layout.Tree.Polymorphic
 import Dodge.Layout.Tree.Either
 import Dodge.Layout.Tree.Annotate
@@ -31,16 +32,13 @@ import Control.Monad.Loops
 import System.Random
 import Data.Sequence hiding (zipWith)
 import Data.Maybe
+
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree =
     let struct = treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]] [EndRoom]
         t' = padWithCorridors struct
     in treeFromTrunk 
             [[StartRoom]
-            ,[SpecificRoom spawnerRoom]
-            ,[Corridor]
-            ,[Corridor]
-            ,[Corridor]
             ,[Corridor]
             ,[SpecificRoom $ return $ connectRoom lasTunnel ]
             ,[Corridor]
@@ -122,12 +120,12 @@ layoutLevelFromSeed i seed = do
             putStr $ "Level generation with seed " ++ show seed ++ " failed: "
             let (seed',_) = random g
             layoutLevelFromSeed i' seed'
-  where
+ -- where
-    setLastLinkToUsed rm = case _rmLinks rm of
+ --   setLastLinkToUsed rm = case _rmLinks rm of
-        (_:_) -> rm
+ --       (_:_) -> rm
-            & rmLinks %~ init
+ --           & rmLinks %~ init
-            & rmUsedLinks %~ (last (_rmLinks rm) :)
+ --           & rmUsedLinks %~ (last (_rmLinks rm) :)
-        _ -> rm
+ --       _ -> rm
 
 compactDrawTree :: Tree String -> String
 compactDrawTree = unlines . compactDraw

src/Dodge/Layout.hs

@@ -55,7 +55,7 @@ generateLevelFromRoomList gr w
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
 
 doRoomPlacements :: World -> Room -> World
-doRoomPlacements w rm = fst $ foldl' placeSpot (w,rm) $ _rmPS rm
+doRoomPlacements w rm = fst $ foldl' placeSpot (w,rm) $ _rmPmnts rm
 
 updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot
 updatePSLnkUsing pf PSLnk{_psLinkShift=f} = uncurry PS $ f pf
@@ -117,13 +117,19 @@ gameRoomsFromRooms = map f
     f rm = GameRoom
         { _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
             ++ map fst (_rmLinks rm)
-        , _grViewpointsEx = map fst (_rmUsedLinks rm)
+        , _grViewpointsEx = mapMaybe unpos (_rmUsedLinks rm)
         , _grBound = expandPolyByFixed 100 . convexHullSafe . nubBy closePoints 
             . concat $ _rmBound rm ++ _rmPolys rm
-        , _grDir   = snd . head $ _rmUsedLinks rm
+        , _grDir   = getDir $ _rmUsedLinks rm
         , _grName  = _rmName rm
         }
     closePoints x y = roundPoint2 x == roundPoint2 y
+    unpos (OutLink _ p _) = Just p
+    unpos (InLink  p _) = Just p
+    unpos _ = Nothing
+    getDir (InLink _ a:_) = a
+    getDir (_:xs) = getDir xs
+    getDir _ = 0 -- fallback
 
 floorsFromRooms :: [Room] -> [(Point3,Point3)]
 floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)

src/Dodge/Layout/Tree/Annotate.hs

@@ -61,26 +61,26 @@ roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r])
                                 (randomiseOutLinks corridor)
 {- | Create a random room tree structure from a list of annotations.  -}
 annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
-annoToRoomTree [OrAno as] = do
+annoToRoomTree anos = case anos of
-    a <- takeOne as
+    [OrAno as] -> do
-    annoToRoomTree a
+        a <- takeOne as
-annoToRoomTree [Corridor] = pure . Right <$> randomiseOutLinks corridor
+        annoToRoomTree a
-annoToRoomTree [CorridorDebug] = pure . Right <$> randomiseOutLinks corridorDebug
+    [Corridor] -> pure . Right <$> randomiseOutLinks corridor
-annoToRoomTree [DoorAno] = roomThenCorridor door
+    [CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug
-annoToRoomTree [AirlockAno] = airlock >>=  roomThenCorridor
+    [DoorAno] -> roomThenCorridor door
-annoToRoomTree [FirstWeapon] = do
+    [AirlockAno] -> airlock >>=  roomThenCorridor
-    branchWP <- branchRectWith weaponRoom
+    [FirstWeapon] -> do
-    blockedC <- longBlockedCorridor
+        branchWP <- branchRectWith weaponRoom
-    join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
+        blockedC <- longBlockedCorridor
-annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1)
+        join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
-annoToRoomTree [StartRoom] = startRoom
+    [EndRoom] -> fmap (pure . Right) (telRoomLev 1)
-annoToRoomTree (SpecificRoom rt:_) = rt
+    [StartRoom] -> startRoom
-annoToRoomTree (BossAno cr : _) = do
+    (SpecificRoom rt:_) -> rt
-    br <- bossRoom cr
+    (BossAno cr : _) -> do
-    branchRectWith . pure . fmap Left $ treeFromPost [corridor,corridor] br
+        br <- bossRoom cr
-annoToRoomTree (TreasureAno crs loot : _) =
+        branchRectWith . pure . fmap Left $ treeFromPost [corridor,corridor] br
-    branchRectWith . fmap (pure . Left) $ lootRoom crs loot
+    (TreasureAno crs loot : _) -> branchRectWith . fmap (pure . Left) $ lootRoom crs loot
-annoToRoomTree _ = do
+    _ -> do
-    w <- state $ randomR (100,400)
+        w <- state $ randomR (100,400)
-    h <- state $ randomR (200,400)
+        h <- state $ randomR (200,400)
-    fmap (pure . Right) . randomiseOutLinks $ roomRectAutoLinks w h
+        fmap (pure . Right) . randomiseOutLinks $ roomRectAutoLinks w h

src/Dodge/Layout/Tree/Shift.hs

@@ -1,11 +1,8 @@
-{- |
+{- | Given a tree of rooms, tries to shift them into place in such a way that their
-Given a tree of rooms, tries to shift them into place in such a way that their
 links connect and that none of them clip.
-Returns a list; after this step the structure is determined by the actual positions of rooms.
+Creates a list of rooms; after this step the structure is determined by the actual positions of rooms.  -}
- -}
 module Dodge.Layout.Tree.Shift
-    ( shiftRoomTreeSearchAll
+    ( positionRooms
-    , positionRooms
     ) where
 import Dodge.Room.Data
 import Dodge.Room.Link
@@ -15,34 +12,9 @@ import Geometry.ConvexPoly
 import Data.Tree
 import Data.Sequence hiding (zipWith)
 import Data.List (delete)
---import Data.Maybe (listToMaybe)
 import Data.Bifunctor
 import Control.Lens hiding (Empty, (<|) , (|>))
 
-{- | All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.  -}
-shiftRoomTreeSearchAll 
-    :: [ConvexPoly]       -- ^ Clipping bounds
-    -> Seq (Tree Room)  -- ^ Rooms to be added
-    -> [[Room]]
-shiftRoomTreeSearchAll _ Empty = [[]]
-shiftRoomTreeSearchAll bs (Node r ts :<| tseq)
---    | roomIsClipping = [] -- this is called too often--might get memoized?
---    | otherwise = case ts of
---        [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq
---        (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls
-    = case ts of
-        [] | roomIsClipping -> []
-        [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq
-        (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls
-  where
-    convexBounds = map pointsToPoly $ _rmBound r
-    ls = init $ _rmLinks r
-    newBounds = convexBounds ++ bs
-    roomIsClipping = or (convexPolysOverlap <$> convexBounds <*> bs)
-    useLink l = r & rmLinks %~ delete l
-        & rmUsedLinks %~ (l :)
-    f l = applyToRoot (shiftRoomToLink l)
-
 positionRooms :: Tree RoomInt -> IO (Maybe [Room])
 positionRooms (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) ts Empty
 
@@ -59,30 +31,22 @@ posRms bounds (rtoadd,_) [] (Node (r,i) ts :<| tseq)
     = fmap (setLastLinkToUsed rtoadd:) <$> posRms bounds (r,i) ts tseq
 posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
     putStr $ "Trying to place room " ++ show i' ++ ": "
-    tryLinks' (0::Int) (_rmLinks r)
+    tryLinks (0::Int) (_rmLinks r)
   where
-    tryLinks' _ [] = do
+    tryLinks _ [] = do
         putStrLn "all links tried"
         return Nothing
-    tryLinks' j (l:ls) 
+    tryLinks j (l:ls) 
-        | clipping   = tryLinks' (j+1) ls
+        | clipping   = tryLinks (j+1) ls
         | otherwise = do
             putStrLn $ "placing at link " ++ show j
             mayrs <- posRms (convexBounds ++ bounds) useLink ts (tseq |> shiftedt)
             case mayrs of
-                Nothing -> do putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks' (j+1) ls
+                Nothing -> do putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks (j+1) ls
                 Just rs -> return (Just rs)
       where
         convexBounds = map pointsToPoly $ _rmBound r'
         clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
-        useLink = (r & rmLinks %~ delete l & rmUsedLinks %~ (l :)
+        useLink = (r & rmLinks %~ delete l & rmUsedLinks %~ (uncurry (OutLink (Prelude.length ts)) l :)
             , i)
         shiftedt@(Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l) t
-        
-
-setLastLinkToUsed :: Room -> Room
-setLastLinkToUsed rm = case _rmLinks rm of
-    (_:_) -> rm
-        & rmLinks %~ init
-        & rmUsedLinks %~ (last (_rmLinks rm) :)
-    _ -> rm

src/Dodge/Placements/Wall.hs

@@ -89,7 +89,7 @@ replacePutID
     -> Room 
     -> Room
 replacePutID i psts r =
-    r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts
+    r & rmPmnts %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts
 {- Partition a list by a predicate, apply a zip to those elements 
 that satisfy the predicate, concatenate 
 the new zipped list and the other (unchanged) half.  -}

src/Dodge/Room.hs

@@ -41,7 +41,7 @@ roomC w h = do
             , windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
             ]
     changeLinkFrom fromCond $ roomRectAutoLinks w h
-        & rmPS %~ (wl : )
+        & rmPmnts %~ (wl : )
         & rmRandPSs .~ [farside]
   where
     fromCond (V2 x _,_) = x < w / 2 - 10
@@ -56,11 +56,9 @@ roomPadCut ps p = defaultRoom
     { _rmPolys = [ps]
     , _rmLinks = [(p,0),(V2 0 0,pi)]
     , _rmPath  = [(V2 0 0,p)]
-    , _rmPS    = []
-    , _rmBound = []
     }
 roomPillars :: Room
-roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
+roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2
   where 
     plmnts = spanLightI (V2 120 24) (V2 120 216) 
         : mountLightV (V2 12 12) (V3 25 25 70)
@@ -86,8 +84,8 @@ glassLesson = do
     return $ Node (Left botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
   where 
     uppers = Node (Left door) [deadRoom topRoom]
-    botRoom = set rmPS botplmnts $ roomRect 200 200 1 1
+    botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1
-    topRoom = set rmPS topplmnts $ roomRect 200 200 1 1
+    topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1
     botplmnts = 
         [sPS    (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
         ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
@@ -134,12 +132,12 @@ glassSwitchBack = do
             return (V2 crx cry,1.5*pi)
         midPS = return (V2 (wth-20) (hgt/2+40), pi)
     return $ roomRect wth hgt 2 4
-        & rmPS .~ plmnts
+        & rmPmnts .~ plmnts
         & rmRandPSs .~ [northPSs,midPS]
 
 glassSwitchBackCrits :: RandomGen g => State g Room
 glassSwitchBackCrits = glassSwitchBack 
-    <&> rmPS %~ ([Placement (PSRoomRand 0) (PutCrit miniGunCrit) (const Nothing)
+    <&> rmPmnts %~ ([Placement (PSRoomRand 0) (PutCrit miniGunCrit) (const Nothing)
                 , Placement (PSRoomRand 1) randC1 (const Nothing)
                 ] ++)
 
@@ -178,7 +176,7 @@ miniRoom3 = do
                      ,sPS cp (pi/8+7*pi/4) b
                      ,sPS (V2 (w/2) (h/2)) 0 putLamp
                      ]
-        fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h
+        fmap connectRoom $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
 
 rot90Around :: Point2 -> Point2 -> Point2
 rot90Around cen p = cen +.+ vNormal (p -.- cen)
@@ -200,7 +198,7 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
 
 roomCenterPillar :: RandomGen g => State g Room
 roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) 
-    $ set rmPS plmnts $ roomRect 240 240 2 2
+    $ set rmPmnts plmnts $ roomRect 240 240 2 2
   where 
     plmnts = 
         [ blockLine (V2 115 115) (V2 115 125)
@@ -216,7 +214,7 @@ roomOctogon = defaultRoom
     { _rmPolys = [poly ]
     , _rmLinks = lnks
     , _rmPath  = allPairs $ map fst lnks -- this is too much
-    , _rmPS    = []
+    , _rmPmnts    = []
     , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
     , _rmFloor = [makeTileFromPoly poly 7]
     }
@@ -260,7 +258,7 @@ weaponEmptyRoom = do
             ,mntLightLnkCond (const True)
             ]
     (fmap connectRoom . randomiseOutLinks) =<< 
-        changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2)
+        changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2)
      
 weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
 weaponUnderCrits = do
@@ -271,7 +269,7 @@ weaponUnderCrits = do
             ]
     let continuationRoom = treeFromTrunk 
             [Left corridorN,Left corridorN] 
-            (connectRoom (set rmPS plmnts corridorN))
+            (connectRoom (set rmPmnts plmnts corridorN))
     rcp <- roomCenterPillar
     deadEndRoom' <- takeOne [roomPillars,rcp]
     junctionRoom <- takeOne [Left tEast,Left tWest]
@@ -292,9 +290,9 @@ weaponBehindPillar  = do
       rcp <- roomCenterPillar
       return $ treeFromTrunk 
         [Left door
-        ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp
+        ,Left $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
         ]
-        (connectRoom $ set rmPS [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
+        (connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
 
 weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
 weaponBetweenPillars = do
@@ -307,7 +305,7 @@ weaponBetweenPillars = do
             ,sPS crPos1 (d crPos1) randC1
             ,sPS crPos2 (d crPos2) randC1
             ]
-        theRoom = roomPillars & rmPS %~ (++ plmnts)
+        theRoom = roomPillars & rmPmnts %~ (++ plmnts)
     (fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom
   where 
     f (_,a) = a == 0
@@ -316,7 +314,7 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
 weaponLongCorridor = do
     root <- takeOne [tEast, tWest]
     connectingRoom <- takeOne 
-        [tEast & rmPS .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)]
+        [tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)]
         ]
     i1 <- state $ randomR (2,5)
     i2 <- state $ randomR (2,5)
@@ -324,11 +322,11 @@ weaponLongCorridor = do
     let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
     return $ Node (Left root) [branch1,branch2]
       where 
-        putCrs = over rmPS (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
+        putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
-        putWp = set rmPS [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
+        putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
 
 critInDeadEnd :: Room
-critInDeadEnd = set rmPS [sPS (V2 0 0) 0 randC1] deadEndRoom
+critInDeadEnd = set rmPmnts [sPS (V2 0 0) 0 randC1] deadEndRoom
 
 deadEndRoom :: Room
 deadEndRoom = defaultRoom
@@ -336,7 +334,7 @@ deadEndRoom = defaultRoom
                  ]
     , _rmLinks = lnks
     , _rmPath  = []
-    , _rmPS    = [sPS (V2 0 (-10)) 0 putLamp]
+    , _rmPmnts    = [sPS (V2 0 (-10)) 0 putLamp]
     , _rmBound = [rectNSWE 20 (-20) (-30) 30]
     }
   where 
@@ -353,7 +351,7 @@ weaponRoom = join $ takeOne
 
 roomCCrits :: RandomGen g => State g Room
 roomCCrits = roomC 200 200
-    <&> rmPS %~ (replicate 20 (Placement (PSRoomRand 0) randC1 (const Nothing)) ++ )
+    <&> rmPmnts %~ (replicate 20 (Placement (PSRoomRand 0) randC1 (const Nothing)) ++ )
 
 longRoom :: RandomGen g => State g Room
 longRoom = do
@@ -373,7 +371,7 @@ longRoom = do
     brls <- fmap (map (\p -> sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel) )
                             $ replicateM 5 $ randInRect (w-20) 900
     let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
-    changeLinkTo cond $ rm & rmPS .~ ws ++ brls ++ wsDefense ++
+    changeLinkTo cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
         [sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit
         ,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
         ,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
@@ -385,7 +383,7 @@ doubleCorridorBarrels :: RandomGen g => State g Room
 doubleCorridorBarrels = do
     h <- state $ randomR (200,300)
     let cond x = (sndV2 . fst) x < h - 40
-    changeLinkTo cond $ roomRect 100 h 1 1 & rmPS .~
+    changeLinkTo cond $ roomRect 100 h 1 1 & rmPmnts .~
         [blockLine (V2 50 50) (V2 50 h)
         ,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit
         ,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel
@@ -413,19 +411,19 @@ shootersRoom' = do
                     ,spanLightI (V2 (w/2) 200) (V2 (w+10) 200)
                      ]
         toPS x y = return (V2 x y,-0.5*pi)
-    return $ set rmPS plmnts $ roomRectAutoLinks w 600
+    return $ set rmPmnts plmnts $ roomRectAutoLinks w 600
-        & rmPS .~ plmnts
+        & rmPmnts .~ plmnts
         & rmRandPSs .~ [toPS x1 y1,toPS x2 y2,toPS x3 y3]
 
 shootersRoom1 :: RandomGen g => State g Room
-shootersRoom1 = shootersRoom' <&> rmPS %~ 
+shootersRoom1 = shootersRoom' <&> rmPmnts %~ 
     ( (
     RandomPlacement $ takeOne $ map (\i -> Placement (PSRoomRand i) (PutCrit autoCrit) (const Nothing))
                     [0,1,2]
     ) :)
 
 shootersRoom :: RandomGen g => State g Room
-shootersRoom = shootersRoom' <&> rmPS %~
+shootersRoom = shootersRoom' <&> rmPmnts %~
     ( map (\i -> Placement (PSRoomRand i) (PutCrit autoCrit) (const Nothing))
                     [0,1,2]
     ++ )
@@ -456,13 +454,13 @@ pillarGrid = do
                   ++ 
                  concat [f x y | x<-xs,y<-ys]
     return $ roomRect w h (max i 2) (max i 2)
-        & rmPS .~ plmnts
+        & rmPmnts .~ plmnts
         & rmRandPSs .~ [rps]
 
 -- TODO remove possible identical draws on random PSs
 pistolerRoom :: RandomGen g => State g Room
 pistolerRoom = pillarGrid
-    <&> rmPS %~ (
+    <&> rmPmnts %~ (
         [Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing)
         ,Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing)
         ,Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing)
@@ -480,10 +478,10 @@ shootingRange = do
     return $ treeFromPost 
         [Left rm1
         ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
-            & rmPS %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
+            & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
         ,Left rm2
         ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
-            & rmPS %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
+            & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
         ] 
         (Right rm3)
 
@@ -492,6 +490,6 @@ spawnerRoom = do
     x <- state $ randomR (250,300)
     y <- state $ randomR (300,400)
     roomWithSpawner <- roomC x y <&> 
-        rmPS %~ (Placement (PSRoomRand 0) (PutCrit spawnerCrit) (const Nothing) :)
+        rmPmnts %~ (Placement (PSRoomRand 0) (PutCrit spawnerCrit) (const Nothing) :)
     aRoom <- airlock
     return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner

src/Dodge/Room/Airlock.hs

@@ -26,7 +26,7 @@ airlock0 = defaultRoom
     { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ]
     , _rmLinks = lnks
     , _rmPath  = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20  5) ]
-    , _rmPS    = 
+    , _rmPmnts    = 
         [Placement (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
             $ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
                 $ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing
@@ -48,7 +48,7 @@ airlockSimple = defaultRoom
         [ rectNSWE 120 0 0 180 ]
     , _rmLinks = lnks
     , _rmPath  = concatMap (doublePair. (V2 90 30,) . fst) lnks
-    , _rmPS = 
+    , _rmPmnts = 
         [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
             $ \btid -> jspsJ (V2 0 0) 0 (PutDoor col (cond btid) outDoorps)
             $ sPS (V2 180 0) 0 (PutDoor col (cond btid) inDoorps)
@@ -77,7 +77,7 @@ airlockZ = defaultRoom
 --         [(V2 0 40,V2 40 0)
 --         ,(V2 40 0,V2 0 40)
 --         ]
-    , _rmPS = 
+    , _rmPmnts = 
         [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
             $ \btid -> jspsJ (V2 0 60) 0 (PutDoor col (cond btid) outDoorps)
             $ sPS (V2 180 60) 0 (PutDoor col (cond btid) inDoorps)
@@ -117,7 +117,7 @@ airlock90 = defaultRoom
          [(V2 0 40,V2 40 0)
          ,(V2 40 0,V2 0 40)
          ]
-    , _rmPS    = 
+    , _rmPmnts    = 
         [ Placement (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id)
             $ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
         ,mountLightV (V2 20 20) (V3 70 70 50)
@@ -145,7 +145,7 @@ airlockCrystal = defaultRoom
         ]
     , _rmLinks = [(V2 20 130,0) ,(V2 20  0 ,pi) ]
     , _rmPath  = [ ]
-    , _rmPS    = 
+    , _rmPmnts    = 
         [ Placement (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id)
             $ \btid -> jsps0 $ PutDoor col (cond btid) pss
         , crystalLine (V2 0 70) (V2 40 70)

src/Dodge/Room/Boss.hs

@@ -34,7 +34,7 @@ roomGlassOctogon x = createPathGrid $ defaultRoom
         [ ( V2 0 x        , V2 0 (-(x+40)))
         , ( V2 0 (-(x+40)), V2 0 x)
         ]
-    , _rmPS = 
+    , _rmPmnts = 
         [sPS (V2 fx fx)     0 putLamp
         ,sPS (V2 (-fx) fx)  0 putLamp
         ,sPS (V2 fx (-fx))  0 putLamp
@@ -55,14 +55,14 @@ roomGlassOctogon x = createPathGrid $ defaultRoom
         ]
 
 bossRoom :: RandomGen g => Creature -> State g Room
-bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :)
+bossRoom cr = randomMediumRoom <&> rmPmnts %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :)
 
 armouredChasers :: RandomGen g => State g (Tree Room)
 armouredChasers = do
     ps <- takeN 5 [V2 x y | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
     as <- replicateM 5 . state $ randomR (0,2*pi)
     let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs
-    treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits))
+    treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPmnts %~ (++ theCrits))
   where
     cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0]) 
             : replicate 4 chaseCrit
@@ -94,7 +94,7 @@ roomCross x y = defaultRoom
         ,(V2 (y-20) (-x),pi)
         ]
     , _rmPath  = []
-    , _rmPS = 
+    , _rmPmnts = 
         [ spanLightI (V2 (x+5) x) (V2 (x+5) (-x))
         , spanLightI (V2 (-x-5) x) (V2 (-x-5) (-x))
         ]
@@ -119,7 +119,7 @@ roomShuriken x y =
             { _rmPolys  = ps
             , _rmLinks  = [(V2 (x-1) (y-20),negate $ pi/2)]
             , _rmPath   = []
-            , _rmPS     = [mountLight (V2 x x) (V3 (x-20) x 70)]
+            , _rmPmnts     = [mountLight (V2 x x) (V3 (x-20) x 70)]
             , _rmBound  = ps
             }
     in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
@@ -143,7 +143,7 @@ roomTwistCross x y z =
             { _rmPolys  = ps
             , _rmLinks  = [(V2 z (y-20), pi/2)]
             , _rmPath   = []
-            , _rmPS     = [mountLight (V2 x x) (V3 (x-20) (x-20) 70)]
+            , _rmPmnts     = [mountLight (V2 x x) (V3 (x-20) (x-20) 70)]
             , _rmBound  = ps
             }
     in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]

src/Dodge/Room/Corridor.hs

@@ -17,7 +17,7 @@ corridor = defaultRoom
     { _rmPolys = [poly]
     , _rmLinks = lnks
     , _rmPath  = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
-    , _rmPS    = [ spanLightI (V2 0 40) (V2 40 40) ]
+    , _rmPmnts    = [ spanLightI (V2 0 40) (V2 40 40) ]
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     , _rmFloor = [makeTileFromPoly poly 2]  
     }
@@ -39,7 +39,7 @@ corridorDebug = defaultRoom
         ]
     , _rmLinks = lnks
     , _rmPath  = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
-    , _rmPS    = []
+    , _rmPmnts    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     }
   where 
@@ -55,7 +55,7 @@ corridorN = defaultRoom
                  ]
     , _rmLinks = lnks
     , _rmPath  = pth
-    , _rmPS    = []
+    , _rmPmnts    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     }
     where lnks = [(V2 20 70  ,0)
@@ -70,7 +70,7 @@ tEast = defaultRoom
                  ]
     , _rmLinks = lnks
     , _rmPath  = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
-    , _rmPS    = []
+    , _rmPmnts    = []
     , _rmBound = [ rectNSWE 70 10 0 40 ]
     }
   where 
@@ -86,7 +86,7 @@ tWest = defaultRoom
                  ]
     , _rmLinks = lnks
     , _rmPath  = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
-    , _rmPS    = []
+    , _rmPmnts    = []
     , _rmBound = [ rectNSWE 70 10 0 40 ]
     }
   where 

src/Dodge/Room/Data.hs

@@ -9,6 +9,7 @@ import Data.Tile
 import Control.Monad.State
 import System.Random
 import Control.Lens
+import qualified Data.IntMap.Strict as IM
 {- 
 The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room.
 Link pairs contain a position and rotation to attach to another room;
@@ -21,9 +22,11 @@ assigning no bounds will allow rooms to overlap.
 data Room = Room
     { _rmPolys  :: [ [Point2] ]
     , _rmLinks  :: [(Point2,Float)]
-    , _rmUsedLinks  :: [(Point2,Float)]
+    , _rmUsedLinks  :: [RoomPos]
     , _rmPath   :: [(Point2, Point2)]
-    , _rmPS     :: [Placement]
+    , _rmPmnts  :: [Placement]
+    , _rmLabelledPmnts :: IM.IntMap Placement
+    , _rmPartialPmnts :: IM.IntMap (Int -> Placement)
     , _rmBound  :: [ [Point2] ]
     , _rmFloor  :: [Tile]
     , _rmName   :: String
@@ -32,7 +35,9 @@ data Room = Room
     , _rmRandPSs :: [State StdGen (Point2,Float)]
     }
 data RoomPos 
-    = Link     (Point2,Float)
+    = OutLink Int Point2 Float
-    | UsedLink (Point2,Float)
+    | InLink  Point2 Float
-    | LinkInt  Int (Point2,Float)
+    | PosInt Int Point2 Float
+    | PosPl  Point2 Float
+  deriving (Eq,Ord,Show)
 makeLenses ''Room

src/Dodge/Room/Door.hs

@@ -14,8 +14,8 @@ door = defaultRoom
     , _rmLinks = lnks
     , _rmPath  = [(V2 20 35,V2 20 5)]
 -- door extends into side walls (for shadows as rendered 12/03)
-    , _rmPS    = [putAutoDoor (V2 0 20) (V2 40 20)]
+    , _rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)]
-    , _rmBound = [] 
+-- note no bounds
     }
     where lnks = [(V2 20 35,0)
                  ,(V2 20  5,pi)

src/Dodge/Room/Link.hs

@@ -15,6 +15,7 @@ module Dodge.Room.Link
     , randomiseOutLinks
     , randomiseLinksBy
     , invShiftLinkBy
+    , setLastLinkToUsed
     ) where
 import Dodge.LevelGen
 import Dodge.Room.Data
@@ -105,3 +106,10 @@ shiftPathBy
     -> (Point2,Point2) 
     -> (Point2,Point2) 
 shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
+
+setLastLinkToUsed :: Room -> Room
+setLastLinkToUsed rm = case _rmLinks rm of
+    (_:_) -> rm
+        & rmLinks %~ init
+        & rmUsedLinks %~ (uncurry InLink (last (_rmLinks rm)) :)
+    _ -> rm

src/Dodge/Room/LongDoor.hs

@@ -38,7 +38,7 @@ twinSlowDoorRoom w h x = defaultRoom
         , (V2 0 (-h), pi)
         ]
     , _rmPath   = []
-    , _rmPS     = 
+    , _rmPmnts     = 
         [ Placement (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
             $ \btid -> jsps0J (PutSlideDoor False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
             $ ps0 (PutSlideDoor False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
@@ -73,7 +73,7 @@ twinSlowDoorChasers = do
         rps = V2 65 <$> [20,40 .. 180]
     ps <- takeN 4 $ lps ++ rps
     let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
-    return $ twinSlowDoorRoom 80 200 40 & rmPS %~ (plmnts ++)
+    return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++)
 
 southPillarsRoom :: RandomGen g => Float -> Float -> Float -> State g Room
 southPillarsRoom x y h = do
@@ -85,7 +85,7 @@ southPillarsRoom x y h = do
         pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
            ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
     pillars <- takeOne [pillarsa, pillarsb, pillarsc]
-    return $ roomRectAutoLinks x y & rmPS .~ pillars
+    return $ roomRectAutoLinks x y & rmPmnts .~ pillars
 
 addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
 addSouthPillars x h r = do
@@ -97,7 +97,7 @@ addSouthPillars x h r = do
         pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
            ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
     pillars <- takeOne [pillarsa, pillarsb, pillarsc]
-    return $ r & rmPS %~ (++ pillars)
+    return $ r & rmPmnts %~ (++ pillars)
 
 addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
 addButtonSlowDoor x h rm = do
@@ -107,7 +107,7 @@ addButtonSlowDoor x h rm = do
        ]
     thePlacement <- takeOne [butDoor butPos butRot ]
     changeLinkFrom aboveH =<< changeLinkTo belowH (rm 
-        & rmPS %~ (thePlacement :)
+        & rmPmnts %~ (thePlacement :)
         & rmBound %~ (openDoorBound :)
         )
   where
@@ -138,7 +138,7 @@ slowDoorRoom = do
         lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
         barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
     proom <- southPillarsRoom x y h
-    addButtonSlowDoor x h (proom & rmPS %~ (++ (crits ++ barrels ++ lsources)))
+    addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels ++ lsources)))
 
 randC1 :: PSType
 randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit

src/Dodge/Room/NoNeedWeapon.hs

@@ -34,5 +34,5 @@ centerVaultExplosiveExit = do
             ,sPS (V2 0 120) 0 $ PutCrit explosiveBarrel
             ,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
             ]
-    r <- centerVaultRoom 120 120 50 <&> rmPS %~ (extraPS ++)
+    r <- centerVaultRoom 120 120 50 <&> rmPmnts %~ (extraPS ++)
     randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2

src/Dodge/Room/Procedural.hs

@@ -48,7 +48,7 @@ roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
     , _rmPath  = concatMap doublePair pth
-    , _rmPS    = []
+    , _rmPmnts    = []
     , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
     , _rmFloor = [Tile 
             { _tilePoly = rectNSWE y 0 0 x
@@ -69,7 +69,7 @@ roomRect x y xn yn = defaultRoom
 {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.  -}
 roomRectAutoLinks :: Float -> Float -> Room
 roomRectAutoLinks x y = (roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60))
-    {_rmPS = plmnts}
+    {_rmPmnts = plmnts}
   where
     plmnts = 
         [mntLightLnkCond (const True)
@@ -83,8 +83,8 @@ combineRooms r r' = defaultRoom
     , _rmLinks = _rmLinks r ++ _rmLinks r'
     , _rmPath  = map clampPath $ _rmPath  r 
               ++ _rmPath  r'
-    , _rmPS    = map (shiftPlacement $ _rmShift r)  (_rmPS r) 
+    , _rmPmnts    = map (shiftPlacement $ _rmShift r)  (_rmPmnts r) 
-              ++ map (shiftPlacement $ _rmShift r') (_rmPS r')
+              ++ map (shiftPlacement $ _rmShift r') (_rmPmnts r')
     , _rmBound = _rmBound r ++ _rmBound r'
     , _rmFloor = _rmFloor r ++ _rmFloor r'
     , _rmShift  = (V2 0 0 , 0)
@@ -126,7 +126,7 @@ quarterRoomFlat w = do
             ,(V2 0 (w-20),V2 0 0)
             ,(V2 (55-w) (w-20),V2 0 0)
             ]
-        , _rmPS     = b
+        , _rmPmnts     = b
         , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
         }
 
@@ -167,13 +167,13 @@ fourthCornerWall w = do
             ,(V2 0 0,V2 0 (w-40))
 --            ,(V2 (20-w) (w-20),V2 (40-w) (w))
             ]
-        , _rmPS     = b
+        , _rmPmnts     = b
         , _rmBound  = [map toV2 [(w,w),(0,2*w),(-w,w)]]
         }
 {- | Replace the first 'PutNothing' with a given 'PSType'. -}
 fillNothingPlacement :: PSType -> Room -> Room
 fillNothingPlacement pst r =
-    r & rmPS %~ replaceNothingWith pst
+    r & rmPmnts %~ replaceNothingWith pst
   where
     replaceNothingWith x (Placement (PS p rot) PutNothing _: pss) = sPS p rot x : pss
     replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
@@ -186,8 +186,8 @@ fillNothingPlacements pst r = foldr fillNothingPlacement r pst
 Useful for randomising the position of generic placements such as 'PutNothing'. -}
 shufflePlacements :: RandomGen g => Room -> State g Room
 shufflePlacements r = do
-    newPSs <- shuffle $ _rmPS r
+    newPSs <- shuffle $ _rmPmnts r
-    return $ r & rmPS .~ newPSs
+    return $ r & rmPmnts .~ newPSs
 {- | A randomly generate room based on four randomly generated corners. 
 Tight corridors, random placements. -}
 randomFourCornerRoom :: RandomGen g => State g Room
@@ -201,7 +201,7 @@ randomFourCornerRoom = do
         ++ replicate 20 chaseCrit
     randomiseAllLinks . fillNothingPlacements (crits ++ itms) =<< 
         ( shufflePlacements
-        . over rmPS ( sps0 putLamp :)
+        . over rmPmnts ( sps0 putLamp :)
         . foldr1 combineRooms 
         $ zipWith (\r a -> shiftRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
         )
@@ -221,7 +221,7 @@ centerVaultRoom w h d = do
             ,(V2 0   (-h), pi  )
             ]
         , _rmPath   = []
-        , _rmPS     = 
+        , _rmPmnts     = 
             [sps0 $ PutWall (rectNSEW   d  (d - 30)   d  (d - 30)) defaultWall
             ,sps0 $ PutWall (rectNSEW   d  (d - 30) (-d) (30 - d)) defaultWall
             ,sps0 $ PutWall (rectNSEW (-d) (30 - d)   d  (d - 30)) defaultWall

src/Dodge/Room/RoadBlock.hs

@@ -41,7 +41,7 @@ litCorridor90 = do
             ,( V2   0  (h-40) , V2 20 (h-40) )
             ,( V2  40  (h-40) , V2 20 (h-40) )
             ]
-        , _rmPS    = 
+        , _rmPmnts    = 
             [ sPS (V2 20 (h-5)) 0     putLamp
             , spanLightI (V2 0 (0.4*h)) (V2 40 (0.4*h))
             , windowLine (V2 0 (h-20)) (V2 40 (h-20))
@@ -63,7 +63,7 @@ longBlockedCorridor = do
                  ,sPS (V2 20 15) 0 putLamp
                  ]
     sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor) 
-                        $ return $ Right $ set rmPS plmnts corridor
+                        $ return $ Right $ set rmPmnts plmnts corridor
 
 -- | A single corridor with a destructible block blocking it.
 blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
@@ -74,14 +74,14 @@ blockedCorridor = do
                                           $ reverse $ rectNSWE 10 (-10) (-10) 10
             ,spanLightI (V2 0 15) (V2 40 15)
             ]
-    sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor
+    sequence $ treeFromPost [] $ return $ Right $ set rmPmnts plmnts corridor
 
 lasTunnel :: Room
 lasTunnel = defaultRoom
     { _rmPolys  = polys
     , _rmBound  = polys
     , _rmLinks  = [(V2 20 190,1.5* pi),(V2 0 20,0.5* pi)]
-    , _rmPS     = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi)
+    , _rmPmnts     = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi)
         , lowWall (rectNSEW 65 40 0 25)
         , mountLightV (V2 50 10) (V3 40 20 50)
         ]

src/Dodge/Room/Start.hs

@@ -20,7 +20,7 @@ import System.Random
 
 rezBox :: Room
 rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1 
-    & rmPS .~ [ spanColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ]
+    & rmPmnts .~ [ spanColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ]
 
 startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = do
@@ -30,7 +30,7 @@ startRoom = do
             girderV 40 20 10 (V2  0    (h/2)) (V2  w    (h/2))
     treeFromPost [Left rezBox, Left door] . Right 
         <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) 
-            $ roomRectAutoLinks w h & rmPS %~ 
+            $ roomRectAutoLinks w h & rmPmnts %~ 
             (
             [ fground
             , mountLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)

src/Dodge/Room/Teleport.hs

@@ -22,7 +22,7 @@ telRoomLev
 telRoomLev _ = do
     w <- state $ randomR (200,300)
     h <- state $ randomR (200,300)
-    return $ roomRectAutoLinks w h & rmPS .~ 
+    return $ roomRectAutoLinks w h & rmPmnts .~ 
         [ sPS (V2 (w/2) (h/2)) 0 $ PutPressPlate telPP 
         , sPS (V2 (w/2) (h/2+ 30)) 0 putLamp
         ]

src/Dodge/Room/Treasure.hs

@@ -28,7 +28,7 @@ triLootRoom w h = pure $ defaultRoom
                   ]
     , _rmLinks  = [(V2 0 (-80) , pi)]
     , _rmPath   = doublePair (V2 0 (-80) , V2 0 (h/2))
-    , _rmPS     =
+    , _rmPmnts     =
         [sPS (V2 (15-w)    15 )  0 $ PutID 0
         ,sPS (V2 (w-15)    15 ) pi $ PutID 0
         ,sPS (V2     0  (h-35))  0 $ PutID 2