From c4a891244152551ef9026d3a962173635c50f792 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 17 Mar 2022 19:37:17 +0000 Subject: [PATCH] Improve rooms --- src/Dodge/LevelGen.hs | 3 ++ src/Dodge/Placement/Instance/Wall.hs | 12 +++++++ src/Dodge/PlacementSpot.hs | 2 ++ src/Dodge/Room.hs | 2 ++ src/Dodge/Room/Room.hs | 54 ++++++++++++++-------------- src/Dodge/Room/Start.hs | 14 ++++---- src/Dodge/Room/Tanks.hs | 30 +++------------- 7 files changed, 58 insertions(+), 59 deletions(-) diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 9e77e9c1d..8e7b1d0c9 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -31,6 +31,9 @@ layoutLevelFromSeed i seed = do let rmtree = inorderNumberTree $ evalState initialRoomTree g putStrLn "Abstract layout: " putStrLn $ compactDrawTree $ fmap (show . snd) rmtree + let nameshow (r,rid) = _rmName r ++ "-" ++ show rid + writeFile "aGeneratedRoomLayout" $ drawTree $ fmap nameshow rmtree + putStrLn "Layout with room names written to aGeneratedRoomLayout" mrs <- positionRoomsFromTree rmtree case mrs of Just rs -> do diff --git a/src/Dodge/Placement/Instance/Wall.hs b/src/Dodge/Placement/Instance/Wall.hs index 217f18dc5..b7470a6f1 100644 --- a/src/Dodge/Placement/Instance/Wall.hs +++ b/src/Dodge/Placement/Instance/Wall.hs @@ -152,6 +152,18 @@ subZipWith f g xs ys = isPutID :: Int -> Placement -> Bool isPutID i ps = Just i == ps ^? plType . putID +putBlockRect' :: Float -> Float -> Placement +putBlockRect' w h = ps0jPushPS (aline tl tr) + $ ps0jPushPS (aline tr br) + $ ps0jPushPS (aline br bl) + $ sps0 (aline bl tl) + where + tl = V2 (-w) h + tr = V2 w h + br = V2 w (-h) + bl = V2 (-w) (-h) + aline = PutLineBlock baseBlockPane StoneBlock 9 9 + putBlockRect :: Float -> Float -> Float -> Float -> [Placement] putBlockRect a x b y = [ blockLine (V2 a b) (V2 a y) diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index 2a637236b..6266deb12 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -26,6 +26,8 @@ module Dodge.PlacementSpot , resetPLUse , psposAddLabel , shiftByV2 + , usedRoomLinkPoss + , usedRoomInLinkPoss ) where import Dodge.LevelGen.Data import Geometry diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 26e18e9f3..8075f03b7 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -22,6 +22,7 @@ module Dodge.Room , module Dodge.Room.Containing , module Dodge.Room.SensorDoor , module Dodge.Room.Ngon + , module Dodge.Room.Pillar ) where import Dodge.Room.Room import Dodge.Room.RoadBlock @@ -45,3 +46,4 @@ import Dodge.Room.Tanks import Dodge.Room.Containing import Dodge.Room.SensorDoor import Dodge.Room.Ngon +import Dodge.Room.Pillar diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 4007fb132..8a0d17725 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -7,7 +7,8 @@ import Dodge.Default.Room import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.Launcher import Dodge.Creature -import Dodge.Room.Foreground +import Dodge.Room.Pillar +import Dodge.Room.Modify.Girder import Dodge.LevelGen.Data import Dodge.RandomHelp import Dodge.Default.Wall @@ -23,8 +24,9 @@ import Geometry import Tile import MonadHelp import LensHelp +--import Color ---import qualified Data.Set as S +import qualified Data.Set as S import Control.Monad.State --import Control.Monad.Loops import System.Random @@ -54,18 +56,6 @@ roomPadCut ps p = defaultRoom , _rmLinks = muout [(p,0)] ++ muin [(V2 0 0,pi)] , _rmPath = [(V2 0 0,p)] } -roomPillars :: Room -roomPillars = roomRect 240 240 2 2 - & rmPmnts .~ plmnts - where - plmnts = spanLightI (V2 120 24) (V2 120 216) - : mntLS vShape (V2 12 12) (V3 25 25 70) - : mntLS vShape (V2 228 228) (V3 215 215 70) - : sps0 (PutShape $ thinHighBar 75 (V2 26 25) (V2 120 25)) - : sps0 (PutShape $ thinHighBar 75 (V2 214 215) (V2 120 215)) - : g 180 150 90 60 - f a x b y = putBlockRect a x b y - g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d branchWith :: Room -> [Tree Room] -> SubCompTree Room branchWith r ts = Node (PassDown r) $ return (UseAll door) : fmap (fmap PassDown) ts @@ -74,7 +64,6 @@ branchWith r ts = Node (PassDown r) $ return (UseAll door) : fmap (fmap PassDown manyDoors :: Int -> SubCompTree Room manyDoors i = treeFromPost (replicate i (PassDown door)) $ UseAll door - glassSwitchBack :: RandomGen g => State g Room glassSwitchBack = do wth <- state $ randomR (200,400) @@ -102,6 +91,7 @@ glassSwitchBack = do return $ roomRect wth hgt 2 4 & rmPmnts .~ plmnts & rmRandPSs .~ [northPSs,midPS] + & rmName .~ "glassSwitchBack" glassSwitchBackCrits :: RandomGen g => State g Room glassSwitchBackCrits = glassSwitchBack @@ -143,7 +133,7 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen) roomMiniIntro :: RandomGen g => State g (SubCompTree Room) roomMiniIntro = do midroom <- join $ takeOne [miniTree2] --,glassLesson] - return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor] + return $ chainUses [return $ UseAll corridor,return $ UseAll corridor,return $ UseAll corridor,return $ UseAll door, midroom,return $ UseAll corridor] roomCenterPillar :: RandomGen g => State g Room roomCenterPillar = randomiseAllLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) @@ -206,7 +196,8 @@ weaponEmptyRoom = do ,mntLightLnkCond useUnusedLnk ] f (V2 x y,a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30) - rm <- shuffleLinks $ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts) + rm <- addHighGirder >=> shuffleLinks + $ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts) return $ treeFromTrunk [PassDown corridor] (singleUseAll rm ) weaponUnderCrits :: RandomGen g => State g (SubCompTree Room) @@ -222,7 +213,7 @@ weaponUnderCrits = do (singleUseAll (set rmPmnts plmnts corridorN)) rcp <- roomCenterPillar deadEndRoom' <- takeOne - [ addwpat (V2 120 20) roomPillars + [ addwpat (V2 120 20) (roomPillars 0 240 240 2 2) , addwpat (V2 120 20) rcp] junctionRoom <- takeOne [PassDown tEast,PassDown tWest] return $ treeFromTrunk [PassDown corridorN,PassDown corridorN] @@ -251,10 +242,21 @@ weaponBehindPillar = do weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room) weaponBetweenPillars = do - let wpPos = unusedSpotNearInLink 100 + w <- state $ randomR (240,360) + h <- state $ randomR (240,360) + let wpPos = rprBool $ \rp r -> and + [ RoomPosOnPath `S.member` _rpType rp + , _rpPlacementUse rp == 0 + , _rpLinkStatus rp == NotLink + , any ((<100) . dist (_rpPos rp)) (usedRoomInLinkPoss r) + ] ncrits <- state $ randomR (1,3) - critPlacementSpots <- replicateM ncrits $ randDirPS $ unusedSpotAwayFromInLink 100 - let theRoom = roomPillars & rmPmnts .++~ + critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> and + [ RoomPosOnPath `S.member` _rpType rp + , _rpPlacementUse rp == 0 + , all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r) + ] + let theRoom = roomPillars 0 w h 1 1 & rmPmnts .++~ sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots return $ singleUseAll theRoom @@ -290,11 +292,11 @@ deadEndRoom = defaultRoom {- A random Either tree with a weapon and melee monster challenge. -} weaponRoom :: RandomGen g => State g (SubCompTree Room) weaponRoom = join $ takeOne - [ weaponEmptyRoom - , weaponUnderCrits - , weaponBehindPillar - , weaponBetweenPillars - , weaponLongCorridor +-- [ weaponEmptyRoom +-- , weaponUnderCrits +-- , weaponBehindPillar + [ weaponBetweenPillars +-- , weaponLongCorridor ] roomCCrits :: RandomGen g => State g Room diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 991d45d05..653bf0f47 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -50,13 +50,13 @@ powerFakeout = do startRoom :: RandomGen g => Int -> State g (SubCompTree Room) startRoom i = join $ uncurry takeOneWeighted $ unzip - [ (,) (0.5::Float) $ chainUses <$> sequence [powerFakeout,weaponRoom] - , (,) one rezBoxesWp - , (,) one rezBoxesThenWeaponRoom - , (,) 1 rezBoxThenWeaponRoom - , (,) one rezBoxesWpCrit - , (,) 1 $ runPastStart i - , (,) 5 $ startCrafts >>= roomsContaining [] >>= rezBoxThenRooms +-- [ (,) (0.5::Float) $ chainUses <$> sequence [powerFakeout,weaponRoom] +-- , (,) one rezBoxesWp +-- , (,) one rezBoxesThenWeaponRoom + [ (,) one rezBoxThenWeaponRoom +-- , (,) one rezBoxesWpCrit +-- , (,) 1 $ runPastStart i +-- , (,) 1 $ startCrafts >>= roomsContaining [] >>= rezBoxThenRooms ] where one = 1::Float diff --git a/src/Dodge/Room/Tanks.hs b/src/Dodge/Room/Tanks.hs index b8ad327ea..007bf16ee 100644 --- a/src/Dodge/Room/Tanks.hs +++ b/src/Dodge/Room/Tanks.hs @@ -4,21 +4,22 @@ import Dodge.LevelGen.Data import Dodge.RandomHelp import Dodge.Room.Procedural import Dodge.Room.Foreground +import Dodge.Room.Modify.Girder --import Dodge.Room.RoadBlock import Dodge.Placement.Instance import Dodge.Placement.TopDecoration import Dodge.PlacementSpot --import Padding import Color -import Shape +--import Shape import LensHelp -import Geometry +--import Geometry --import Data.Maybe --import Data.Tree import Control.Monad.State import System.Random -import qualified Data.Set as S +--import qualified Data.Set as S randomTank :: RandomGen g => State g Placement randomTank = takeOne $ map (\f -> f (dim orange) orange) @@ -29,29 +30,6 @@ randomTank = takeOne $ map (\f -> f (dim orange) orange) , roundTankCross , tankSquareDec plusDecoration ] -addGirderNS :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room -addGirderNS shapef col room = do - let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room - girderPosOrder <- shuffle [1 .. nwestlnks - 2] - return $ room & rmPmnts .:~ foldr1 setFallback - (sps0 PutNothing : [ twoRoomPoss - (isUnusedLnkType (FromWest i)) - (isUnusedLnkType (FromWest i)) - $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) - | i <- girderPosOrder] - ) -addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room -addGirderEW shapef col room = do - let nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room - girderPosOrder <- shuffle [1 .. nwestlnks - 2] - return $ room & rmPmnts .:~ foldr1 setFallback - (sps0 PutNothing : - [ twoRoomPoss - (isUnusedLnkType (FromSouth i)) - (isUnusedLnkType (FromSouth i)) - $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) - | i <- girderPosOrder] - ) tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room tanksRoom crs its = do