diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index de56cb16e..9af45fc01 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -13,8 +13,8 @@ defaultRoom = Room , _rmPos = [] , _rmPath = [] , _rmPmnts = [] - , _rmPartPmnt = Nothing - , _rmExtPmnt = Nothing + , _rmInPmnt = [] + , _rmOutPmnt = [] , _rmBound = [] , _rmFloor = InheritFloor , _rmName = "defaultRoom" diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 65c55133b..93ceae7e4 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -132,11 +132,13 @@ doPartialPlacements (im,w) = let (gw,rms) = mapAccumR (doPartialPlacement im) w in gw {_gRooms = rms} doPartialPlacement :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room) -doPartialPlacement im w rm = case _rmPartPmnt rm of - Nothing -> (w, rm) - Just fi -> case _rmTakeFrom rm of - Nothing -> (w, rm) - Just i -> fst $ placeSpot (w,rm) (fi (im IM.! i)) +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 doExtendedPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld) doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (IM.empty,w) (_gRooms w) @@ -145,12 +147,13 @@ doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (I doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) -> Room -> ( (IM.IntMap [Placement], GenWorld) , Room ) -doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of - Nothing -> ( (im,w) , rm ) - Just plmnt -> case _rmLabel rm of - Nothing -> ( (im,w) , rm ) - Just i -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt - in ( (IM.insert i plmnts im, neww) , newrm ) +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 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 fb240bf5e..2f434e764 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -77,8 +77,8 @@ data Room = Room , _rmPos :: [RoomPos] , _rmPath :: [(Point2, Point2)] , _rmPmnts :: [Placement] - , _rmPartPmnt :: Maybe ([Placement] -> Placement) - , _rmExtPmnt :: Maybe Placement + , _rmInPmnt :: [InPlacement] + , _rmOutPmnt :: [OutPlacement] , _rmBound :: [ [Point2] ] , _rmFloor :: Floor , _rmName :: String diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index ffcb48ae7..35b6cb26f 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -28,12 +28,12 @@ door = defaultRoom ,uncurry inLink (V2 20 5,pi) ] -switchDoorRoom :: Room -switchDoorRoom = defaultRoom +switchDoorRoom :: Int -> Room +switchDoorRoom inplid = defaultRoom { _rmPolys = [rectNSWE 40 0 0 40] , _rmLinks = init lnks++ [last lnks] , _rmPath = [(V2 20 35,V2 20 5)] - , _rmPartPmnt = Just f + , _rmInPmnt = [InPlacement f inplid] -- door extends into side walls (for shadows as rendered 12/03/21) -- note no bounds } diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index aa3169b26..6efc004f6 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -37,14 +37,14 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~ , mntLightLnkCond unusedLnkToPS ] -lightSensInsideDoor :: Room -> Room -lightSensInsideDoor rm = rm +lightSensInsideDoor :: Int -> Room -> Room +lightSensInsideDoor outplid rm = rm & rmPmnts .:~ psPt atFstLnkOut (PutShape $ colorSH yellow $ thinHighBar 0 (V2 20 (-1)) (V2 20 (-100)) <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100)) <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) - & rmExtPmnt ?~ lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100) + & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)) outplid] lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement lasSensLightAboveDoor wth ps = extTrigLitPos @@ -54,29 +54,29 @@ lasSensLightAboveDoor wth ps = extTrigLitPos upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True | otherwise = w -lightSensByDoor :: Room -> Room -lightSensByDoor rm = rm +lightSensByDoor :: Int -> Room -> Room +lightSensByDoor outplid rm = rm & rmPmnts .++~ [ psPt atFstLnkOut $ PutShape $ colorSH yellow $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80) , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape , heightWallPS (atFstLnkOutShiftInward 100) 30 covershape ] - & rmExtPmnt ?~ lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift) + & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)) outplid] where covershape = rectNSEW 10 (-10) 20 (-20) sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a) lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room) lasSensorTurretTest n = do - cenroom <- shuffleLinks $ lightSensInsideDoor cenLasTur & rmLabel ?~ n - let doorroom = switchDoorRoom & rmTakeFrom ?~ n + cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur & rmLabel ?~ n + let doorroom = switchDoorRoom n & rmTakeFrom ?~ 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 cenLasTur) {_rmLabel = Just n} - let doorroom = switchDoorRoom {_rmTakeFrom = Just n} + cenroom <- shuffleLinks $ (lightSensByDoor n cenLasTur) {_rmLabel = Just n} + let doorroom = (switchDoorRoom n) {_rmTakeFrom = Just 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 36c919153..16eadc907 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -57,11 +57,11 @@ runPastRoom i = do let linkcor = critRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ] critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1 aswitchroom = corridorWallN - {_rmExtPmnt = Just $ putLitButOnPosExtTrig red useUnusedLnk + {_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i] ,_rmLabel = Just i ,_rmPmnts = [] } - switchdoor = switchDoorRoom & rmTakeFrom ?~ i + switchdoor = switchDoorRoom i & rmTakeFrom ?~ i n = length $ filter theedgetest $ map lnkPosDir $ _rmLinks cenroom controom = treeFromPost [PassDown switchdoor,PassDown linkcor] (UseAll door) critrooms :: [SubCompTree Room]