diff --git a/src/Dodge/Data/GenWorld.hs b/src/Dodge/Data/GenWorld.hs index 7f638f335..5683aab5e 100644 --- a/src/Dodge/Data/GenWorld.hs +++ b/src/Dodge/Data/GenWorld.hs @@ -105,9 +105,8 @@ data Room = Room , _rmPos :: [RoomPos] , _rmPath :: S.Set (Point2, Point2) , _rmPmnts :: [Placement] - , _rmInPmnt :: [InPlacement] - , -- note that in placements form a list: multiple InPlacements can use the same id - _rmOutPmnt :: IM.IntMap Placement + , _rmInPmnt :: [GenWorld -> 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 diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 554cd7a3c..1f3483c97 100644 --- a/src/Dodge/Layout.hs +++ b/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 (im, w) = - let (gw, rms) = mapAccumR (doRoomInPlacements im) w (_genRooms w) +doInPlacements :: GenWorld -> GenWorld +doInPlacements w = + let (gw, rms) = mapAccumR doRoomInPlacements w (_genRooms w) in gw & genRooms .~ rms -doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room) -doRoomInPlacements im w rm = foldr f (w, rm) $ _rmInPmnt rm +doRoomInPlacements :: GenWorld -> Room -> (GenWorld, Room) +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) -> diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 3690b1c79..34b3622c5 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/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) - (V2 (-10) 35) - (V2 (-10) 65) - 2 - f _ _ = error "tried to put a door using an empty placement list" + f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do + pmnt <- gw ^? genPmnt . ix i . _head + return $ putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) + (V2 (-10) 35) + (V2 (-10) 65) + 2 cond pmnt = WdTrig $ pmnt ^?! plMID . _Just mcpos = V2 70 50 cutps = [rectNSWE 100 0 0 40, switchcut] diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 972c1abaf..033c83031 100644 --- a/src/Dodge/Room/Door.hs +++ b/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 _ _ = error "tried to put a door using an empty placement list" + f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do + 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)