diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs
index d6da7cc72..2d96708fb 100644
--- a/src/Dodge/Layout.hs
+++ b/src/Dodge/Layout.hs
@@ -215,16 +215,16 @@ gameRoomFromRoom rm = GameRoom
         [p +.+ 10 *.* unitVectorAtAngle a
         ,p -.- 10 *.* unitVectorAtAngle a
         ]
-    filterUnusedLinks (UnusedLink p _ _) = Just p
+    filterUnusedLinks (UnusedLink p _ _ _) = Just p
     filterUnusedLinks _ = Nothing
-    filterUsedLinks (UsedOutLink _ _ p a _) = doubleShift p a
-    filterUsedLinks (UsedInLink  _ p a _) = doubleShift p a
+    filterUsedLinks (UsedOutLink _ _ p a _ _) = doubleShift p a
+    filterUsedLinks (UsedInLink  _ p a _ _) = doubleShift p a
     filterUsedLinks _ = []
-    undir (UsedOutLink _ _ _ a _) = Just $ 0.5*pi + a + snd (_rmShift rm)
-    undir (UsedInLink  _ _ a _) = Just $ 0.5*pi + a + snd (_rmShift rm)
+    undir (UsedOutLink _ _ _ a _ _) = Just $ 0.5*pi + a + snd (_rmShift rm)
+    undir (UsedInLink  _ _ a _ _) = Just $ 0.5*pi + a + snd (_rmShift rm)
     undir _ = Nothing
     closePoints x y = roundPoint2 x == roundPoint2 y
-    getDir (UsedInLink _ _ a _:_) = a  + snd (_rmShift rm)
+    getDir (UsedInLink _ _ a _ _:_) = a  + snd (_rmShift rm)
     getDir (_:xs) = getDir xs
     getDir _ = 0 -- fallback
 
diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs
index 2fc225cd4..ce003eb6f 100644
--- a/src/Dodge/LevelGen/Data.hs
+++ b/src/Dodge/LevelGen/Data.hs
@@ -116,39 +116,60 @@ data CardinalPoint
 data RoomWire
     = --RoomWire Point2 Float
      WallWire Point2 Float Float
+
+data RPLinkStatus
+    = UsedAsOutLink 
+        { _rplsType :: S.Set RoomLinkType 
+        , _rplsChildNum :: Int
+        , _rplsOutRoomID :: Int
+        }
+    | UsedAsInLink  
+        { _rplsType :: S.Set RoomLinkType 
+        , _rplsInRoomID :: Int
+        }
+    | UnusedAsLink  { _rplsType :: S.Set RoomLinkType }
+    | NotLink
+  deriving (Eq,Ord,Show)
+
 data RoomPos 
     = UsedOutLink 
