Attempt to stop reuse of link placement spots

src/Dodge/LevelGen.hs

@@ -4,8 +4,9 @@
 module Dodge.LevelGen 
     ( shiftPlacement
     , shiftPointBy
-    , placeSpot
+--    , placeSpot
     , invShiftPointBy
+    , placeSpot'
     ) where
 import Dodge.Data
 import Dodge.LevelGen.Block
@@ -25,6 +26,40 @@ import Color
 import Control.Monad.State
 import Control.Lens
 import qualified Data.IntSet as IS
+import Data.List (delete)
+
+placeSpot' :: (World,Room) -> Placement -> (World,Room)
+placeSpot' (w,rm) plmnt = case plmnt of
+    Placement{_placementSpot = PSRoomRand i}
+        -> let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
+           in placeSpot' (w & randGen .~ g,rm) (plmnt & placementSpot .~ uncurry PS ps)
+    Placement{_placementSpot = PSLnk{}} -> case lnks of
+        (lnk:_) -> placeSpot' (w & randGen .~ g,uselnk lnk) (updatePS (f lnk) plmnt)
+        [] -> case fallback of
+            Nothing -> (w,rm)
+            Just plmnt' -> placeSpot' (w,rm) plmnt'
+      where
+        uselnk lnk = rm & rmLinks %~ delete lnk
+        rps = _placementSpot plmnt
+        fallback = _psFallback rps
+        test = _psLinkTest rps
+        (lnks,g) = runState (shuffle $ filter test $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) 
+            $ _randGen w
+        f x (PSLnk t s _)
+            | t x = uncurry PS $ s x
+        f _ ps = ps
+        invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
+        invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot)
+    Placement{} ->
+        let (i,w') = placeSpotID (shiftPSBy shift (_placementSpot plmnt)) (_psType plmnt) w
+        in (maybe w' (curry (placeSpot w') rm) (_idPlacement plmnt i) , rm)
+    PlacementUsingPos p subpl -> placeSpot' (w,rm) (subpl (shiftPoint3By shift p))
+    RandomPlacement rplmnt -> placeSpot' (w & randGen .~ g,rm) plmnt'
+      where
+        (plmnt', g) = runState rplmnt (_randGen w)
+  where
+    shift = _rmShift rm
+
 
 -- potential failure cases: randomising using an already set link position
 -- others?
@@ -49,11 +84,12 @@ placeSpot w (rm, RandomPlacement rplmnt) = placeSpot (w & randGen .~ g) (rm, plm
 -- this should be woven into placeSpot
 assignPSToLnk :: Room -> Placement -> World -> World
 assignPSToLnk rm plmnt w = case lnks of
-    (lnk:_) -> placeSpot (w & randGen .~ g) (rm, updatePS (f lnk) plmnt)
+    (lnk:_) -> placeSpot (w & randGen .~ g) (uselnk lnk, updatePS (f lnk) plmnt)
     [] -> case fallback of
         Nothing -> w
         Just plmnt' -> placeSpot w (rm,plmnt')
   where
+    uselnk lnk = rm & rmLinks %~ delete lnk
     rps = _placementSpot plmnt
     fallback = _psFallback rps
     test = _psLinkTest rps