From 1f2d767d5e3991a52a2a1eeff93ed3cd0712cd65 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Tue, 23 Nov 2021 20:45:39 +0000
Subject: [PATCH] Move to using RoomLink datatype

---
 src/Dodge/Debug/LinkDecoration.hs  |  3 +-
 src/Dodge/LevelGen/Data.hs         | 28 ++++++++-------
 src/Dodge/Room/Airlock.hs          | 21 +++++------
 src/Dodge/Room/Boss.hs             | 17 ++++-----
 src/Dodge/Room/CheckConsistency.hs |  3 +-
 src/Dodge/Room/Corridor.hs         | 58 ++++++++++++++++++------------
 src/Dodge/Room/Door.hs             |  9 ++---
 src/Dodge/Room/Link.hs             | 54 +++++++++++++++-------------
 src/Dodge/Room/LongDoor.hs         |  5 +--
 src/Dodge/Room/NoNeedWeapon.hs     |  3 +-
 src/Dodge/Room/Path.hs             |  7 +++-
 src/Dodge/Room/Procedural.hs       | 26 +++++++-------
 src/Dodge/Room/RoadBlock.hs        |  9 ++---
 src/Dodge/Room/Room.hs             | 17 ++++-----
 src/Dodge/Room/RunPast.hs          |  3 +-
 src/Dodge/Room/Start.hs            |  7 ++--
 src/Dodge/Room/Treasure.hs         |  3 +-
 src/Dodge/Tree/Shift.hs            |  9 ++---
 18 files changed, 160 insertions(+), 122 deletions(-)

diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs
index 71970ec7a..f6f4617b9 100644
--- a/src/Dodge/Debug/LinkDecoration.hs
+++ b/src/Dodge/Debug/LinkDecoration.hs
@@ -3,6 +3,7 @@ module Dodge.Debug.LinkDecoration
     , addRoomPolyDecorations
     ) where
 import Dodge.Data
+import Dodge.RoomLink
 --import Dodge.Base
 import Dodge.LevelGen.Data
 import Dodge.Picture.Layer
@@ -22,7 +23,7 @@ addRoomLinkDecorations rms w = w & decorations %~
     IM.insertWithNewKeys (map roomLinkDecorations rms)
 
 roomLinkDecorations :: Room -> Picture
-roomLinkDecorations rm = pictures . map linkDecoration $ _rmOutLinks rm ++ _rmInLinks rm
+roomLinkDecorations rm = pictures . map linkDecoration $ map lnkPosDir $ _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)]
diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs
index c9ffe6d14..a0e597f9a 100644
--- a/src/Dodge/LevelGen/Data.hs
+++ b/src/Dodge/LevelGen/Data.hs
@@ -7,6 +7,7 @@ import Geometry
 import Shape.Data
 import Data.Tile
 
+import qualified Data.Set as S
 import Control.Lens
 import Control.Monad.State
 import System.Random
@@ -62,29 +63,29 @@ Room bounds between a new room and previously placed rooms are checked during le
 assigning no bounds will allow rooms to overlap.
  -}
 data Room = Room
-    { _rmPolys  :: [ [Point2] ]
-    , _rmOutLinks  :: [(Point2,Float)] 
-    , _rmInLinks :: [(Point2,Float)]
+    { _rmPolys      :: [ [Point2] ]
+    , _rmOutLinks   :: [RoomLink] 
+    , _rmInLinks    :: [RoomLink]
         -- 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]
-    , _rmPath   :: [(Point2, Point2)]
-    , _rmPmnts  :: [Placement]
+    , _rmLinkEff    :: [(Point2,Float) -> Room -> Room]
+    , _rmPos        :: [RoomPos]
+    , _rmPath       :: [(Point2, Point2)]
+    , _rmPmnts      :: [Placement]
     , _rmPartPmnt   :: Maybe ([Placement] -> Placement)
     , _rmExtPmnt    :: Maybe Placement
-    , _rmBound  :: [ [Point2] ]
-    , _rmFloor  :: [Tile]
-    , _rmName   :: String
-    , _rmShift  :: (Point2, Float)
+    , _rmBound      :: [ [Point2] ]
+    , _rmFloor      :: [Tile]
+    , _rmName       :: String
+    , _rmShift      :: (Point2, Float)
     , _rmViewpoints :: [Point2]
-    , _rmRandPSs :: [State StdGen (Point2,Float)]
+    , _rmRandPSs    :: [State StdGen (Point2,Float)]
     , _rmLabel      :: Maybe Int
     , _rmTakeFrom   :: Maybe Int
     , _rmStartWires :: IM.IntMap RoomWire
     , _rmEndWires   :: IM.IntMap RoomWire
     }
 data RoomLink = RoomLink