-        {_rpChildNum  :: Int 
-        ,_rpOutRoomID :: Int
-        ,_rpPos :: Point2  
-        ,_rpDir :: Float
-        ,_rpLinkType :: S.Set RoomLinkType
+        { _rpChildNum  :: Int 
+        , _rpOutRoomID :: Int
+        , _rpPos :: Point2  
+        , _rpDir :: Float
+        , _rpLinkType :: S.Set RoomLinkType
+        , _rpLinkStatus :: RPLinkStatus
         }
     | UsedInLink 
-        {_rpInRoomID :: Int 
-        ,_rpPos :: Point2 
-        ,_rpDir :: Float
-        ,_rpLinkType :: S.Set RoomLinkType
+        { _rpInRoomID :: Int 
+        , _rpPos :: Point2 
+        , _rpDir :: Float
+        , _rpLinkType :: S.Set RoomLinkType
+        , _rpLinkStatus :: RPLinkStatus
         }
     | UnusedLink
-        {_rpPos :: Point2 
-        ,_rpDir ::Float
-        ,_rpLinkType :: S.Set RoomLinkType
+        { _rpPos :: Point2 
+        , _rpDir ::Float
+        , _rpLinkType :: S.Set RoomLinkType
+        , _rpLinkStatus :: RPLinkStatus
         }
     | UsedLink
-        {_rpPos :: Point2 
-        ,_rpDir :: Float
-        ,_rpLinkType :: S.Set RoomLinkType
+        { _rpPos :: Point2 
+        , _rpDir :: Float
+        , _rpLinkType :: S.Set RoomLinkType
+        , _rpLinkStatus :: RPLinkStatus
         }
     | UsedSpot
-        {_rpPos :: Point2 
-        ,_rpDir :: Float
-        ,_rpType :: S.Set RoomPosType
+        { _rpPos :: Point2 
+        , _rpDir :: Float
+        , _rpType :: S.Set RoomPosType
+        , _rpLinkStatus :: RPLinkStatus
         }
     | UnusedSpot
-        {_rpPos :: Point2 
-        ,_rpDir :: Float
-        ,_rpType :: S.Set RoomPosType
+        { _rpPos :: Point2 
+        , _rpDir :: Float
+        , _rpType :: S.Set RoomPosType
+        , _rpLinkStatus :: RPLinkStatus
         }
   deriving (Eq,Ord,Show)
 
@@ -165,6 +186,7 @@ makeLenses ''Placement
 makeLenses ''RoomLink
 makeLenses ''RoomPos
 makeLenses ''RoomPosType
+makeLenses ''RPLinkStatus
 
 spNoID :: PlacementSpot -> PSType -> Placement
 spNoID ps pst = Placement ps pst Nothing (const Nothing)
diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs
index b2854018d..fbcfd79d6 100644
--- a/src/Dodge/PlacementSpot.hs
+++ b/src/Dodge/PlacementSpot.hs
@@ -26,16 +26,16 @@ anyUnusedSpot :: PlacementSpot
 anyUnusedSpot = PSPos f (const id) Nothing
   where
     f rp _ = case rp of
-        UnusedSpot p a t -> Just (PS p a,UsedSpot p a t)
+        UnusedSpot p a t rpls -> Just (PS p a,UsedSpot p a t rpls)
         _ -> Nothing
 
 unusedSpotAwayFromLink :: Float -> PlacementSpot
 unusedSpotAwayFromLink x = PSPos f (const id) Nothing
   where
     f rp r = case rp of
-        UnusedSpot p a t
+        UnusedSpot p a t rpls
             | all ( (>x) . dist p ) (usedRoomLinkPoss r)
-                -> Just (PS p a,UsedSpot p a t)
+                -> Just (PS p a,UsedSpot p a t rpls)
         _       -> Nothing
 
 setFallback :: Placement -> Placement -> Placement
@@ -47,16 +47,17 @@ unusedOffPathAwayFromLink :: Float -> PlacementSpot
 unusedOffPathAwayFromLink x = PSPos f (const id) Nothing
   where
     f rp r = case rp of
-        UnusedSpot p a t
+        UnusedSpot p a t rpls
             | all ( (>x) . dist p ) (usedRoomLinkPoss r) && RoomPosOffPath `S.member` t
-                -> Just (PS p a,UsedSpot p a t)
+                -> Just (PS p a,UsedSpot p a t rpls)
         _       -> Nothing
 
 unusedSpotAwayFromInLink :: Float -> PlacementSpot
 unusedSpotAwayFromInLink x = PSPos f (const id) Nothing
   where
     f rp r = case rp of
-        UnusedSpot p a t | all ( (>x) . dist p ) (usedRoomInLinkPoss r) -> Just (PS p a,UsedSpot p a t)
+        UnusedSpot p a t rpls 
+            | all ( (>x) . dist p ) (usedRoomInLinkPoss r) -> Just (PS p a,UsedSpot p a t rpls)
         _ -> Nothing
 
 twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement)
@@ -82,7 +83,7 @@ useRoomPos cond = PSPos (useRoomPosCond cond) (const id) Nothing
 useRoomPosCond :: (RoomPos -> Bool)
     -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosCond t rp _
-    | t rp = Just (PS p a, UsedSpot p a (fromMaybe S.empty $ rp ^? rpType))
+    | t rp = Just (PS p a, UsedSpot p a (fromMaybe S.empty $ rp ^? rpType) NotLink)
     | otherwise = Nothing
   where
     p = _rpPos rp
@@ -93,6 +94,11 @@ unusedLnkToPS = useRoomPosCond $ \case
     UnusedLink {} -> True
     _ -> False
 
+usedInLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
+usedInLnkToPS = useRoomPosCond $ \case
+    UsedInLink {} -> True
+    _ -> False
+
 isUnusedLinkType :: RoomLinkType -> RoomPos -> Bool
 isUnusedLinkType rlt rp = case rp of
     UnusedLink{_rpLinkType = rlts} -> rlt `S.member` rlts
@@ -102,7 +108,8 @@ unusedSpotNearInLink :: Float -> PlacementSpot
 unusedSpotNearInLink x = PSPos f (const id) Nothing
   where
     f rp r = case rp of
-        UnusedSpot p a t | any ( (<x) . dist p ) (usedRoomInLinkPoss r) -> Just (PS p a,UsedSpot p a t)
+        UnusedSpot p a t rpls 
+            | any ( (<x) . dist p ) (usedRoomInLinkPoss r) -> Just (PS p a,UsedSpot p a t rpls)
         _ -> Nothing
 
 usedRoomInLinkPoss :: Room -> [Point2]
@@ -124,19 +131,19 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r
 anyLnkOutPS :: PlacementSpot
 anyLnkOutPS = PSPos f (const id) Nothing
   where
-    f (UnusedLink p a _) _ = Just (PS p a, UsedSpot p a S.empty)
+    f (UnusedLink p a _ rpls) _ = Just (PS p a, UsedSpot p a S.empty rpls)
     f _ _ = Nothing
     
 atFstLnkOut :: PlacementSpot
 atFstLnkOut = PSPos f (const id) Nothing
   where
-    f (UsedOutLink 0 i p a lt) _ = Just (PS p a, UsedOutLink 0 i p a lt)
+    f (UsedOutLink 0 i p a lt rpls) _ = Just (PS p a, UsedOutLink 0 i p a lt rpls)
     f _                     _ = Nothing
 
 atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
 atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
   where
-    f (UsedOutLink i rmid p a lt) _ | n == i = Just (PS p' a', UsedOutLink n rmid p a lt)
+    f (UsedOutLink i rmid p a lt rpls) _ | n == i = Just (PS p' a', UsedOutLink n rmid p a lt rpls)
       where
         (p',a') = theshift (p,a)
     f _ _ = Nothing
@@ -155,14 +162,14 @@ atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
 overFstLnkOut :: PlacementSpot
 overFstLnkOut = PSPos f (const id) Nothing
   where
-    f (UsedOutLink 0 _ p a lt) _ = Just (PS p a, UsedLink p a lt)
+    f (UsedOutLink 0 _ p a lt rpls) _ = Just (PS p a, UsedLink p a lt rpls)
     f _ _ = Nothing
 
 anyLnkInPS :: Float -- ^ amount to shift inward
     -> PlacementSpot
 anyLnkInPS x = PSPos f (const id) Nothing
   where
-    f (UnusedLink v a _) _ = Just (PS v' a' ,UsedSpot v' a' S.empty)
+    f (UnusedLink v a _ rpls) _ = Just (PS v' a' ,UsedSpot v' a' S.empty rpls)
       where
         v' = v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
         a' = a + pi
@@ -170,7 +177,7 @@ anyLnkInPS x = PSPos f (const id) Nothing
 
 useLnkRoomPos :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useLnkRoomPos rp _ = case rp of
-    (UnusedLink (V2 x y) a lt) -> Just (PS (V2 x y) a , UsedLink (V2 x y) a lt)
+    (UnusedLink (V2 x y) a lt rpls) -> Just (PS (V2 x y) a , UsedLink (V2 x y) a lt rpls)
     _ -> Nothing
 
 psRandRanges :: (Float,Float) -> (Float,Float) -> (Float,Float) -> State StdGen (Point2,Float)
diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs
index 69edfdbe5..eb2d25541 100644
--- a/src/Dodge/Room/LongDoor.hs
+++ b/src/Dodge/Room/LongDoor.hs
@@ -9,6 +9,7 @@ import Dodge.Tree
 import Dodge.Default.Room
 import Dodge.LevelGen.Data
 import Dodge.Placement.Instance
+import Dodge.PlacementSpot
 import Dodge.Room.Link
 import Dodge.Room.Door
 import Dodge.Room.Procedural
@@ -92,7 +93,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 & rmPmnts .~ pillars
+    return $ roomRectAutoLinks x y & rmPmnts .~ (pillars ++ [mntLightLnkCond usedInLnkToPS])
 
 addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
 addSouthPillars x h r = do
@@ -118,21 +119,21 @@ addButtonSlowDoor x h rm = do
     openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
     belowH y = (sndV2 . fst) y < h - 40
     aboveH y = (sndV2 . fst) y > h + 40
+    amountedlight dr xoff = Just . moveLSThen (getdoorpos (fromJust $ _plMID dr)) 
+                (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) . const . const
+    -- TODO make the height of this light source and of other mounted lights
+    -- be taken from a single consistent source
     butDoor _ _ = putLitButOnPos col butPosCond
         $  \btid -> Just $ putDoubleDoorThen False col (cond' btid) 30 (V2 0 h) (V2 x h) 2
-        $ \dr1 dr2 -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr1)) 
-                (V3 15 50 88) (aShape (V2 15 0) (V3 15 50 90))
-        $ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr2)) 
-                (V3 15 (-50) 88) (aShape (V2 15 0) (V3 15 (-50) 90))
-        $ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr2)) 
-                (V3 15 50 88) (aShape (V2 15 0) (V3 15 50 90))
-        $ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr1)) 
-                (V3 15 (-50) 88) (aShape (V2 15 0) (V3 15 (-50) 90))
-        $ \_ _ ->Nothing
+        $ \dr1 dr2 -> amountedlight dr1 50
+        $ amountedlight dr1 (-50)
+        $ amountedlight dr2   50
+        $ amountedlight dr2 (-50)
+        $ Nothing
     getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
         in (b, argV (a-.-b))
