Successfully stop reuse of link placement spots

src/Dodge/Layout.hs

@@ -41,8 +41,6 @@ generateLevelFromRoomList :: State StdGen [Room] -> World -> World
 generateLevelFromRoomList gr w 
     = initWallZoning 
     . setupWorldBounds
-    -- . flip (foldr $ flip placeSpot) plmnts
-    -- . flip (foldl' placeSpot) plmnts
     . flip (foldl' doRoomPlacements) rs
     $ w { _walls        = wallsFromRooms rs
         , _floorTiles   = floorsFromRooms rs
@@ -53,12 +51,11 @@ generateLevelFromRoomList gr w
   where
     path = pairsToGraph dist pairPath
     pairPath = concatMap _rmPath rs
-    plmnts = concatMap (\rm -> map (rm,) (_rmPS rm)) rs
     rs = zipWith addTile zs . evalState gr $ _randGen w
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
 
 doRoomPlacements :: World -> Room -> World
-doRoomPlacements w rm = fst $ foldl' placeSpot' (w,rm) $ _rmPS rm
+doRoomPlacements w rm = fst $ foldl' placeSpot (w,rm) $ _rmPS rm
 
 updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot
 updatePSLnkUsing pf PSLnk{_psLinkShift=f} = uncurry PS $ f pf

src/Dodge/LevelGen.hs

@@ -4,9 +4,8 @@
 module Dodge.LevelGen 
     ( shiftPlacement
     , shiftPointBy
---    , placeSpot
     , invShiftPointBy
-    , placeSpot'
+    , placeSpot
     ) where
 import Dodge.Data
 import Dodge.LevelGen.Block
@@ -26,25 +25,24 @@ 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 :: (World,Room) -> Placement -> (World,Room)
-placeSpot' (w,rm) plmnt = case plmnt of
+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)
+           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)
+        ((lnki,lnk):_) -> placeSpot (w & randGen .~ g,uselnk lnki) (updatePS (f lnk) plmnt)
         [] -> case fallback of
             Nothing -> (w,rm)
-            Just plmnt' -> placeSpot' (w,rm) plmnt'
+            Just plmnt' -> placeSpot (w,rm) plmnt'
       where
-        uselnk lnk = rm & rmLinks %~ delete lnk
+        uselnk lnki = rm & rmLinks %~ deletei lnki
         rps = _placementSpot plmnt
         fallback = _psFallback rps
         test = _psLinkTest rps
-        (lnks,g) = runState (shuffle $ filter test $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) 
+        (lnks,g) = runState (shuffle $ filter (test . snd) $ zip [0..] 
-            $ _randGen w
+            $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) $ _randGen w
         f x (PSLnk t s _)
             | t x = uncurry PS $ s x
         f _ ps = ps
@@ -52,54 +50,16 @@ placeSpot' (w,rm) plmnt = case plmnt of
         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)
+        in maybe (w',rm) (placeSpot (w',rm)) (_idPlacement plmnt i)
-    PlacementUsingPos p subpl -> placeSpot' (w,rm) (subpl (shiftPoint3By shift p))
+    PlacementUsingPos p subpl -> placeSpot (w,rm) (subpl (shiftPoint3By shift p))
-    RandomPlacement rplmnt -> placeSpot' (w & randGen .~ g,rm) plmnt'
+    RandomPlacement rplmnt -> placeSpot (w & randGen .~ g,rm) plmnt'
       where
         (plmnt', g) = runState rplmnt (_randGen w)
   where
     shift = _rmShift rm
 
-
+deletei :: Int -> [a] -> [a]
--- potential failure cases: randomising using an already set link position
+deletei i xs = take i xs ++ drop (i+1) xs
--- others?
-placeSpot :: World -> (Room , Placement) -> World
-placeSpot w (rm, plmnt@Placement{_placementSpot=PSRoomRand i}) =
-    let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
-    in placeSpot (w & randGen .~ g) (rm, plmnt & placementSpot .~ uncurry PS ps)
-placeSpot w (rm, plmnt@Placement{_placementSpot=PSLnk{}}) 
-    = assignPSToLnk rm plmnt w
-placeSpot w (rm, plmnt@Placement{}) =
-    let (i,w') = placeSpotID (shiftPSBy shift (_placementSpot plmnt)) (_psType plmnt) w
-    in maybe w' (curry (placeSpot w') rm) (_idPlacement plmnt i)
-  where
-    shift = _rmShift rm
-placeSpot w (rm, PlacementUsingPos p subpl) = placeSpot w (rm, subpl (shiftPoint3By shift p))
-  where
-    shift = _rmShift rm
-placeSpot w (rm, RandomPlacement rplmnt) = placeSpot (w & randGen .~ g) (rm, plmnt)
-  where
-    (plmnt, g) = runState rplmnt (_randGen w)
-
--- this should be woven into placeSpot
-assignPSToLnk :: Room -> Placement -> World -> World
-assignPSToLnk rm plmnt w = case lnks of
-    (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
-    (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)
 
 shiftPlacement :: (Point2,Float) -> Placement -> Placement
 shiftPlacement shift (Placement ps pt f) = Placement (shiftPSBy shift ps) pt