-    { _rlType   :: RoomLinkType
+    { _rlType   :: S.Set RoomLinkType
     , _rlPos    :: Point2
     , _rlDir    :: Float
     } deriving (Eq,Ord)
@@ -109,6 +110,7 @@ makeLenses ''Room
 makeLenses ''PSType
 makeLenses ''PlacementSpot
 makeLenses ''Placement
+makeLenses ''RoomLink
 
 spNoID :: PlacementSpot -> PSType -> Placement
 spNoID ps pst = Placement ps pst Nothing (const Nothing)
diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs
index b4441dfe0..a7526b02b 100644
--- a/src/Dodge/Room/Airlock.hs
+++ b/src/Dodge/Room/Airlock.hs
@@ -3,6 +3,7 @@
 module Dodge.Room.Airlock where
 import Dodge.Placement.Instance
 import Dodge.Room.Foreground
+import Dodge.RoomLink
 import Dodge.Default.Room
 import Dodge.Default.Wall
 import Dodge.Data
@@ -23,8 +24,8 @@ airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ]
 airlock0 :: Room
 airlock0 = defaultRoom
     { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ]
-    , _rmOutLinks = init lnks
-    , _rmInLinks  = [last lnks]
+    , _rmOutLinks = muout lnks
+    , _rmInLinks  = muin [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)
@@ -46,8 +47,8 @@ airlockSimple :: Room
 airlockSimple = defaultRoom
     { _rmPolys =
         [ rectNSWE 120 0 0 180 ]
-    , _rmOutLinks = init lnks
-    , _rmInLinks  = [last lnks]
+    , _rmOutLinks = map (uncurry outLink) $init lnks
+    , _rmInLinks  = [uncurry inLink $ last lnks]
     , _rmPath  = concatMap (doublePair. (V2 90 30,) . fst) lnks
     , _rmPmnts = 
         [pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
@@ -70,8 +71,8 @@ airlockZ :: Room
 airlockZ = defaultRoom
     { _rmPolys =
         [ rectNSWE 120 0 0 180 ]
-    , _rmOutLinks = [(V2 0 30,pi/2)]
-    , _rmInLinks = [(V2 180 30,1.5*pi) ]
+    , _rmOutLinks = muout[(V2 0 30,pi/2)]
+    , _rmInLinks = muin[(V2 180 30,1.5*pi) ]
     , _rmPath  = []
 --         [(V2 0 40,V2 40 0)
 --         ,(V2 40 0,V2 0 40)
@@ -108,8 +109,8 @@ airlock90 = defaultRoom
             , (100,10)
             ]
         ]
-    , _rmOutLinks = [(V2 0 40,pi/2)]
-    , _rmInLinks = [(V2 40 0,pi) ]
+    , _rmOutLinks = muout[(V2 0 40,pi/2)]
+    , _rmInLinks = muin[(V2 40 0,pi) ]
     , _rmPath  = 
          [(V2 0 40,V2 40 0)
          ,(V2 40 0,V2 0 40)
@@ -141,8 +142,8 @@ airlockCrystal = defaultRoom
         [ rectNSWE 140 0 0 40
         , orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
         ]
-    , _rmOutLinks = [(V2 20 130,0) ]
-    , _rmInLinks = [(V2 20  0 ,pi) ]
+    , _rmOutLinks = muout[(V2 20 130,0) ]
+    , _rmInLinks = muin[(V2 20  0 ,pi) ]
     , _rmPath  = [ ]
     , _rmPmnts    = 
         [pContID (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id)
diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs
index 5744c5f21..d4b188a6b 100644
--- a/src/Dodge/Room/Boss.hs
+++ b/src/Dodge/Room/Boss.hs
@@ -2,6 +2,7 @@
 module Dodge.Room.Boss
   where
 import Dodge.Data
+import Dodge.RoomLink
 import Dodge.Default.Room
 import Dodge.Placement.Instance
 import Dodge.LevelGen.Data
@@ -29,8 +30,8 @@ roomGlassOctogon x = createPathGrid $ defaultRoom
         [rectNSWE x (-x) (-x) x
         ,rectNSWE 0 (-(x + 40)) (-20) 20
         ]
-    , _rmOutLinks = init lnks
-    , _rmInLinks = [last lnks]
+    , _rmOutLinks = map (uncurry outLink) $ init lnks
+    , _rmInLinks = [uncurry inLink $ last lnks]
     , _rmPath  = linksAndPath lnks  
         [ ( V2 0 x        , V2 0 (-(x+40)))
         , ( V2 0 (-(x+40)), V2 0 x)
@@ -85,7 +86,7 @@ roomCross x y = defaultRoom
     { _rmPolys = [rectNSWE y (-y) (-x) x
                  ,rectNSWE (-x) x y (-y)
                  ]
-    , _rmOutLinks = 
+    , _rmOutLinks = map (uncurry outLink)
         [(V2  x  (y-20),negate $ pi/2)
         ,(V2  x  (20-y),negate $ pi/2)
         ,(V2 (20-y)  x ,0)
@@ -93,7 +94,7 @@ roomCross x y = defaultRoom
         ,(V2 (-x) (y-20),pi/2)
         ,(V2 (-x) (20-y),pi/2)
         ,(V2 (20-y) (-x),pi) ]
-    , _rmInLinks = [(V2 (y-20) (-x),pi)
+    , _rmInLinks = [uncurry inLink $ (V2 (y-20) (-x),pi)
         ]
     , _rmPath  = []
     , _rmPmnts = 
@@ -120,8 +121,8 @@ roomShuriken x y =
             ]   ]
         corner = defaultRoom
             { _rmPolys  = ps
-            , _rmOutLinks  = [(V2 (x-1) (y-20),negate $ pi/2)]
-            , _rmInLinks  = [(V2 (x-1) (y-20),negate $ pi/2)]
+            , _rmOutLinks  = [uncurry outLink (V2 (x-1) (y-20),negate $ pi/2)]
+            , _rmInLinks  = [uncurry inLink (V2 (x-1) (y-20),negate $ pi/2)]
             , _rmPath   = []
             , _rmPmnts  = [mntLS iShape (V2 x x) (V3 (x-20) x 70)]
             , _rmBound  = ps
@@ -146,8 +147,8 @@ roomTwistCross x y z =
             ]
         corner = defaultRoom
             { _rmPolys  = ps
-            , _rmOutLinks  = [(V2 z (y-20), pi/2)]
-            , _rmInLinks  = [(V2 z (y-20), pi/2)]
+            , _rmOutLinks  = [toBothLnk (V2 z (y-20), pi/2)]
+            , _rmInLinks  = [toBothLnk (V2 z (y-20), pi/2)]
             , _rmPath   = []
             , _rmPmnts  = [mntLS iShape (V2 x x) (V3 (x-20) (x-20) 70)]
             , _rmBound  = map (expandPolyCorners 10) ps
diff --git a/src/Dodge/Room/CheckConsistency.hs b/src/Dodge/Room/CheckConsistency.hs
index bae7f9f22..d73081911 100644
--- a/src/Dodge/Room/CheckConsistency.hs
+++ b/src/Dodge/Room/CheckConsistency.hs
@@ -2,11 +2,12 @@ module Dodge.Room.CheckConsistency
   where
 import Dodge.LevelGen.Data
 import Dodge.Graph
+import Dodge.RoomLink
 
 linksOnPath :: Room -> Bool
 linksOnPath r = all pointOnPath linkPoints
   where
-    linkPoints = map fst $ _rmOutLinks r ++ _rmInLinks r
+    linkPoints = map (fst . lnkPosDir) $ _rmOutLinks r ++ _rmInLinks r
     pointOnPath p = elem p $ concatMap flat2 $ _rmPath r
     flat2 (x,y) = [x,y]
 
diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs
index a985e3c4c..006227a41 100644
--- a/src/Dodge/Room/Corridor.hs
+++ b/src/Dodge/Room/Corridor.hs
@@ -1,6 +1,7 @@
 module Dodge.Room.Corridor
     where
 import Dodge.LevelGen.Data
+import Dodge.RoomLink
 --import Dodge.Room.Foreground
 import Dodge.Default.Room
 --import Dodge.LevelGen.Data
@@ -16,8 +17,8 @@ import Data.Bifunctor
 corridor :: Room
 corridor = defaultRoom
     { _rmPolys = [poly]
-    , _rmOutLinks = init lnks
-    , _rmInLinks = [last 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 ]
@@ -27,11 +28,17 @@ corridor = defaultRoom
     }
   where 
     poly = rectNSWE 80 0 0 40
-    lnks = map (first toV2)
-        [((20,70)  ,0)
-        ,((20,70), pi/6)
-        ,((20,70), negate $ pi/6)
-        ,((20,10)    ,pi)
+    lnks' =
+        [uncurry outLink ((V2 20 70)  ,0)
+        ,uncurry outLink ((V2 20 70), pi/6)
+        ,uncurry outLink ((V2 20 70), negate $ pi/6)
+        ,uncurry inLink ((V2 20 10)    ,pi)
+        ]
+    lnks =
+        [ ((V2 20 70)  ,0)
+        , ((V2 20 70), pi/6)
+        , ((V2 20 70), negate $ pi/6)
+        ,((V2 20 10)    ,pi)
         ]
 keyholeCorridor :: Room
 keyholeCorridor = corridor
@@ -54,8 +61,8 @@ corridorN = defaultRoom
     , _rmPmnts    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     }
-    where lnks = [(V2 20 70  ,0)
-                 ,(V2 20 10  ,pi)
+    where lnks = [uncurry outLink (V2 20 70  ,0)
+                 ,uncurry inLink (V2 20 10  ,pi)
                  ]
           pth = doublePair (V2 20 70,V2 20 10)
 corridorWallN :: Room
@@ -68,8 +75,8 @@ corridorWallN = defaultRoom
     , _rmPmnts    = []
     , _rmBound = [ rectNSWE 50 30 0 40 ]
     }
-    where lnks = [(V2 20 70  ,0)
-                 ,(V2 20 10  ,pi)
+    where lnks = [uncurry outLink(V2 20 70  ,0)
+                 ,uncurry inLink(V2 20 10  ,pi)
                  ]
           pth = doublePair (V2 20 70,V2 20 10)
 
@@ -78,32 +85,37 @@ tEast = defaultRoom
     { _rmPolys = [rectNSWE 80 0  (-20) 20
                  ,rectNSWE 80 40 (-40) 40
                  ]
-    , _rmOutLinks = init lnks
-    , _rmInLinks = [last lnks]
+    , _rmOutLinks = init lnks'
+    , _rmInLinks = [last lnks']
     , _rmPath  = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
     , _rmPmnts    = []
     , _rmBound = [ rectNSWE 70 10 0 40 ]
     }
   where 
-    lnks = map (first toV2) 
-        [(( 30,60),-pi/2)
-        ,((-30,60),pi/2)
-        ,((0,10),pi)
+    lnks =
+        [(V2 ( 30) (60),-pi/2)
+        ,(V2 (-30) (60),pi/2)
+        ,((V2 0 10),pi)
+        ]
+    lnks' =
+        [uncurry outLink(V2 ( 30) (60),-pi/2)
+        ,uncurry outLink(V2 (-30) (60),pi/2)
+        ,uncurry inLink((V2 0 10),pi)
         ]
 tWest :: Room
 tWest = defaultRoom
     { _rmPolys = [rectNSWE 80 0  (-20) 20
                  ,rectNSWE 80 40 (-40) 40
                  ]
-    , _rmOutLinks = init lnks
-    , _rmInLinks = [last lnks]
+    , _rmOutLinks = map (uncurry outLink) $ init lnks
+    , _rmInLinks = [uncurry inLink $ last lnks]
     , _rmPath  = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
     , _rmPmnts    = []
     , _rmBound = [ rectNSWE 70 10 0 40 ]
     }
   where 
-    lnks = map (first toV2)
-        [((-30,60),pi/2)
-        ,(( 30,60),-pi/2)
-        ,((0,10),pi)
+    lnks =
+        [(V2 (-30) (60),pi/2)
+        ,(V2 ( 30) (60),-pi/2)
+        ,(V2 (0) (10),pi)
         ]
diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs
index a64aacec2..d42d20d3d 100644
--- a/src/Dodge/Room/Door.hs
+++ b/src/Dodge/Room/Door.hs
@@ -2,6 +2,7 @@
 module Dodge.Room.Door
     where
 import Geometry
+import Dodge.RoomLink
 import Dodge.Data
 import Dodge.Default.Room
 import Dodge.Placement.Instance
@@ -23,8 +24,8 @@ door = defaultRoom
 -- note no bounds
     }
   where 
-    lnks = [(V2 20 35,0)
-        ,(V2 20  5,pi)
+    lnks = [uncurry outLink (V2 20 35,0)
+        ,uncurry inLink (V2 20  5,pi)
         ]
 
 switchDoorRoom :: Room
@@ -38,8 +39,8 @@ switchDoorRoom = defaultRoom
 -- note no bounds
     }
   where 
-    lnks = [(V2 20 35,0)
-        ,(V2 20  5,pi)
+    lnks = [uncurry outLink (V2 20 35,0)
+        ,uncurry inLink(V2 20  5,pi)
         ]
     f (pmnt:_) = putDoubleDoor False red (cond pmnt) (V2 0 20) (V2 40 20) 2
     f _ = error "tried to put a door using an empty placement list"
diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs
index 583dd9d1e..3e1b94020 100644
--- a/src/Dodge/Room/Link.hs
+++ b/src/Dodge/Room/Link.hs
@@ -17,7 +17,7 @@ module Dodge.Room.Link
     , changeLinkTo
     , changeLinkFrom
     , randomiseOutLinks
-    , randomiseLinksBy
+--    , randomiseLinksBy
     , invShiftLinkBy
     , finalLinksUpdate
     ) where
@@ -26,6 +26,7 @@ import Dodge.LevelGen.Data
 import Dodge.RandomHelp
 import Geometry
 import Data.Tile
+import Dodge.RoomLink
 
 import System.Random
 import Control.Monad.State
@@ -38,14 +39,14 @@ randomiseOutLinks r = do
     return $ r {_rmOutLinks = newLinks }
 
 sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room
-sortOutLinksOn f = rmOutLinks %~ sortOn f
+sortOutLinksOn f = overLnkType OutLink $ sortOn (f . lnkPosDir)
 
 filterSortOutLinksOn :: Ord b => ((Point2,Float) -> Bool) -> ((Point2,Float) -> b) -> Room -> Room
-filterSortOutLinksOn test f = rmOutLinks %~ dosort
+filterSortOutLinksOn test f = overLnkType OutLink dosort
   where
     dosort [] = []
-    dosort xs = let (ys,zs) = partition test xs
-        in sortOn f ys ++ zs
+    dosort xs = let (ys,zs) = partition (test . lnkPosDir) xs
+        in sortOn (f . lnkPosDir) ys ++ zs
 
 {- Shuffle all links of a room randomly. -}
 randomiseAllLinks :: RandomGen g => Room -> State g Room
@@ -55,26 +56,26 @@ randomiseAllLinks r = do
         , _rmInLinks = [head newLinks]
         }
 
-randomiseLinksBy 
-    :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
-    -> Room
-    -> State g Room
-randomiseLinksBy f r = do
-    newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
-    return $ r {_rmOutLinks = init newLinks
-                , _rmInLinks = [last newLinks]
-                }
+--randomiseLinksBy 
+--    :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
+--    -> Room
+--    -> State g Room
+--randomiseLinksBy f r = do
+--    newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
+--    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 $ _rmOutLinks r
+    newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmOutLinks 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 $ _rmOutLinks r
+    let (possibleLnks,otherLnks) = partition (cond . lnkPosDir) $ _rmOutLinks r
     newLnks <- shuffle possibleLnks
     return $ r {_rmOutLinks = newLnks ++ otherLnks}
 {- | Swaps the last link in the list with one that satisfies a given
@@ -83,7 +84,7 @@ changeLinkFrom cond r = do
 changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
 changeLinkTo cond r = do
     let alllinks = _rmOutLinks r ++ _rmInLinks r
-    l <- takeOne $ filter cond alllinks
+    l <- takeOne $ filter (cond . lnkPosDir) alllinks
     let newLinks = delete l alllinks
     return $ r { _rmOutLinks = newLinks
         ,_rmInLinks = [l]}
@@ -98,7 +99,7 @@ shiftRoomToLink l r
     $ shiftRoomBy (V2 0 0 -.- p , 0) 
     r
   where 
-    (p,a) = head $ _rmInLinks r
+    (p,a) = lnkPosDir $ head $ _rmInLinks r
 
 doRoomShift :: Room -> Room
 doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
@@ -111,7 +112,7 @@ shiftRoomBy shift r = r
     & rmInLinks %~ fmap (shiftLinkBy shift)
     & rmPath  %~ map (shiftPathBy shift)
     & rmBound %~ fmap (map (shiftPointBy shift))
-    & rmShift %~ shiftLinkBy shift
+    & rmShift %~ shiftPosDirBy shift
     & rmFloor %~ map 
         ( (tilePoly %~ map (shiftPointBy shift))
         . (tileZero %~ shiftPointBy shift    )
@@ -138,10 +139,15 @@ shiftRoomShiftToLink' l inlink r
 -- NOTE placements, when placed, will be shifted by the value _rmShift
 shiftRoomShiftBy :: (Point2,Float) -> Room -> Room
 shiftRoomShiftBy shift r = r
-    & rmShift %~ shiftLinkBy shift
+    & rmShift %~ shiftPosDirBy shift
 
-shiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
-shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
+shiftPosDirBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
+shiftPosDirBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
+
+shiftLinkBy :: (Point2,Float) -> RoomLink -> RoomLink
+shiftLinkBy (pos,rot) = overLnkPosDir f
+  where
+    f (p,r) = (shiftPointBy (pos,rot) p, r + rot)
 
 invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
 invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot)
@@ -156,8 +162,8 @@ finalLinksUpdate :: Room -> Room
 finalLinksUpdate rm = case _rmInLinks rm of
     (_:_) -> rm
         & rmInLinks %~ tail
-        & rmPos %~ ( (uncurry (UsedInLink 0) (head inlnks) :) 
-                    . (map (uncurry UnusedLink) (outlnks ++ tail inlnks) ++) )
+        & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir $ head inlnks) :) 
+                    . (map (uncurry UnusedLink . lnkPosDir) (outlnks ++ tail inlnks) ++) )
     _ -> rm
   where
     inlnks = _rmInLinks rm
diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs
index a8529012d..f087847ff 100644
--- a/src/Dodge/Room/LongDoor.hs
+++ b/src/Dodge/Room/LongDoor.hs
@@ -3,6 +3,7 @@
  -}
 module Dodge.Room.LongDoor where
 import Dodge.Data
+import Dodge.RoomLink
 import Dodge.Base
 import Dodge.Default.Room
 import Dodge.LevelGen.Data
@@ -32,10 +33,10 @@ twinSlowDoorRoom
     -> Room
 twinSlowDoorRoom w h x = defaultRoom
     { _rmPolys  = ps
-    , _rmOutLinks  =
+    , _rmOutLinks  = map (uncurry outLink)
         [ (V2 w (h/2) , negate $ pi/2)
         , (V2 (-w) (h/2) , pi/2) ]
-    , _rmInLinks = [ (V2 0 (-h), pi) ]
+    , _rmInLinks = [uncurry inLink (V2 0 (-h), pi) ]
     , _rmPath   = []
     , _rmPmnts     = 
         [ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
diff --git a/src/Dodge/Room/NoNeedWeapon.hs b/src/Dodge/Room/NoNeedWeapon.hs
index f1f40b3ef..aa4cad782 100644
--- a/src/Dodge/Room/NoNeedWeapon.hs
+++ b/src/Dodge/Room/NoNeedWeapon.hs
@@ -34,4 +34,5 @@ centerVaultExplosiveExit = do
             ,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
             ]
     r <- centerVaultRoom 120 120 50 <&> rmPmnts %~ (extraPS ++)
-    randomiseLinksBy shuffleTail r <&> rmOutLinks %~ take 2
+    --randomiseLinksBy shuffleTail r <&> rmOutLinks %~ take 2
+    return $ r & rmOutLinks %~ take 2
diff --git a/src/Dodge/Room/Path.hs b/src/Dodge/Room/Path.hs
index 2232d8675..480484c9b 100644
--- a/src/Dodge/Room/Path.hs
+++ b/src/Dodge/Room/Path.hs
@@ -1,12 +1,14 @@
 module Dodge.Room.Path
     ( gridPoints
     , linksAndPath
+    , linksAndPath'
     , makeGrid
     , createPathGrid
     )
     where
 import Dodge.LevelGen.Data
 import Dodge.LevelGen.StaticWalls
+import Dodge.RoomLink
 import Geometry
 
 import Data.Function (on)
@@ -18,7 +20,7 @@ import qualified Control.Foldl as L
 
 createPathGrid :: Room -> Room
 createPathGrid rm = rm
-    { _rmPath = linksAndPath (_rmOutLinks rm ++ _rmInLinks rm) filterGrid }
+    { _rmPath = linksAndPath (map lnkPosDir $ _rmOutLinks rm ++ _rmInLinks rm) filterGrid }
   where
     filterGrid = filter (\p -> pairInPolys (_rmPolys rm) p && testCrossWalls outerWalls p) grid
     grid = fromMaybe [] $ shiftedGrid <$> minx <*> maxx <*> miny <*> maxy
@@ -37,6 +39,9 @@ linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
   where 
     linkClosest (p,_) = doublePair (p, minimumBy (compare `on` dist p) $ map fst subpth)
 
+linksAndPath' :: [RoomLink] -> [(Point2,Point2)] -> [(Point2,Point2)]
+linksAndPath' = linksAndPath . map lnkPosDir
+
 testCrossWalls
     :: [(Point2,Point2)]
     -> (Point2,Point2)
diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs
index 3e5639513..88a98c027 100644
--- a/src/Dodge/Room/Procedural.hs
+++ b/src/Dodge/Room/Procedural.hs
@@ -13,6 +13,7 @@ import Dodge.Data
 import Dodge.Default.Wall
 import Dodge.PlacementSpot
 import Dodge.Placement.Instance
+import Dodge.RoomLink
 import Dodge.Item.Weapon.Utility
 import Dodge.Room.Link
 import Dodge.Room.Path
@@ -66,8 +67,8 @@ roomRect x y xn yn = defaultRoom
     wlnks = zip (map (+.+ V2 x 20) $ gridPoints  0  1      yd (yn+1))  (repeat (-pi/2)) 
     nlnks = zip (map (+.+ V2 20 y) $ gridPoints xd (xn+1)  0  1     )  (repeat      0 ) 
     slnks = zip (map (+.+ V2 20 0) $ gridPoints xd (xn+1)  0  1     )  (repeat     pi ) 
-    lnks = nlnks ++ elnks ++ wlnks ++ slnks
-    pth  = linksAndPath lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
+    lnks = map toBothLnk $ nlnks ++ elnks ++ wlnks ++ slnks
+    pth  = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
 {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.  -}
 -- it is not clear to me that this works for very small rooms (but it does seem
 -- to do so)
@@ -122,8 +123,8 @@ quarterRoomFlat w = do
         ]
     pure $ defaultRoom
         { _rmPolys  = [ [V2 0 0,V2 w w,V2 (-w) w] ]
-        , _rmOutLinks  = [(V2 0 w, 0)]
-        , _rmInLinks  = [(V2 0 w, 0)]
+        , _rmOutLinks  = [toBothLnk (V2 0 w, 0)]
+        , _rmInLinks  = [toBothLnk (V2 0 w, 0)]
         , _rmPath   = concatMap doublePair
             [(V2 0 w,V2 0 (w-20))
             ,(V2 0 (w-20),V2 (w-20) (w-20))
@@ -158,12 +159,12 @@ fourthCornerWall w = do
     pure $ defaultRoom
         { _rmPolys  = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
         , _rmOutLinks  = 
-            [(V2 (w/2) (3*w/2), negate $ pi/4)
-            ,(V2 (negate $ w/2) (3*w/2), pi/4)
+            [toBothLnk (V2 (w/2) (3*w/2), negate $ pi/4)
+            ,toBothLnk (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)
+            [toBothLnk (V2 (w/2) (3*w/2), negate $ pi/4)
+            ,toBothLnk (V2 (negate $ w/2) (3*w/2), pi/4)
             ]
         , _rmPath   = concatMap doublePair
             [(V2 (0.5*w) (1.5*w),V2 (0.5*w-20) (1.5*w-20))
@@ -225,11 +226,10 @@ centerVaultRoom w h d = do
     return $ defaultRoom
         { _rmPolys  = [rectNSWE h (-h) (-w) w]
         , _rmOutLinks  = 
-            [(V2 0    h  , 0   )
-            ,(V2 w    0  ,-pi/2)
-            ,(V2 (-w) 0  , pi/2) ]
-        , _rmInLinks = [(V2 0   (-h), pi  )
-            ]
+            [outLink (V2 0    h) 0   
+            ,outLink (V2 w    0) (-pi/2)
+            ,outLink (V2 (-w) 0) (pi/2) ]
+        , _rmInLinks = [inLink (V2 0   (-h)) pi ]
         , _rmPath   = []
         , _rmPmnts     = 
             [sps0 $ PutWall (rectNSEW   d  (d - 30)   d  (d - 30)) defaultWall
diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs
index 9f18c7430..b77b6d659 100644
--- a/src/Dodge/Room/RoadBlock.hs
+++ b/src/Dodge/Room/RoadBlock.hs
@@ -2,6 +2,7 @@
 module Dodge.Room.RoadBlock
     where
 import Dodge.Data
+import Dodge.RoomLink
 import Geometry
 import Dodge.Default.Room
 import Dodge.LevelGen.Data
@@ -31,8 +32,8 @@ litCorridor90 = do
         poly2 = rectNSWE (h-60) (h-100) (-60) 5
     pure $ defaultRoom
         { _rmPolys = [poly,poly2]
-        , _rmOutLinks = [ (V2 40 (h - 80), -pi/2)]
-        , _rmInLinks = [ (V2 20       0 , pi   ) ]
+        , _rmOutLinks = [uncurry outLink (V2 40 (h - 80), -pi/2)]
+        , _rmInLinks = [uncurry inLink (V2 20       0 , pi   ) ]
         , _rmPath  = concatMap doublePair 
             [( V2  20   0     , V2 20 (h-40) )
             ,( V2   0  (h-40) , V2 20 (h-40) )
@@ -94,8 +95,8 @@ lasTunnel :: Room
 lasTunnel = defaultRoom
     { _rmPolys  = polys
     , _rmBound  = polys
-    , _rmOutLinks  = [(V2 20 190,1.5* pi)]
-    , _rmInLinks = [(V2 0 20,0.5* pi)]
+    , _rmOutLinks  = [uncurry outLink(V2 20 190,1.5* pi)]
+    , _rmInLinks = [uncurry inLink(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)
diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs
index e119394ac..a3f94e943 100644
--- a/src/Dodge/Room/Room.hs
+++ b/src/Dodge/Room/Room.hs
@@ -1,5 +1,6 @@
 module Dodge.Room.Room where
 import Dodge.Data
+import Dodge.RoomLink
 import Dodge.Default.Room
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.Launcher
@@ -48,8 +49,8 @@ roomC w h = do
 roomPadCut :: [Point2] -> Point2 -> Room
 roomPadCut ps p = defaultRoom
     { _rmPolys = [ps]
-    , _rmOutLinks = [(p,0)]
-    , _rmInLinks = [(V2 0 0,pi)]
+    , _rmOutLinks = muout [(p,0)]
+    , _rmInLinks = muin [(V2 0 0,pi)]
     , _rmPath  = [(V2 0 0,p)]
     }
 roomPillars :: Room
@@ -201,8 +202,8 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst)
 roomOctogon :: Room
 roomOctogon = defaultRoom
     { _rmPolys = [poly ]
-    , _rmOutLinks = init lnks
-    , _rmInLinks = [last lnks]
+    , _rmOutLinks = muout $ init lnks
+    , _rmInLinks = muin [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)] ]
@@ -224,8 +225,8 @@ roomOctogon = defaultRoom
 roomNgon :: Int -> Float -> Room
 roomNgon n x = defaultRoom
     { _rmPolys = [poly]
-    , _rmOutLinks = init lnks
-    , _rmInLinks = [last lnks]
+    , _rmOutLinks = muout $init lnks
+    , _rmInLinks = muin[last lnks]
     , _rmPath  = [] -- TODO
     , _rmPmnts = []
     , _rmBound = [poly]
@@ -347,8 +348,8 @@ deadEndRoom :: Room
 deadEndRoom = defaultRoom
     { _rmPolys = [rectNSWE 40 (-20) (-20) 20
                  ]
-    , _rmOutLinks = init lnks
-    , _rmInLinks = [last lnks]
+    , _rmOutLinks = muout $init lnks
+    , _rmInLinks = muin $[last lnks]
     , _rmPath  = []
     , _rmPmnts    = [sPS (V2 0 (-10)) 0 putLamp]
     , _rmBound = [rectNSWE 20 (-20) (-30) 30]
diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs
index 67eadaed8..2d4aeb5c2 100644
--- a/src/Dodge/Room/RunPast.hs
+++ b/src/Dodge/Room/RunPast.hs
@@ -1,5 +1,6 @@
 module Dodge.Room.RunPast where
 import Dodge.LevelGen.Data
+import Dodge.RoomLink
 import Dodge.Data
 import Dodge.Default
 --import Dodge.Layout.Tree.Either
@@ -70,7 +71,7 @@ runPastRoom i = do
             ,_rmPmnts = []
             }
         switchdoor = switchDoorRoom & rmTakeFrom ?~ i
-        n = length $ filter theedgetest $ _rmOutLinks cenroom
+        n = length $ filter theedgetest $ map lnkPosDir $ _rmOutLinks cenroom
         controom = treeFromPost [PassDown switchdoor,PassDown linkcor] (UseAll door)
         critrooms :: [SubCompTree Room]
         critrooms = treeFromPost [PassDown switchdoor] (PassDown critroom) : 
diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs
index 59299b2bf..5a6d4e16f 100644
--- a/src/Dodge/Room/Start.hs
+++ b/src/Dodge/Room/Start.hs
@@ -2,6 +2,7 @@ module Dodge.Room.Start where
 import Dodge.LevelGen.Data
 --import Dodge.PlacementSpot
 import Dodge.Room.RunPast
+import Dodge.RoomLink
 import Dodge.Room.LasTurret
 import Dodge.Data
 import Dodge.Default
@@ -135,7 +136,7 @@ rezBoxesWpCrit = do
     centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$>
             (randomiseOutLinks =<< changeLinkTo bottomPassDownTest 
                     ((roomRectAutoLinks w h) {_rmPmnts = []}))
-    let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom
+    let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmOutLinks centralRoom
     i <- state $ randomR (0,n-3)
     j <- state $ randomR (i,n-2)
     blcor <- blockedCorridor'
@@ -162,7 +163,7 @@ rezBoxesWp = do
     centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
         ((roomRectAutoLinks w h) {_rmPmnts = []})
     blcor <- blockedCorridor'
-    let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom
+    let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmOutLinks centralRoom
     let rezrooms = map adddoor 
             $ wpAdd theweapon aroom : replicate (n-2) aroom
     centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
@@ -183,7 +184,7 @@ rezBoxes = do
         dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
     centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
         ((roomRectAutoLinks w h) {_rmPmnts = []})
-    let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom
+    let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmOutLinks centralRoom
     centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
     return $ treeFromTrunk [PassDown $ rezBox thecol
         , PassDown door
diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs
index a84b15c87..1fe45488a 100644
--- a/src/Dodge/Room/Treasure.hs
+++ b/src/Dodge/Room/Treasure.hs
@@ -5,6 +5,7 @@ Typically dead ends.
 module Dodge.Room.Treasure
     where
 import Dodge.Data
+import Dodge.RoomLink
 import Dodge.Placement.Instance
 import Dodge.Default.Room
 import Dodge.LevelGen.Data
@@ -26,7 +27,7 @@ triLootRoom w h = pure $ defaultRoom
                   , base
                   ]
     , _rmOutLinks = []
-    , _rmInLinks  = [(V2 0 (-80) , pi)]
+    , _rmInLinks  = [uncurry inLink(V2 0 (-80) , pi)]
     , _rmPath   = doublePair (V2 0 (-80) , V2 0 (h/2))
     , _rmPmnts     =
         [sPS (V2 (15-w)    15 )  0 $ PutID 0
diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs
index 6d0beb5d8..c14183583 100644
--- a/src/Dodge/Tree/Shift.hs
+++ b/src/Dodge/Tree/Shift.hs
@@ -7,6 +7,7 @@ module Dodge.Tree.Shift
 import Dodge.LevelGen.Data
 import Dodge.Room.Link
 import Dodge.Tree.Polymorphic
+import Dodge.RoomLink
 import Geometry.ConvexPoly
 import Geometry.Data
 import Padding
@@ -54,15 +55,15 @@ posRms bounds parenti@(parent,_) numChild (t@(Node childi _):ts) tseq = do
           where
             convexBounds = map pointsToPoly $ _rmBound r'
             clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
-            updateparent rm = doLnkEff l $ rm & rmOutLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) l :)
+            updateparent rm = doLnkEff (lnkPosDir l) $ rm & rmOutLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) (lnkPosDir l) :)
             l' = shiftLinkBy (_rmShift parent) l
             r' = doRoomShift . fst $ rootLabel shiftedt
             updatechild rm = rm & rmInLinks %~ delete il 
-                & rmPos %~ ( (uncurry (UsedInLink 0) il:)
-                    . (map (uncurry UnusedLink) (_rmOutLinks rm ++ newInLinks) ++) )
+                & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir il):)
+                    . (map (uncurry UnusedLink . lnkPosDir) (_rmOutLinks rm ++ newInLinks) ++) )
               where
                 newInLinks = delete il $ _rmInLinks rm
-            shiftedt = applyToRoot (first $ updatechild . shiftRoomShiftToLink' l' il) t
+            shiftedt = applyToRoot (first $ updatechild . shiftRoomShiftToLink' (lnkPosDir l') (lnkPosDir il)) t
 
 printColumns :: [Int] -> [String] -> IO ()
 printColumns (i:is) (s:strs) = putStr (rightPad i ' ' s) >> printColumns is strs