-    butPosCond (UnusedLink (V2 x' y') a' _) _ | y' < 0.5 * h 
-                = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink))
+    butPosCond (UnusedLink (V2 x' y') a' _ rpls) _ | y' < 0.5 * h 
+                = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink) rpls)
     butPosCond _ _ = Nothing
     --butPosCond _ = True -- y < h
     col = dim $ light red
diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs
index 60df1c808..58d67d64e 100644
--- a/src/Dodge/Room/Procedural.hs
+++ b/src/Dodge/Room/Procedural.hs
@@ -53,8 +53,8 @@ roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
     , _rmPath  = concatMap doublePair pth
-    , _rmPos   = map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOnPath) posps
-        ++ map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOffPath) interposps
+    , _rmPos   = map (\pd -> UnusedSpot pd 0 (S.singleton RoomPosOnPath) NotLink) posps
+        ++ map (\pd -> UnusedSpot pd 0 (S.singleton RoomPosOffPath) NotLink) interposps
     , _rmPmnts    = []
     , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
     , _rmFloor = Tiled [Tile 
@@ -147,8 +147,8 @@ quarterRoomTri w = do
             , sPS (V2 (w-15) (w-25)) pi PutNothing 
             ]
         , _rmPos = 
-            [ UnusedSpot (V2 (w-20) (w-20)) pi S.empty 
-            , UnusedSpot (V2 (w-15) (w-25)) pi S.empty 
+            [ UnusedSpot (V2 (w-20) (w-20)) pi S.empty NotLink
+            , UnusedSpot (V2 (w-15) (w-25)) pi S.empty NotLink
             ]
         , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
         }
