Pass room id rather than room during placement

src/Dodge/Data/GenWorld.hs

@@ -58,7 +58,7 @@ data PSType
     | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
     | RandPS (State StdGen PSType)
     | PutForeground ForegroundShape
-    | PutWorldUpdate (Room -> PlacementSpot -> GenWorld -> GenWorld)
+    | PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
     | PutNothing
     | PutID {_putID :: Int}
     | PutChasm {_putChasmPoly :: [Point2]}

src/Dodge/Layout.hs

@@ -80,7 +80,7 @@ shuffleRoomPos rm = do
     return $ rm & rmPos .~ newPos
 
 doInPlacements :: GenWorld -> GenWorld
-doInPlacements w = foldl' (\gw (i,(_,f)) -> placeSpot' i gw (f gw)) w
+doInPlacements w = foldl' (\gw (i,(_,f)) -> placeSpot i gw (f gw)) w
     . sortOn (fst.snd)
     $ foldMap g $ w ^. genRooms
   where
@@ -97,15 +97,16 @@ doIndividualPlacements :: GenWorld -> GenWorld
 doIndividualPlacements gw = foldl' doRoomPlacements gw (_genRooms gw)
 
 doRoomPlacements :: GenWorld -> Room -> GenWorld
-doRoomPlacements w rm = foldl' (placeSpot' i) (w & genRooms . ix i . rmPmnts .~ mempty) 
+doRoomPlacements w rm = foldl' (placeSpot i) (w & genRooms . ix i . rmPmnts .~ mempty) 
     $ _rmPmnts rm
   where
     i = rm ^?! rmMID . _Just
 
-placeSpot' :: Int -> GenWorld -> Placement -> GenWorld
+--placeSpot' :: Int -> GenWorld -> Placement -> GenWorld
-placeSpot' i gw x = 
+--placeSpot' = placeSpot
-    let (gw',r') = placeSpot (gw,(gw ^?! genRooms . ix i)) x
+--placeSpot' i gw x = 
-    in gw' & genRooms . ix i .~ r'
+--    let (gw',r') = placeSpot (gw,(gw ^?! genRooms . ix i)) x
+--    in gw' & genRooms . ix i .~ r'
 
 setupWorldBounds :: World -> World
 setupWorldBounds w =

src/Dodge/Placement/PlaceSpot.hs

@@ -28,64 +28,65 @@ import System.Random
 -- when placing a placement, we update the world and the room and assign an id
 -- to the placement. This id should be associated with the type of placement and
 -- match up with the created id for the object (creature id, flitid id, etc)
-placeSpot :: (GenWorld, Room) -> Placement -> (GenWorld, Room)
+placeSpot :: Int -> GenWorld -> Placement -> GenWorld
-placeSpot (w, rm) plmnt = case plmnt of
+--placeSpot :: (GenWorld, Room) -> Placement -> (GenWorld, Room)
-    Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
+placeSpot rid w plmnt = case plmnt of
+    Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rid i f plmnt w
     Placement{_plSpot = PSPos extract eff fallback} ->
-        placeSpotUsingLink w rm plmnt extract eff fallback
+        placeSpotUsingLink w rid plmnt extract eff fallback
-    Placement{} -> placePlainPSSpot w rm plmnt shift
+    Placement{} -> placePlainPSSpot w rid plmnt shift
   where
-    shift = _rmShift rm
+    shift = _rmShift $ w ^?! genRooms . ix rid
 
 placePlainPSSpot 
-    :: GenWorld -> Room -> Placement -> DPoint2 -> (GenWorld, Room)
+    :: GenWorld -> Int -> Placement -> DPoint2 -> GenWorld
-placePlainPSSpot w rm plmnt shift =
+placePlainPSSpot w rid plmnt shift =
-    let (i, w') = placeSpotID rm (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
+    let (i, w') = placeSpotID rid (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
         newplmnt = plmnt & plMID ?~ i
-        (gw,rm') = maybe (w', rm & rmPmnts .:~ newplmnt) 
+        gw = maybe (w' & genRooms . ix rid . rmPmnts .:~ newplmnt) 
             (recrPlace newplmnt w') (_plIDCont plmnt w' newplmnt)
-     in (f newplmnt gw,rm')
+     in (f newplmnt gw)
   where
     f x gw = fromMaybe gw $ do
         j <- x ^. plExternalID
         return $ gw & genPmnt . at j ?~ x
-    recrPlace newplmnt w' pl = placeSpot (w', rm & rmPmnts .:~ newplmnt) pl
+    recrPlace newplmnt w' pl = placeSpot rid (w' & genRooms . ix rid . rmPmnts .:~ newplmnt) pl
 
 -- this should be tidied up
 placeSpotUsingLink ::
     GenWorld ->
-    Room ->
+    Int ->
     Placement ->
     (RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)) ->
     (RoomPos -> Room -> Room) ->
     Maybe Placement ->
-    (GenWorld, Room)
+    GenWorld
-placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos rm) of
+placeSpotUsingLink w rid plmnt extract eff fallback = case searchedPoss (w ^?! genRooms . ix rid . rmPos) of
-    Just (ps, rmposs) -> placeSpot (w, eff (head rmposs) $ rm & rmPos .~ rmposs) (plmnt & plSpot .~ ps)
+    Just (ps, rmposs) -> placeSpot rid (w & genRooms . ix rid %~ eff (head rmposs) . (rmPos .~ rmposs)) (plmnt & plSpot .~ ps)
     Nothing -> case fallback of
