Improve placementspots

src/Dodge/PlacementSpot.hs

@@ -8,6 +8,7 @@ module Dodge.PlacementSpot
     , anyUnusedSpot
     , unusedSpotAwayFromLink
     , isUnusedLnk
+    , isInLnk
     , unusedLnkToPS
     , unusedSpotNearInLink
     , randDirPS
@@ -20,6 +21,8 @@ module Dodge.PlacementSpot
     , setFallback
     , twoRoomPoss
     , isUnusedLinkType
+    , roomPosRoomBoolShift 
+    , shiftInBy
     ) where
 import Dodge.LevelGen.Data
 import Geometry
@@ -52,6 +55,17 @@ anyUnusedSpot = roomPosBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacement
 roomPosRoomBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
 roomPosRoomBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
 
+roomPosRoomBoolShift :: (RoomPos -> Room -> Bool) 
+    -> ((Point2,Float) -> (Point2,Float))
+    -> PlacementSpot
+roomPosRoomBoolShift t shift = PSPos f (const id) Nothing
+  where
+    f rp r
+        | t rp r    = Just (PS p a, rp & rpPlacementUse +~ 1)
+        | otherwise = Nothing
+      where
+        (p,a) = shift (_rpPos rp, _rpDir rp)
+
 unusedSpotAwayFromLink :: Float -> PlacementSpot
 unusedSpotAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink 
     && _rpPlacementUse rp == 0 
@@ -88,6 +102,11 @@ isUnusedLnk rp = case _rpLinkStatus rp of
     UnusedLink {} -> _rpPlacementUse rp == 0
     _ -> False
 
+isInLnk :: RoomPos -> Bool
+isInLnk rp = case _rpLinkStatus rp of
+    UsedInLink {} -> _rpPlacementUse rp == 0
+    _ -> False
+
 useUnusedLnk :: PlacementSpot
 useUnusedLnk = roomPosBool isUnusedLnk
 
@@ -99,19 +118,13 @@ isUsedLnkUnplaced  rp = case _rpLinkStatus rp of
 
 useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosCond t rp _
-    | t rp = Just (PS p a, rp & rpPlacementUse +~ 1)
+    | t rp = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
     | otherwise = Nothing
-  where
-    p = _rpPos rp
-    a = _rpDir rp
 
 useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosRoomCond t rp r
-    | t rp r = Just (PS p a, rp & rpPlacementUse +~ 1)
+    | t rp r = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
     | otherwise = Nothing
-  where
-    p = _rpPos rp
-    a = _rpDir rp
 
 unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 unusedLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
@@ -172,6 +185,9 @@ atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
   where
     f (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
 
+shiftInBy :: Float -> (Point2,Float) -> (Point2,Float)
+shiftInBy x (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
+
 --anyLnkInPS :: Float -- ^ amount to shift inward
 --    -> PlacementSpot
 --anyLnkInPS x = PSPos f (const id) Nothing