Move towards unifying RoomPos constructors

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)