Add explicit door position field

src/Dodge/Room/GlassLesson.hs

@@ -24,22 +24,20 @@ glassLesson = do
     i <- takeOne [1,2,3]
     corridors <- replicateM i $ PassDown <$> shuffleLinks corridor
     return $ Node (PassDown botRoom) 
-        [ singleUseNone $ door & rmConnectsTo .~ S.singleton (LabLink 0)
+        [ singleUseNone $ door & rmConnectsTo .~ fromWest North 1
         , uppers
-        , treeFromPost (PassDown (door & rmConnectsTo .~ S.singleton (OnEdge East)) 
+        , treeFromPost (PassDown (door & rmConnectsTo .~ S.member (OnEdge East)) 
             : corridors) $ UseAll door]
   where 
-    uppers = Node (PassDown $ door & rmConnectsTo .~ S.singleton (LabLink 1)) 
-        [singleUseNone $ setInLinksPD (onBottomEdgeLeft . fst) topRoom]
-    botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1 
-        & rmLinks %~ (setInLinksByType (OnEdge West)
-            . addLabelLink 0 (onTopEdgeRight . _rlPos)
-            . addLabelLink 1 (onTopEdgeLeft  . _rlPos)
-            )
-    onTopEdgeRight (V2 x y) = x > 50 && y > 95
-    onTopEdgeLeft (V2 x y) = x < 50 && y > 95
-    onBottomEdgeLeft (V2 x y) = x < 50 && y < 5
-    topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1
+    fromWest edge i s = S.member (OnEdge edge) s && S.member (FromWest i) s
+    uppers = Node (PassDown $ door & rmConnectsTo .~ fromWest North 0)
+        [singleUseNone topRoom]
+    botRoom = roomRect 200 200 1 1 
+        & rmPmnts .~ botplmnts 
+        & rmLinks %~ setInLinksByType (OnEdge West)
+    topRoom = roomRect 200 200 1 1
+        & rmPmnts .~ topplmnts
+        & rmLinks %~ setInLinks (fromWest South 0 . _rlType)
     botplmnts = 
         [sPS    (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
         ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
@@ -59,4 +57,4 @@ glassLesson = do
 glassLessonRunPast :: RandomGen g => State g (SubCompTree Room)
 glassLessonRunPast = f <$> glassLesson
   where
-    f (Node r rs) = Node r $ return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton (OnEdge West)) : rs
+    f (Node r rs) = Node r $ return (UseLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs

src/Dodge/Room/LasTurret.hs

@@ -123,5 +123,5 @@ lasTunnelRunPast y = do
     r2 <- takeOne [door,corridor]
     return $ Node (PassDown r)
         [ singleUseAll r1
-        , return (UseLabel 0 $ r2 & rmConnectsTo .~ S.singleton InLink)
+        , return (UseLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
         ]

src/Dodge/Room/LongDoor.hs

@@ -148,5 +148,5 @@ slowDoorRoomRunPast = do
     r <- slowDoorRoom
     return $ treeFromTrunk [PassDown door] $ Node (PassDown r)
         [ singleUseAll door
-        , return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
+        , return (UseLabel 0 $ door & rmConnectsTo .~ S.member InLink)
         ]

src/Dodge/Room/LongRoom.hs

@@ -54,7 +54,7 @@ longRoomRunPast = do
         (Node (PassDown r)
             [ singleUseAll door
             --, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
-            , treeFromPost [PassDown $ corridor & rmConnectsTo .~ S.singleton InLink, PassDown corridor] 
+            , treeFromPost [PassDown $ corridor & rmConnectsTo .~ S.member InLink, PassDown corridor] 
                 (UseLabel 0 door)
             ]
         )

src/Dodge/Room/RezBox.hs

@@ -62,7 +62,7 @@ rezBoxesWp = do
         (Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
   where
     adddoor rm = treeFromPost [PassDown $ connectsToNorth door ] (PassDown rm)
-    connectsToNorth = rmConnectsTo .~ S.singleton (OnEdge North)
+    connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)
 maybeBlockedPassage :: RandomGen g => State g (SubCompTree Room)
 maybeBlockedPassage = fmap singleUseAll $ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
 rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room)
@@ -75,7 +75,7 @@ rezBoxesWpCrit = do
         aroom = rezInvBox thecol
     let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
     onwardpassage <-
-        applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West)) <$> maybeBlockedPassage
+        applyToCompRoot (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
     let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
     i <- state $ randomR (0,n-3)
     j <- state $ randomR (i,n-2)
@@ -88,7 +88,7 @@ rezBoxesWpCrit = do
         ]
         (Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
   where
-    adddoor rm = treeFromPost [PassDown $ door & rmConnectsTo .~ S.singleton (OnEdge North)] (PassDown rm)
+    adddoor rm = treeFromPost [PassDown $ door & rmConnectsTo .~ S.member (OnEdge North)] (PassDown rm)
 
 crAdd :: Room -> Room
 crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5*pi) randC1
@@ -99,7 +99,7 @@ rezBoxes = do
     h <- state $ randomR (40,40)
     thecol <- rezColor
     let bottomEdgeTest = S.member (OnEdge South) . _rlType 
-        dbox = treeFromPost [PassDown $ door & rmConnectsTo .~ S.singleton (OnEdge South)] 
+        dbox = treeFromPost [PassDown $ door & rmConnectsTo .~ S.member (OnEdge South)] 
             (PassDown $ rezInvBox thecol)
     centralRoom <- shuffleLinks $ (roomRectAutoLinks w h) {_rmPmnts = []}
             & rmLinks %~ setInLinks bottomEdgeTest

src/Dodge/Room/RunPast.hs

@@ -68,5 +68,5 @@ runPastRoom i = do
         critrooms = treeFromPost [PassDown switchdoor] (PassDown critroom) : 
             replicate (n-2) (treeFromPost [PassDown switchdoor] (PassDown linkcor))
     return $ Node (PassDown cenroom) $ 
-        map (applyToCompRoot $ rmConnectsTo .~ S.singleton (OnEdge theedge)) (controom : critrooms) 
+        map (applyToCompRoot $ rmConnectsTo .~ S.member (OnEdge theedge)) (controom : critrooms) 
             ++ [return $ PassDown aswitchroom]