@@ -188,8 +188,8 @@ quarterRoomSquare w = do
             , sPS (V2 20 (2*w-40)) pi PutNothing
             , sPS (V2 25 (2*w-45)) pi PutNothing
             ]
-        , _rmPos = [UnusedSpot (V2 20 (2*w-40)) pi S.empty
-                , UnusedSpot (V2 25 (2*w-45)) pi S.empty
+        , _rmPos = [UnusedSpot (V2 20 (2*w-40)) pi S.empty NotLink
+                , UnusedSpot (V2 25 (2*w-45)) pi S.empty NotLink
                 ]
         , _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
         }
diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs
index 8fda26bb5..370fa405f 100644
--- a/src/Dodge/Room/Room.hs
+++ b/src/Dodge/Room/Room.hs
@@ -83,7 +83,8 @@ glassSwitchBack = do
     hgt <- state $ randomR (400,600)
     wllen <- state $ randomR (60,wth/2-40)
     let hf = hgt/5
-        con1 cond (UnusedLink (V2 x y) a _) _ | cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a $ S.singleton RoomPosExLink)
+        con1 cond (UnusedLink (V2 x y) a _ rpls) _ 
+            | cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a (S.singleton RoomPosExLink) rpls)
         con1 _ _ _ = Nothing
         plmnts = 
             [ mntLightLnkCond $ con1 (< 0.5 * hgt)
diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs
index b67af804e..59f400360 100644
--- a/src/Dodge/Tree/Shift.hs
+++ b/src/Dodge/Tree/Shift.hs
@@ -73,6 +73,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
                     , _rpPos = fst (lnkPosDir outlnk)
                     , _rpDir = snd (lnkPosDir outlnk)
                     , _rpLinkType = _rlType outlnk
+                    , _rpLinkStatus = UsedAsOutLink (_rlType outlnk) numChild (snd childi)
                     }
                 & rmChildren .:~ snd childi
             shiftedoutlink = shiftLinkBy (_rmShift parent) outlnk
@@ -85,6 +86,7 @@ posRms bounds parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
                     , _rpPos = fst (lnkPosDir il)
                     , _rpDir = snd (lnkPosDir il)
                     , _rpLinkType = _rlType il
+                    , _rpLinkStatus = UsedAsInLink (_rlType il) 0
                     }
             shiftedt = applyToRoot
                 (first $ updatechild . shiftRoomShiftToLink (lnkPosDir shiftedoutlink) (lnkPosDir il)) 
@@ -97,6 +99,7 @@ createUnusedLinkPos rm = rm & rmPos .++~ map f (_rmLinks rm)
         { _rpPos = _rlPos rl
         , _rpDir = _rlDir rl
         , _rpLinkType = _rlType rl
+        , _rpLinkStatus = UnusedAsLink $ _rlType rl
         }
 
 zipCount :: [a] -> [(Int,a)]