Define room link datatypes

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
 

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

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

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

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'

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