From 67b0d694af0e4d836042d6f6fe49aa079bd835dd Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Tue, 23 Nov 2021 13:00:34 +0000
Subject: [PATCH] Define room link datatypes

---
 src/Dodge/Layout.hs        | 10 +++++-----
 src/Dodge/LevelGen/Data.hs | 15 +++++++++++++--
 src/Dodge/PlacementSpot.hs |  6 +++---
 src/Dodge/Room/Link.hs     |  2 +-
 src/Dodge/RoomPos.hs       |  4 ++--
 src/Dodge/Tree/Shift.hs    |  2 +-
 6 files changed, 25 insertions(+), 14 deletions(-)

diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs
index d90964383..8e606a7f3 100644
--- a/src/Dodge/Layout.hs
+++ b/src/Dodge/Layout.hs
@@ -168,14 +168,14 @@ gameRoomFromRoom rm = GameRoom
         [p +.+ 10 *.* unitVectorAtAngle a
         ,p -.- 10 *.* unitVectorAtAngle a
         ]
-    unpos (OutLink _ p a) = doubleShift p a
-    unpos (InLink    p a) = doubleShift p a
+    unpos (UsedOutLink _ p a) = doubleShift p a
+    unpos (UsedInLink    p a) = doubleShift p a
     unpos _ = []
-    undir (OutLink _ _ a) = Just $ 0.5*pi + a + snd (_rmShift rm)
-    undir (InLink    _ 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 (InLink _ 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 174c05b78..b0fadfad0 100644
--- a/src/Dodge/LevelGen/Data.hs
+++ b/src/Dodge/LevelGen/Data.hs
@@ -82,12 +82,23 @@ data Room = Room
     , _rmStartWires :: IM.IntMap RoomWire
     , _rmEndWires   :: IM.IntMap RoomWire
     }
+data RoomLink = RoomLink
+    { _rlType   :: RoomLinkType
+    , _rlPos    :: Point2
+    , _rlDir    :: Float
+    } deriving (Eq,Ord)
+data RoomLinkType
+    = OutLink
+    | InLink
+    | AnyLink
+    | LabLink Int
+    deriving (Eq,Ord)
 data RoomWire
     = --RoomWire Point2 Float
      WallWire Point2 Float Float
 data RoomPos 
-    = OutLink Int    Point2  Float
-    | InLink  Point2 Float
+    = UsedOutLink Int    Point2  Float
+    | UsedInLink  Point2 Float
     | UnusedLink Point2 Float
     | PosPl   Point2 Float
     | LabPos  Int    RoomPos
diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs
index 3b761353c..35cf2b5d4 100644
--- a/src/Dodge/PlacementSpot.hs
+++ b/src/Dodge/PlacementSpot.hs
@@ -15,13 +15,13 @@ anyLnkOutPS = PSPos f (const id) Nothing
 atFstLnkOut :: PlacementSpot
 atFstLnkOut = PSPos f (const id) Nothing
   where
-    f (OutLink 0 p a) = Just (PS p a, OutLink 0 p a)
+    f (UsedOutLink 0 p a) = Just (PS p a, UsedOutLink 0 p a)
     f _ = Nothing
 
 atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
 atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
   where
-    f (OutLink i p a) | n == i = Just (PS p' a', OutLink n p a)
+    f (UsedOutLink i p a) | n == i = Just (PS p' a', UsedOutLink n p a)
       where
         (p',a') = theshift (p,a)
     f _ = Nothing
@@ -40,7 +40,7 @@ atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
 overFstLnkOut :: PlacementSpot
 overFstLnkOut = PSPos f (const id) Nothing
   where
-    f (OutLink 0 p a) = Just (PS p a, PosPl p a)
+    f (UsedOutLink 0 p a) = Just (PS p a, PosPl p a)
     f _ = Nothing
 
 anyLnkInPS :: Float -- ^ amount to shift inward
diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs
index 07e225ed5..22991c614 100644
--- a/src/Dodge/Room/Link.hs
+++ b/src/Dodge/Room/Link.hs
@@ -140,7 +140,7 @@ finalLinksUpdate :: Room -> Room
 finalLinksUpdate rm = case _rmLinks rm of
     (_:_) -> rm
         & rmLinks %~ init
-        & rmPos %~ ( (uncurry InLink (last thelnks) :) . (map (uncurry UnusedLink) (init thelnks) ++) )
+        & rmPos %~ ( (uncurry UsedInLink (last thelnks) :) . (map (uncurry UnusedLink) (init thelnks) ++) )
     _ -> rm
   where
     thelnks = _rmLinks rm
diff --git a/src/Dodge/RoomPos.hs b/src/Dodge/RoomPos.hs
index 16ec2480c..49872a7fc 100644
--- a/src/Dodge/RoomPos.hs
+++ b/src/Dodge/RoomPos.hs
@@ -4,8 +4,8 @@ import Geometry
 
 extractRoomPos :: RoomPos -> (Point2,Float)
 extractRoomPos rp = case rp of
-    OutLink _  p a -> (p,a)
-    InLink     p a -> (p,a)
+    UsedOutLink _  p a -> (p,a)
+    UsedInLink     p a -> (p,a)
     UnusedLink p a -> (p,a)
     PosPl      p a -> (p,a)
     LabPos _ rp'   -> extractRoomPos rp'
diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs
index eed8fc96c..36a96ee8f 100644
--- a/src/Dodge/Tree/Shift.hs
+++ b/src/Dodge/Tree/Shift.hs
@@ -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 (OutLink numChild) l :)
+        upr rm = doLnkEff l $ rm & rmLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) l :)
         l' = shiftLinkBy (_rmShift parent) l
         r' = doRoomShift . fst $ rootLabel shiftedt
         shiftedt = applyToRoot (first $ shiftRoomShiftToLink l') t