diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index 9af45fc01..14f6edad1 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -21,8 +21,8 @@ defaultRoom = Room , _rmShift = (V2 0 0 , 0) , _rmViewpoints = [] , _rmRandPSs = [] - , _rmLabel = Nothing - , _rmTakeFrom = Nothing +-- , _rmLabel = Nothing +-- , _rmTakeFrom = Nothing , _rmStartWires = IM.empty , _rmEndWires = IM.empty , _rmConnectsTo = S.member OutLink diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 93ceae7e4..8273dbd41 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -42,8 +42,8 @@ generateLevelFromRoomList gr' w = over gWorld initWallZoning . over gWorld setupWorldBounds . placeWires . doAfterPlacements - . doPartialPlacements - . doExtendedPlacements + . doInPlacements + . doOutPlacements . doIndividualPlacements . setFloors . worldToGenWorld rs' @@ -127,33 +127,27 @@ doAfterPlacement pmntis gw = gRandify gw $ do let (newgw,rm) = fst $ placeSpot (gw,_gRooms gw IM.! i) pmnt return $ newgw & gRooms . ix i .~ rm -doPartialPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld -doPartialPlacements (im,w) = let (gw,rms) = mapAccumR (doPartialPlacement im) w (_gRooms w) +doInPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld +doInPlacements (im,w) = let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_gRooms w) in gw {_gRooms = rms} -doPartialPlacement :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room) -doPartialPlacement im w rm = case _rmInPmnt rm of - [] -> (w, rm) - (InPlacement f i:xs) -> - let (w',r') = fst $ placeSpot (w,rm) (f (im IM.! i)) - in doPartialPlacement im w' (r' & rmInPmnt %~ tail) --- TODO rather than explicitly recursing and changing the room, this should be done --- with a fold over the list of in placements +doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room) +doRoomInPlacements im w rm = foldr f (w,rm) $ _rmInPmnt rm + where + f (InPlacement plf i) (w',r') = fst $ placeSpot (w',r') (plf $ im IM.! i) -doExtendedPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld) -doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (IM.empty,w) (_gRooms w) +doOutPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld) +doOutPlacements w = let ((pmnts,gw),rms) = mapAccumR doRoomOutPlacements (IM.empty,w) (_gRooms w) in (pmnts,gw{_gRooms = rms}) -doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) +doRoomOutPlacements :: (IM.IntMap [Placement], GenWorld) -> Room -> ( (IM.IntMap [Placement], GenWorld) , Room ) -doExtendedPlacement (im,w) rm = case _rmOutPmnt rm of - [] -> ( (im,w) , rm ) - (OutPlacement plmnt i:xs) -> - let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt - in doExtendedPlacement (IM.insert i plmnts im, neww) (newrm & rmOutPmnt %~ tail) --- TODO rather than explicitly recursing and changing the room, this should be done --- with a fold over the list of out placements +doRoomOutPlacements imw r = foldr f ( imw, r ) $ _rmOutPmnt r + where + f (OutPlacement pl i) ( (im,w) , rm ) = + let ((neww,newrm),plmnts) = placeSpot (w,rm) pl + in ((IM.insert i plmnts im, neww) , newrm ) doIndividualPlacements :: GenWorld -> GenWorld doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_gRooms gw) diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 2f434e764..daa812157 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -85,8 +85,6 @@ data Room = Room , _rmShift :: (Point2, Float) , _rmViewpoints :: [Point2] , _rmRandPSs :: [State StdGen (Point2,Float)] - , _rmLabel :: Maybe Int - , _rmTakeFrom :: Maybe Int , _rmStartWires :: IM.IntMap RoomWire , _rmEndWires :: IM.IntMap RoomWire , _rmConnectsTo :: S.Set RoomLinkType -> Bool diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index 6efc004f6..f4df3677b 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -69,14 +69,14 @@ lightSensByDoor outplid rm = rm lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room) lasSensorTurretTest n = do - cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur & rmLabel ?~ n - let doorroom = switchDoorRoom n & rmTakeFrom ?~ n + cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur + let doorroom = switchDoorRoom n return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door) lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room) lasCenSensEdge n = do - cenroom <- shuffleLinks $ (lightSensByDoor n cenLasTur) {_rmLabel = Just n} - let doorroom = (switchDoorRoom n) {_rmTakeFrom = Just n} + cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur + let doorroom = switchDoorRoom n return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom) [ treeFromPost [PassDown doorroom] (UseAll door) , treeFromPost [PassDown door] (UseLabel 0 corridor) diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs index 16eadc907..165dbaeb9 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -58,10 +58,9 @@ runPastRoom i = do critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1 aswitchroom = corridorWallN {_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i] - ,_rmLabel = Just i ,_rmPmnts = [] } - switchdoor = switchDoorRoom i & rmTakeFrom ?~ i + switchdoor = switchDoorRoom i n = length $ filter theedgetest $ map lnkPosDir $ _rmLinks cenroom controom = treeFromPost [PassDown switchdoor,PassDown linkcor] (UseAll door) critrooms :: [SubCompTree Room]