Transition to new room datatypes, first separate out/inlinks

src/Dodge/Debug/LinkDecoration.hs

@@ -22,7 +22,7 @@ addRoomLinkDecorations rms w = w & decorations %~
     IM.insertWithNewKeys (map roomLinkDecorations rms)
 
 roomLinkDecorations :: Room -> Picture
-roomLinkDecorations rm = pictures . map linkDecoration $ _rmLinks rm 
+roomLinkDecorations rm = pictures . map linkDecoration $ _rmOutLinks rm ++ _rmInLinks rm
 
 linkDecoration :: (Point2,Float) -> Picture
 linkDecoration (p,a) = setLayer 1 . onLayer DebugLayer . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi/2)]

src/Dodge/Default/Room.hs

@@ -7,8 +7,9 @@ import qualified Data.IntMap.Strict as IM
 defaultRoom :: Room
 defaultRoom = Room
     { _rmPolys  = []
-    , _rmLinks  = []
+    , _rmOutLinks  = []
     , _rmLinkEff = []
+    , _rmInLinks = []
     , _rmPos    = []
     , _rmPath   = []
     , _rmPmnts  = []

src/Dodge/LevelGen/Data.hs

@@ -63,7 +63,8 @@ assigning no bounds will allow rooms to overlap.
  -}
 data Room = Room
     { _rmPolys  :: [ [Point2] ]
-    , _rmLinks  :: [(Point2,Float)] 
+    , _rmOutLinks  :: [(Point2,Float)] 
+    , _rmInLinks :: [(Point2,Float)]
         -- update the room when assigning the next link to an adjacent room with the head of of this list, return the tail
     , _rmLinkEff :: [(Point2,Float) -> Room -> Room]
     , _rmPos    :: [RoomPos]

src/Dodge/Room/Airlock.hs

@@ -23,7 +23,8 @@ airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ]
 airlock0 :: Room
 airlock0 = defaultRoom
     { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks  = [last lnks]
     , _rmPath  = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20  5) ]
     , _rmPmnts    = 
         [pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
@@ -45,7 +46,8 @@ airlockSimple :: Room
 airlockSimple = defaultRoom
     { _rmPolys =
         [ rectNSWE 120 0 0 180 ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks  = [last lnks]
     , _rmPath  = concatMap (doublePair. (V2 90 30,) . fst) lnks
     , _rmPmnts = 
         [pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
@@ -68,10 +70,8 @@ airlockZ :: Room
 airlockZ = defaultRoom
     { _rmPolys =
         [ rectNSWE 120 0 0 180 ]
-    , _rmLinks =
+    , _rmOutLinks = [(V2 0 30,pi/2)]
-         [(V2 0 30,pi/2)
+    , _rmInLinks = [(V2 180 30,1.5*pi) ]
-         ,(V2 180 30,1.5*pi)
-         ]
     , _rmPath  = []
 --         [(V2 0 40,V2 40 0)
 --         ,(V2 40 0,V2 0 40)
@@ -108,10 +108,8 @@ airlock90 = defaultRoom
             , (100,10)
             ]
         ]
-    , _rmLinks =
+    , _rmOutLinks = [(V2 0 40,pi/2)]
-         [(V2 0 40,pi/2)
+    , _rmInLinks = [(V2 40 0,pi) ]
-         ,(V2 40 0,pi)
-         ]
     , _rmPath  = 
          [(V2 0 40,V2 40 0)
          ,(V2 40 0,V2 0 40)
@@ -143,7 +141,8 @@ airlockCrystal = defaultRoom
         [ rectNSWE 140 0 0 40
         , orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
         ]
-    , _rmLinks = [(V2 20 130,0) ,(V2 20  0 ,pi) ]
+    , _rmOutLinks = [(V2 20 130,0) ]
+    , _rmInLinks = [(V2 20  0 ,pi) ]
     , _rmPath  = [ ]
     , _rmPmnts    = 
         [pContID (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id)

src/Dodge/Room/Boss.hs

@@ -29,7 +29,8 @@ roomGlassOctogon x = createPathGrid $ defaultRoom
         [rectNSWE x (-x) (-x) x
         ,rectNSWE 0 (-(x + 40)) (-20) 20
         ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = linksAndPath lnks  
         [ ( V2 0 x        , V2 0 (-(x+40)))
         , ( V2 0 (-(x+40)), V2 0 x)
@@ -84,15 +85,15 @@ roomCross x y = defaultRoom
     { _rmPolys = [rectNSWE y (-y) (-x) x
                  ,rectNSWE (-x) x y (-y)
                  ]
-    , _rmLinks = 
+    , _rmOutLinks = 
         [(V2  x  (y-20),negate $ pi/2)
         ,(V2  x  (20-y),negate $ pi/2)
         ,(V2 (20-y)  x ,0)
         ,(V2 (y-20)  x ,0)
         ,(V2 (-x) (y-20),pi/2)
         ,(V2 (-x) (20-y),pi/2)
-        ,(V2 (20-y) (-x),pi)
+        ,(V2 (20-y) (-x),pi) ]
-        ,(V2 (y-20) (-x),pi)
+    , _rmInLinks = [(V2 (y-20) (-x),pi)
         ]
     , _rmPath  = []
     , _rmPmnts = 
@@ -119,7 +120,8 @@ roomShuriken x y =
             ]   ]
         corner = defaultRoom
             { _rmPolys  = ps
-            , _rmLinks  = [(V2 (x-1) (y-20),negate $ pi/2)]
+            , _rmOutLinks  = [(V2 (x-1) (y-20),negate $ pi/2)]
+            , _rmInLinks  = [(V2 (x-1) (y-20),negate $ pi/2)]
             , _rmPath   = []
             , _rmPmnts  = [mntLS iShape (V2 x x) (V3 (x-20) x 70)]
             , _rmBound  = ps
@@ -144,7 +146,8 @@ roomTwistCross x y z =
             ]
         corner = defaultRoom
             { _rmPolys  = ps
-            , _rmLinks  = [(V2 z (y-20), pi/2)]
+            , _rmOutLinks  = [(V2 z (y-20), pi/2)]
+            , _rmInLinks  = [(V2 z (y-20), pi/2)]
             , _rmPath   = []
             , _rmPmnts  = [mntLS iShape (V2 x x) (V3 (x-20) (x-20) 70)]
             , _rmBound  = map (expandPolyCorners 10) ps

src/Dodge/Room/CheckConsistency.hs

@@ -6,7 +6,7 @@ import Dodge.Graph
 linksOnPath :: Room -> Bool
 linksOnPath r = all pointOnPath linkPoints
   where
-    linkPoints = map fst $ _rmLinks r
+    linkPoints = map fst $ _rmOutLinks r ++ _rmInLinks r
     pointOnPath p = elem p $ concatMap flat2 $ _rmPath r
     flat2 (x,y) = [x,y]
 

src/Dodge/Room/Corridor.hs

@@ -16,7 +16,8 @@ import Data.Bifunctor
 corridor :: Room
 corridor = defaultRoom
     { _rmPolys = [poly]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
     , _rmPmnts    = [ spanLightI (V2 0 40) (V2 40 40) ]
     , _rmBound = [ rectNSWE 50 30 0 40 ]
@@ -47,7 +48,8 @@ corridorN :: Room
 corridorN = defaultRoom
     { _rmPolys = [rectNSWE 80 0 0 40
                  ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = pth
     , _rmPmnts    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
@@ -60,7 +62,8 @@ corridorWallN :: Room
 corridorWallN = defaultRoom
     { _rmPolys = [rectNSWE 70 0 0 40
                  ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = pth
     , _rmPmnts    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
@@ -75,7 +78,8 @@ tEast = defaultRoom
     { _rmPolys = [rectNSWE 80 0  (-20) 20
                  ,rectNSWE 80 40 (-40) 40
                  ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
     , _rmPmnts    = []
     , _rmBound = [ rectNSWE 70 10 0 40 ]
@@ -91,7 +95,8 @@ tWest = defaultRoom
     { _rmPolys = [rectNSWE 80 0  (-20) 20
                  ,rectNSWE 80 40 (-40) 40
                  ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
     , _rmPmnts    = []
     , _rmBound = [ rectNSWE 70 10 0 40 ]

src/Dodge/Room/Door.hs

@@ -15,7 +15,8 @@ import Control.Lens
 door :: Room
 door = defaultRoom
     { _rmPolys = [rectNSWE 40 0 0 40]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = [(V2 20 35,V2 20 5)]
 -- door extends into side walls (for shadows as rendered 12/03)
     , _rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)]
@@ -29,7 +30,8 @@ door = defaultRoom
 switchDoorRoom :: Room
 switchDoorRoom = defaultRoom
     { _rmPolys = [rectNSWE 40 0 0 40]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = [(V2 20 35,V2 20 5)]
     , _rmPartPmnt = Just f
 -- door extends into side walls (for shadows as rendered 12/03)

src/Dodge/Room/Link.hs

@@ -33,56 +33,60 @@ import Data.List
 {- Shuffle the initial links of a room randomly. -}
 randomiseOutLinks :: RandomGen g => Room -> State g Room
 randomiseOutLinks r = do
-    newLinks <- shuffle $ init $ _rmLinks r
+    newLinks <- shuffle $ _rmOutLinks r
-    return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}
+    return $ r {_rmOutLinks = newLinks }
 
 sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room
-sortOutLinksOn f = rmLinks %~ dosort
+sortOutLinksOn f = rmOutLinks %~ sortOn f
-  where
-    dosort [] = []
-    dosort xs = sortOn f (init xs) ++ [last xs]
 
 filterSortOutLinksOn :: Ord b => ((Point2,Float) -> Bool) -> ((Point2,Float) -> b) -> Room -> Room
-filterSortOutLinksOn test f = rmLinks %~ dosort
+filterSortOutLinksOn test f = rmOutLinks %~ dosort
   where
     dosort [] = []
-    dosort xs = let (ys,zs) = partition test (init xs)
+    dosort xs = let (ys,zs) = partition test xs
-        in sortOn f ys ++ zs ++ [last xs]
+        in sortOn f ys ++ zs
 
 {- Shuffle all links of a room randomly. -}
 randomiseAllLinks :: RandomGen g => Room -> State g Room
 randomiseAllLinks r = do
-    newLinks <- shuffle $ _rmLinks r
+    newLinks <- shuffle $ _rmOutLinks r ++ _rmInLinks r
-    return $ r {_rmLinks = newLinks}
+    return $ r {_rmOutLinks = tail newLinks
+        , _rmInLinks = [head newLinks]
+        }
 
 randomiseLinksBy 
     :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
     -> Room
     -> State g Room
 randomiseLinksBy f r = do
-    newLinks <- f $ _rmLinks r
+    newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
-    return $ r {_rmLinks = newLinks}
+    return $ r {_rmOutLinks = init newLinks
+                , _rmInLinks = [last newLinks]
+                }
 
+-- TODO rename to filterOutLinks
 filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 filterLinks cond r = do
-    newLinks <- shuffle $ filter cond $ init $ _rmLinks r
+    newLinks <- shuffle $ filter cond $ _rmOutLinks r
-    return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}
+    return $ r {_rmOutLinks = newLinks}
 {- | Swaps the first link in the list with one that satisfies a given property.
  - Does not change the last link in the list -}
 changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkFrom cond r = do
-    let (possibleLnks,otherLnks) = partition cond . init $ _rmLinks r
+    let (possibleLnks,otherLnks) = partition cond $ _rmOutLinks r
     newLnks <- shuffle possibleLnks
-    return $ r {_rmLinks = newLnks ++ otherLnks ++ [last $ _rmLinks r]}
+    return $ r {_rmOutLinks = newLnks ++ otherLnks}
 {- | Swaps the last link in the list with one that satisfies a given
  - property (it might swap with itself). Unsafe. 
  - Be careful about calling this after changeLinkFrom. -}
 changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkTo cond r = do
-    l <- takeOne $ filter cond $ _rmLinks r
+    let alllinks = _rmOutLinks r ++ _rmInLinks r
-    let newLinks = delete l (_rmLinks r) ++ [l]
+    l <- takeOne $ filter cond alllinks
-    return $ r {_rmLinks = newLinks}
+    let newLinks = delete l alllinks
-{- | Move a room so that the last link in '_rmLinks' lines up to 
+    return $ r { _rmOutLinks = newLinks
+        ,_rmInLinks = [l]}
+{- | Move a room so that the first link in '_rmInLinks' lines up to 
 an external point and direction.
 This is intended to work when the external point is an outgoing link from another room.
 -}
@@ -93,7 +97,7 @@ shiftRoomToLink l r
     $ shiftRoomBy (V2 0 0 -.- p , 0) 
     r
   where 
-    (p,a) = last $ _rmLinks r
+    (p,a) = head $ _rmInLinks r
 doRoomShift :: Room -> Room
 doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
 
@@ -101,7 +105,8 @@ doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
 shiftRoomBy :: (Point2,Float) -> Room -> Room
 shiftRoomBy shift r = r
     & rmPolys %~ fmap (map (shiftPointBy shift))
-    & rmLinks %~ fmap (shiftLinkBy shift)
+    & rmOutLinks %~ fmap (shiftLinkBy shift)
+    & rmInLinks %~ fmap (shiftLinkBy shift)
     & rmPath  %~ map (shiftPathBy shift)
     & rmBound %~ fmap (map (shiftPointBy shift))
     & rmShift %~ shiftLinkBy shift
@@ -118,7 +123,7 @@ shiftRoomShiftToLink l r
     $ shiftRoomShiftBy (V2 0 0 -.- p , 0) 
     r
   where 
-    (p,a) = last $ _rmLinks r
+    (p,a) = head $ _rmInLinks r
 -- NOTE placements, when placed, will be shifted by the value _rmShift
 shiftRoomShiftBy :: (Point2,Float) -> Room -> Room
 shiftRoomShiftBy shift r = r
@@ -137,10 +142,12 @@ shiftPathBy
 shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
 
 finalLinksUpdate :: Room -> Room
-finalLinksUpdate rm = case _rmLinks rm of
+finalLinksUpdate rm = case _rmInLinks rm of
     (_:_) -> rm
-        & rmLinks %~ init
+        & rmInLinks %~ tail
-        & rmPos %~ ( (uncurry UsedInLink (last thelnks) :) . (map (uncurry UnusedLink) (init thelnks) ++) )
+        & rmPos %~ ( (uncurry UsedInLink (head inlnks) :) 
+                    . (map (uncurry UnusedLink) (outlnks ++ tail inlnks) ++) )
     _ -> rm
   where
-    thelnks = _rmLinks rm
+    inlnks = _rmInLinks rm
+    outlnks = _rmOutLinks rm

src/Dodge/Room/LongDoor.hs

@@ -32,11 +32,10 @@ twinSlowDoorRoom
     -> Room
 twinSlowDoorRoom w h x = defaultRoom
     { _rmPolys  = ps
-    , _rmLinks  =
+    , _rmOutLinks  =
         [ (V2 w (h/2) , negate $ pi/2)
-        , (V2 (-w) (h/2) , pi/2)
+        , (V2 (-w) (h/2) , pi/2) ]
-        , (V2 0 (-h), pi)
+    , _rmInLinks = [ (V2 0 (-h), pi) ]
-        ]
     , _rmPath   = []
     , _rmPmnts     = 
         [ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)

src/Dodge/Room/NoNeedWeapon.hs

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

src/Dodge/Room/Path.hs

@@ -18,7 +18,7 @@ import qualified Control.Foldl as L
 
 createPathGrid :: Room -> Room
 createPathGrid rm = rm
-    { _rmPath = linksAndPath (_rmLinks rm) filterGrid }
+    { _rmPath = linksAndPath (_rmOutLinks rm ++ _rmInLinks rm) filterGrid }
   where
     filterGrid = filter (\p -> pairInPolys (_rmPolys rm) p && testCrossWalls outerWalls p) grid
     grid = fromMaybe [] $ shiftedGrid <$> minx <*> maxx <*> miny <*> maxy

src/Dodge/Room/Procedural.hs

@@ -46,7 +46,8 @@ roomRect
     -> Room
 roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = concatMap doublePair pth
     , _rmPmnts    = []
     , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
@@ -78,11 +79,13 @@ roomRectAutoLinks x y = (roomRect x y xn yn)
     yn = max 1 $ (ceiling y - 40) `div` 60
     plmnts = [mntLightLnkCond unusedLnkToPS ]
 {- Combines two rooms into one room.
+ - will have to work out exactly what to do with combining links
 Mostly involves concatenation.  -}
 combineRooms :: Room -> Room -> Room
 combineRooms r r' = defaultRoom
     { _rmPolys = _rmPolys r ++ _rmPolys r'
-    , _rmLinks = _rmLinks r ++ _rmLinks r'
+    , _rmOutLinks = _rmOutLinks r ++ _rmOutLinks r'
+    , _rmInLinks = _rmInLinks r ++ _rmInLinks r'
     , _rmPath  = map clampPath $ _rmPath  r 
               ++ _rmPath  r'
     , _rmPmnts    = map (shiftPlacement $ _rmShift r)  (_rmPmnts r) 
@@ -119,7 +122,8 @@ quarterRoomFlat w = do
         ]
     pure $ defaultRoom
         { _rmPolys  = [ [V2 0 0,V2 w w,V2 (-w) w] ]
-        , _rmLinks  = [(V2 0 w, 0)]
+        , _rmOutLinks  = [(V2 0 w, 0)]
+        , _rmInLinks  = [(V2 0 w, 0)]
         , _rmPath   = concatMap doublePair
             [(V2 0 w,V2 0 (w-20))
             ,(V2 0 (w-20),V2 (w-20) (w-20))
@@ -153,7 +157,11 @@ fourthCornerWall w = do
         ]
     pure $ defaultRoom
         { _rmPolys  = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
-        , _rmLinks  = 
+        , _rmOutLinks  = 
+            [(V2 (w/2) (3*w/2), negate $ pi/4)
+            ,(V2 (negate $ w/2) (3*w/2), pi/4)
+            ]
+        , _rmInLinks  = 
             [(V2 (w/2) (3*w/2), negate $ pi/4)
             ,(V2 (negate $ w/2) (3*w/2), pi/4)
             ]
@@ -216,11 +224,11 @@ centerVaultRoom
 centerVaultRoom w h d = do
     return $ defaultRoom
         { _rmPolys  = [rectNSWE h (-h) (-w) w]
-        , _rmLinks  = 
+        , _rmOutLinks  = 
             [(V2 0    h  , 0   )
             ,(V2 w    0  ,-pi/2)
-            ,(V2 (-w) 0  , pi/2)
+            ,(V2 (-w) 0  , pi/2) ]
-            ,(V2 0   (-h), pi  )
+        , _rmInLinks = [(V2 0   (-h), pi  )
             ]
         , _rmPath   = []
         , _rmPmnts     = 

src/Dodge/Room/RoadBlock.hs

@@ -31,9 +31,8 @@ litCorridor90 = do
         poly2 = rectNSWE (h-60) (h-100) (-60) 5
     pure $ defaultRoom
         { _rmPolys = [poly,poly2]
-        , _rmLinks = [ (V2 40 (h - 80), -pi/2)
+        , _rmOutLinks = [ (V2 40 (h - 80), -pi/2)]
-                     , (V2 20       0 , pi   )
+        , _rmInLinks = [ (V2 20       0 , pi   ) ]
-                     ]
         , _rmPath  = concatMap doublePair 
             [( V2  20   0     , V2 20 (h-40) )
             ,( V2   0  (h-40) , V2 20 (h-40) )
@@ -95,7 +94,8 @@ lasTunnel :: Room
 lasTunnel = defaultRoom
     { _rmPolys  = polys
     , _rmBound  = polys
-    , _rmLinks  = [(V2 20 190,1.5* pi),(V2 0 20,0.5* pi)]
+    , _rmOutLinks  = [(V2 20 190,1.5* pi)]
+    , _rmInLinks = [(V2 0 20,0.5* pi)]
     , _rmPmnts     = [putLasTurret 0.005 & plSpot .~ PS (V2 10 240) (1.5*pi)
         , midWall (rectNSEW 65 40 0 25)
         , mntLS vShape (V2 50 10) (V3 40 20 50)

src/Dodge/Room/Room.hs

@@ -48,11 +48,13 @@ roomC w h = do
 roomPadCut :: [Point2] -> Point2 -> Room
 roomPadCut ps p = defaultRoom
     { _rmPolys = [ps]
-    , _rmLinks = [(p,0),(V2 0 0,pi)]
+    , _rmOutLinks = [(p,0)]
+    , _rmInLinks = [(V2 0 0,pi)]
     , _rmPath  = [(V2 0 0,p)]
     }
 roomPillars :: Room
-roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2
+roomPillars = --over rmLinks init $ -- it is unclear to me the purpose of this: perhaps to get the in link in the center?
+    set rmPmnts plmnts $ roomRect 240 240 2 2
   where 
     plmnts = spanLightI (V2 120 24) (V2 120 216) 
         : mntLS vShape (V2 12 12) (V3 25 25 70)
@@ -199,7 +201,8 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst)
 roomOctogon :: Room
 roomOctogon = defaultRoom
     { _rmPolys = [poly ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = allPairs $ map fst lnks -- this is too much
     , _rmPmnts = []
     , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
@@ -221,7 +224,8 @@ roomOctogon = defaultRoom
 roomNgon :: Int -> Float -> Room
 roomNgon n x = defaultRoom
     { _rmPolys = [poly]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = [] -- TODO
     , _rmPmnts = []
     , _rmBound = [poly]
@@ -301,7 +305,7 @@ weaponBehindPillar  = do
     rcp <- roomCenterPillar
     return $ treeFromTrunk 
       [PassDown corridor
-      ,PassDown $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
+      ,PassDown $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp
       ]
       (singleUseAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
 
@@ -343,7 +347,8 @@ deadEndRoom :: Room
 deadEndRoom = defaultRoom
     { _rmPolys = [rectNSWE 40 (-20) (-20) 20
                  ]
-    , _rmLinks = lnks
+    , _rmOutLinks = init lnks
+    , _rmInLinks = [last lnks]
     , _rmPath  = []
     , _rmPmnts    = [sPS (V2 0 (-10)) 0 putLamp]
     , _rmBound = [rectNSWE 20 (-20) (-30) 30]

src/Dodge/Room/RunPast.hs

@@ -70,7 +70,7 @@ runPastRoom i = do
             ,_rmPmnts = []
             }
         switchdoor = switchDoorRoom & rmTakeFrom ?~ i
-        n = length $ filter theedgetest $ _rmLinks cenroom
+        n = length $ filter theedgetest $ _rmOutLinks cenroom
         controom = treeFromPost [PassDown switchdoor,PassDown linkcor] (UseAll door)
         critrooms :: [SubCompTree Room]
         critrooms = treeFromPost [PassDown switchdoor] (PassDown critroom) : 

src/Dodge/Room/Start.hs

@@ -5,6 +5,7 @@ import Dodge.Room.RunPast
 import Dodge.Room.LasTurret
 import Dodge.Data
 import Dodge.Default
+import Dodge.RoomLink
 import Dodge.Tree
 import Dodge.RandomHelp
 import Dodge.Room.Door
@@ -98,7 +99,7 @@ rezColor = do
         }
 
 rezInvBox :: LightSource -> Room
-rezInvBox = (rmLinks %~ reverse) . rezBox
+rezInvBox = swapInOutLinks . rezBox
 
 crAdd :: Room -> Room
 crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :)
@@ -134,7 +135,7 @@ rezBoxesWpCrit = do
     centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$>
             (randomiseOutLinks =<< changeLinkTo bottomPassDownTest 
                     ((roomRectAutoLinks w h) {_rmPmnts = []}))
-    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
+    let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom
     i <- state $ randomR (0,n-3)
     j <- state $ randomR (i,n-2)
     blcor <- blockedCorridor'
@@ -161,7 +162,7 @@ rezBoxesWp = do
     centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
         ((roomRectAutoLinks w h) {_rmPmnts = []})
     blcor <- blockedCorridor'
-    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
+    let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom
     let rezrooms = map adddoor 
             $ wpAdd theweapon aroom : replicate (n-2) aroom
     centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
@@ -182,7 +183,7 @@ rezBoxes = do
         dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
     centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
         ((roomRectAutoLinks w h) {_rmPmnts = []})
-    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
+    let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom
     centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
     return $ treeFromTrunk [PassDown $ rezBox thecol
         , PassDown door

src/Dodge/Room/Treasure.hs

@@ -25,7 +25,8 @@ triLootRoom w h = pure $ defaultRoom
     { _rmPolys  = [ tri
                   , base
                   ]
-    , _rmLinks  = [(V2 0 (-80) , pi)]
+    , _rmOutLinks = []
+    , _rmInLinks  = [(V2 0 (-80) , pi)]
     , _rmPath   = doublePair (V2 0 (-80) , V2 0 (h/2))
     , _rmPmnts     =
         [sPS (V2 (15-w)    15 )  0 $ PutID 0

src/Dodge/Tree/Shift.hs

@@ -34,7 +34,7 @@ posRms bounds (parent,_) _ [] st = case st of
         -> fmap (finalLinksUpdate parent:) <$> posRms bounds childi 0 ts tseq
 posRms bounds parenti numChild (t@(Node childi _):ts) tseq = do
     printInfo parenti numChild childi
-    tryLinks (0::Int) (init $ _rmLinks parent)
+    tryLinks (0::Int) (_rmOutLinks parent)
   where
     parent = fst parenti
     tryLinks _ [] = putStrLn "all links tried" >> return Nothing
@@ -53,7 +53,7 @@ posRms bounds parenti numChild (t@(Node childi _):ts) tseq = do
       where
         convexBounds = map pointsToPoly $ _rmBound r'
         clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
-        upr rm = doLnkEff l $ rm & rmLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) l :)
+        upr rm = doLnkEff l $ rm & rmOutLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) l :)
         l' = shiftLinkBy (_rmShift parent) l
         r' = doRoomShift . fst $ rootLabel shiftedt
         shiftedt = applyToRoot (first $ shiftRoomShiftToLink l') t