-        Nothing -> (w, rm)
+        Nothing -> w
-        Just plmnt' -> placeSpot (w, rm) plmnt'
+        Just plmnt' -> placeSpot rid w plmnt'
   where
     searchedPoss [] = Nothing
-    searchedPoss (pos : poss) = case extract pos rm of
+    searchedPoss (pos : poss) = case extract pos (w ^?! genRooms . ix rid) of
         Nothing -> second (pos :) <$> searchedPoss poss
         Just (ps, rmpos) -> Just (ps, rmpos : poss)
 
 placeSpotRoomRand ::
-    Room ->
+    Int ->
     Int ->
     (DPoint2 -> PlacementSpot) ->
     Placement ->
     GenWorld ->
-    (GenWorld, Room)
+    GenWorld
-placeSpotRoomRand rm i f plmnt w =
+placeSpotRoomRand rid i f plmnt w =
-    let (ps, g) = runState (_rmRandPSs rm !! i) $ w ^. gwWorld . randGen
+    let (ps, g) = runState (_rmRandPSs (w ^?! genRooms . ix rid) !! i) $ w ^. gwWorld . randGen
-     in placeSpot (w & gwWorld . randGen .~ g, rm) (plmnt & plSpot .~ f ps)
+     in placeSpot rid (w & gwWorld . randGen .~ g) (plmnt & plSpot .~ f ps)
 
 
 -- the Int here is some id that is assigned when the placement is placed
-placeSpotID :: Room -> PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
+placeSpotID :: Int -> PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
-placeSpotID rm ps pt w = case pt of
+placeSpotID rid ps pt w = case pt of
     PutTrigger cnd -> plNewID (gwWorld . cWorld . lWorld . triggers) cnd w
     PutMod mdi -> plNewUpID (gwWorld . cWorld . lWorld . modifications) mdID mdi w
     PutProp prp -> plNewUpID (gwWorld . cWorld . lWorld . props) prID (mvProp p rot prp) w
@@ -107,7 +108,7 @@ placeSpotID rm ps pt w = case pt of
     PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
     PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
     PutPPlate pp -> plNewUpID (gwWorld . cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
-    RandPS rgn -> evaluateRandPS rm rgn ps w
+    RandPS rgn -> evaluateRandPS rid rgn ps w
     PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
     PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
     PutSlideDr wl dr eo off a b ->
@@ -122,7 +123,7 @@ placeSpotID rm ps pt w = case pt of
     PutWall qs wl -> (0, over gwWorld (placeWallPoly (map doShift qs) wl) w)
     PutNothing -> (0, w)
     PutID i -> (i, w)
-    PutWorldUpdate f -> (0, w & f rm ps)
+    PutWorldUpdate f -> (0, w & f rid ps)
     PutChasm ps' -> (0, w & gwWorld . cWorld . chasms .:~ map doShift ps')
   where
     p@(V2 px py) = _psPos ps
@@ -131,8 +132,8 @@ placeSpotID rm ps pt w = case pt of
     doShift = shiftPointBy (p, rot)
 
 evaluateRandPS 
-    :: Room -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
+    :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
-evaluateRandPS rm rgen ps w = placeSpotID rm ps evaluatedType (set (gwWorld . randGen) g w)
+evaluateRandPS rid rgen ps w = placeSpotID rid ps evaluatedType (set (gwWorld . randGen) g w)
   where
     (evaluatedType, g) = runState rgen (_randGen $ _gwWorld w)
 

src/Dodge/Room/Tutorial.hs

@@ -66,7 +66,7 @@ setRoomInt x = do
     i <- nextLayoutInt
     return (i,x & rmPmnts .:~ sps0 (PutWorldUpdate (f i)))
   where
-    f i rm _ = genInts . at i ?~ (rm ^?! rmMID . _Just)
+    f i rid _ gw = gw & genInts . at i ?~ (gw ^?! genRooms . ix rid . rmMID . _Just)
 
 setTreeInts :: Tree Room -> State LayoutVars ([Int],Tree Room)
 setTreeInts x = do