Allow for ordering of in placements, not fully tested yet

src/Dodge/Data/GenWorld.hs

@@ -107,7 +107,7 @@ data Room = Room
     , _rmPos :: [RoomPos]
     , _rmPath :: S.Set (Point2, Point2)
     , _rmPmnts :: [Placement]
-    , _rmInPmnt :: [GenWorld -> Placement]
+    , _rmInPmnt :: [(Int,GenWorld -> Placement)]
     , _rmBound :: [[Point2]]
     , _rmFloor :: Floor
     , _rmName :: String

src/Dodge/Layout.hs

@@ -1,9 +1,10 @@
---{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections #-}
 module Dodge.Layout (
     generateLevelFromRoomList,
     tilesFromRooms,
 ) where
 
+import Data.List (sortOn)
 import Dodge.Path.Translate
 import qualified Control.Foldl as L
 import Control.Lens
@@ -13,7 +14,7 @@ import Data.Graph.Inductive (labEdges, labNodes)
 import Data.List (nubBy)
 import Data.Maybe
 import Data.Tile
-import Data.Traversable
+--import Data.Traversable
 import Dodge.Data.GenWorld
 import Dodge.Default.Wall
 import Dodge.GameRoom
@@ -79,26 +80,24 @@ shuffleRoomPos rm = do
     return $ rm & rmPos .~ newPos
 
 doInPlacements :: GenWorld -> GenWorld
-doInPlacements w =
-    let (gw, rms) = mapAccumR doRoomInPlacements w (_genRooms w)
-     in gw & genRooms .~ rms
-
-doRoomInPlacements :: GenWorld -> Room -> (GenWorld, Room)
-doRoomInPlacements w rm = foldr f (w, rm) $ _rmInPmnt rm
+doInPlacements w = foldl' (\gw (i,(_,f)) -> placeSpot' i gw (f gw)) w
+    . sortOn fst
+    $ foldMap g $ w ^. genRooms
   where
-    f plf (w', r') =  placeSpot (w', r') (plf w')
+    g rm = (rm^?! rmMID . _Just,) <$> (rm ^. rmInPmnt)
+--    let (gw, rms) = mapAccumR doRoomInPlacements w (_genRooms w)
+--     in gw & genRooms .~ rms
+
+--doRoomInPlacements :: GenWorld -> Room -> (GenWorld, Room)
+--doRoomInPlacements w rm = foldr f (w, rm) $ _rmInPmnt rm
+--  where
+--    f plf (w', r') =  placeSpot (w', r') (plf w')
 
 doIndividualPlacements :: GenWorld -> GenWorld
-doIndividualPlacements gw = foldl' doRoomPlacements' gw (_genRooms gw)
---    let (gw', rms) = mapAccumR doRoomPlacements gw (_genRooms gw)
---     in gw' & genRooms .~ rms
+doIndividualPlacements gw = foldl' doRoomPlacements gw (_genRooms gw)
 
-doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
-doRoomPlacements w rm = foldl' placeSpot (w, rm & rmPmnts .~ mempty) 
-    $ _rmPmnts rm
-
-doRoomPlacements' :: GenWorld -> Room -> GenWorld
-doRoomPlacements' w rm = foldl' (placeSpot' i) (w & genRooms . ix i . rmPmnts .~ mempty) 
+doRoomPlacements :: GenWorld -> Room -> GenWorld
+doRoomPlacements w rm = foldl' (placeSpot' i) (w & genRooms . ix i . rmPmnts .~ mempty) 
     $ _rmPmnts rm
   where
     i = rm ^?! rmMID . _Just

src/Dodge/Room/Airlock.hs

@@ -42,7 +42,7 @@ decontamRoom i =
                ]
 --        & rmOutPmnt . at i ?~ 
 --               analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
-        & rmInPmnt .~ [f]
+        & rmInPmnt .~ [(0,f)]
         & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
   where
     f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do

src/Dodge/Room/Door.hs

@@ -34,7 +34,7 @@ triggerDoorRoom i =
         { _rmPolys = [rectNSWE 40 0 0 40]
         , _rmLinks = [uncurry outLink (V2 20 35, 0), uncurry inLink (V2 20 5, pi)]
         , _rmPath = doublePairSet (V2 20 35, V2 20 5)
-        , _rmInPmnt = [f]
+        , _rmInPmnt = [(0,f)]
         , _rmName = "triggerDoorRoom"
         -- door extends into side walls (for shadows as rendered 12/03/21)
         -- note no bounds

src/Dodge/Room/Tutorial.hs

@@ -80,7 +80,7 @@ tutDrop = do
     return $
         tToBTree "TutDrop" $
             treePost
-                [x & rmInPmnt .:~ t j, y, cleatOnward rm]
+                [x & rmInPmnt .:~ (0,t j), y, cleatOnward rm]
   where
     t j = \ gw -> let x = gw ^? genInts . ix j
         in putMessageTerminal
@@ -112,7 +112,7 @@ tutRooms is = do
     x <-
         shuffleLinks 
             . analyserByDoorWithPrompt sensorTut (RequireEquipment (AMMOMAG DRUMMAG)) i
-            . (rmInPmnt .:~ a)
+            . (rmInPmnt .:~ (0,a))
             =<< addDoorAtNthLinkToggleTerminal 1 ss j
             <$> roomNgon 6 100
     bcor <- blockedCorridor
@@ -125,7 +125,7 @@ tutRooms is = do
                 [ treeFromPost [triggerDoorRoom i] r1
                 , treeFromPost [triggerDoorRoom j] r2
                 , bcor
---                , treeFromPost [triggerDoorRoom k] r2
+                , treeFromPost [triggerDoorRoom k] r2
                 ]
   where
     ss =