Pass room id rather than room during placement

2025-09-25 22:31:09 +01:00
parent f5a3486f72
commit 9ed6d75853
4 changed files with 40 additions and 38 deletions
@@ -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]}
@@ -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' i gw x = 
-    let (gw',r') = placeSpot (gw,(gw ^?! genRooms . ix i)) x
-    in gw' & genRooms . ix i .~ r'
+--placeSpot' :: Int -> GenWorld -> Placement -> GenWorld
+--placeSpot' = placeSpot
+--placeSpot' i gw x = 
+--    let (gw',r') = placeSpot (gw,(gw ^?! genRooms . ix i)) x
+--    in gw' & genRooms . ix i .~ r'

 setupWorldBounds :: World -> World
 setupWorldBounds w =
@@ -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 (w, rm) plmnt = case plmnt of
-    Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
+placeSpot :: Int -> GenWorld -> Placement -> GenWorld
+--placeSpot :: (GenWorld, Room) -> Placement -> (GenWorld, Room)
+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
-    Placement{} -> placePlainPSSpot w rm plmnt shift
+        placeSpotUsingLink w rid plmnt extract eff fallback
+    Placement{} -> placePlainPSSpot w rid plmnt shift
  where
-    shift = _rmShift rm
+    shift = _rmShift $ w ^?! genRooms . ix rid

 placePlainPSSpot 
-    :: GenWorld -> Room -> Placement -> DPoint2 -> (GenWorld, Room)
-placePlainPSSpot w rm plmnt shift =
-    let (i, w') = placeSpotID rm (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
+    :: GenWorld -> Int -> Placement -> DPoint2 -> GenWorld
+placePlainPSSpot w rid plmnt shift =
+    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)
-placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos rm) of
-    Just (ps, rmposs) -> placeSpot (w, eff (head rmposs) $ rm & rmPos .~ rmposs) (plmnt & plSpot .~ ps)
+    GenWorld
+placeSpotUsingLink w rid plmnt extract eff fallback = case searchedPoss (w ^?! genRooms . ix rid . rmPos) of
+    Just (ps, rmposs) -> placeSpot rid (w & genRooms . ix rid %~ eff (head rmposs) . (rmPos .~ rmposs)) (plmnt & plSpot .~ ps)
    Nothing -> case fallback of
-        Nothing -> (w, rm)
-        Just plmnt' -> placeSpot (w, rm) plmnt'
+        Nothing -> w
+        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)
-placeSpotRoomRand rm i f plmnt w =
-    let (ps, g) = runState (_rmRandPSs rm !! i) $ w ^. gwWorld . randGen
-     in placeSpot (w & gwWorld . randGen .~ g, rm) (plmnt & plSpot .~ f ps)
+    GenWorld
+placeSpotRoomRand rid i f plmnt w =
+    let (ps, g) = runState (_rmRandPSs (w ^?! genRooms . ix rid) !! i) $ w ^. gwWorld . randGen
+     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 rm ps pt w = case pt of
+placeSpotID :: Int -> PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
+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)
-evaluateRandPS rm rgen ps w = placeSpotID rm ps evaluatedType (set (gwWorld . randGen) g w)
+    :: Int -> State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
+evaluateRandPS rid rgen ps w = placeSpotID rid ps evaluatedType (set (gwWorld . randGen) g w)
  where
    (evaluatedType, g) = runState rgen (_randGen $ _gwWorld w)

@@ -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