Simplify room out/in placements

src/Dodge/Data/GenWorld.hs

@@ -105,9 +105,8 @@ data Room = Room
     , _rmPos :: [RoomPos]
     , _rmPath :: S.Set (Point2, Point2)
     , _rmPmnts :: [Placement]
-    , _rmInPmnt :: [InPlacement]
+    , _rmInPmnt :: [GenWorld -> Placement]
-    , -- note that in placements form a list: multiple InPlacements can use the same id
+    , _rmOutPmnt :: IM.IntMap Placement
-      _rmOutPmnt :: IM.IntMap Placement
     , _rmBound :: [[Point2]]
     , _rmFloor :: Floor
     , _rmName :: String
@@ -124,11 +123,6 @@ data Room = Room
     , _rmClusterStatus :: ClusterStatus
     }
 
-data InPlacement = InPlacement
-    { _ipPlacement :: GenWorld -> [Placement] -> Placement
-    , _ipPlacementID :: Int
-    }
-
 makeLenses ''GenWorld
 makeLenses ''Room
 makeLenses ''RoomType

src/Dodge/Layout.hs

@@ -78,20 +78,20 @@ shuffleRoomPos rm = do
     newPos <- shuffle $ _rmPos rm
     return $ rm & rmPos .~ newPos
 
-doInPlacements :: (IM.IntMap [Placement], GenWorld) -> GenWorld
+doInPlacements :: GenWorld -> GenWorld
-doInPlacements (im, w) =
+doInPlacements w =
-    let (gw, rms) = mapAccumR (doRoomInPlacements im) w (_genRooms w)
+    let (gw, rms) = mapAccumR doRoomInPlacements w (_genRooms w)
      in gw & genRooms .~ rms
 
-doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
+doRoomInPlacements :: GenWorld -> Room -> (GenWorld, Room)
-doRoomInPlacements im w rm = foldr f (w, rm) $ _rmInPmnt rm
+doRoomInPlacements w rm = foldr f (w, rm) $ _rmInPmnt rm
   where
-    f (InPlacement plf i) (w', r') = fst $ placeSpot (w', r') (plf (w') $ im IM.! i)
+    f plf (w', r') = fst $ placeSpot (w', r') (plf (w'))
 
-doOutPlacements :: GenWorld -> (IM.IntMap [Placement], GenWorld)
+doOutPlacements :: GenWorld -> GenWorld
 doOutPlacements w =
     let ((pmnts, gw), rms) = mapAccumR doRoomOutPlacements (IM.empty, w) (_genRooms w)
-     in (pmnts, gw & genRooms .~ rms)
+     in gw & genRooms .~ rms & genPmnt .~ pmnts
 
 doRoomOutPlacements ::
     (IM.IntMap [Placement], GenWorld) ->

src/Dodge/Room/Airlock.hs

@@ -3,6 +3,7 @@
 {- Rooms that contain two doors and a switch alternating both.  -}
 module Dodge.Room.Airlock where
 
+import Data.Maybe
 import Control.Lens
 import Control.Monad
 --import Dodge.Annotation.Data
@@ -41,14 +42,15 @@ decontamRoom i =
                ]
         & rmOutPmnt . at i ?~ 
                analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
-        & rmInPmnt .~ [InPlacement f i]
+        & rmInPmnt .~ [f]
         & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
   where
-    f _ (pmnt : _) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) 
+    f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
-        (V2 (-10) 35) 
+        pmnt <- gw ^? genPmnt . ix i . _head
-        (V2 (-10) 65) 
+        return $ putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) 
-        2
+            (V2 (-10) 35) 
-    f _ _ = error "tried to put a door using an empty placement list"
+            (V2 (-10) 65) 
+            2
     cond pmnt = WdTrig $ pmnt ^?! plMID . _Just
     mcpos = V2 70 50
     cutps = [rectNSWE 100 0 0 40, switchcut]

src/Dodge/Room/Door.hs

@@ -9,6 +9,7 @@ import Dodge.Default.Room
 import Dodge.Placement.Instance
 import Dodge.RoomLink
 import Geometry
+import Control.Lens
 
 door :: Room
 door =
@@ -28,17 +29,19 @@ door =
         ]
 
 triggerDoorRoom :: Int -> Room
-triggerDoorRoom inplid =
+triggerDoorRoom i =
     defaultRoom
         { _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 = [InPlacement f inplid]
+        , _rmInPmnt = [f]
         , _rmName = "triggerDoorRoom"
         -- door extends into side walls (for shadows as rendered 12/03/21)
         -- note no bounds
         }
   where
-    f _ (pmnt : _) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
+    f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
-    f _ _ = error "tried to put a door using an empty placement list"
+        pmnt <- gw ^? genPmnt . ix i . _head
+        return $ putDoubleDoor 
+            DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
     cond pmnt = WdTrig $ fromJust (_plMID pmnt)