justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Start cleanup of room in-links

Browse Source
This commit is contained in:
justin
2022-03-05 01:09:19 +00:00
parent 8fa6bbfe29
commit 0c580e63a4
11 changed files with 67 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Procedural.hs
+9 -11
View File
@@ -90,8 +90,7 @@ combineRooms r r' = defaultRoom
, _rmLinks = _rmLinks r ++ _rmLinks r'
, _rmPath = map clampPath $ _rmPath r
++ _rmPath r'
, _rmPmnts = (_rmPmnts r)
++ (_rmPmnts r')
, _rmPmnts = _rmPmnts r ++ _rmPmnts r'
--, _rmPmnts = map (shiftPlacement $ _rmShift r) (_rmPmnts r)
-- ++ map (shiftPlacement $ _rmShift r') (_rmPmnts r')
, _rmBound = _rmBound r ++ _rmBound r'
@@ -142,22 +141,21 @@ quarterRoomTri w = do
}
quarterRoomSquare :: RandomGen g => Float -> State g Room
quarterRoomSquare w = do
let commonPlacements =
[ blockLine (V2 (w/2) (w/2)) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
, sPS (V2 25 (2*w-45)) pi PutNothing
]
b <- takeOne
[ [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
]
] ++ commonPlacements
, [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate w) w ) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
]
] ++ commonPlacements
, [ mntLS iShape (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 0 w) (V2 0 (w*2))
, sPS (V2 20 (2*w-40)) pi PutNothing
]
] ++ commonPlacements
]
pure $ defaultRoom
{ _rmPolys = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
src/Dodge/Room/RezBox.hs
+6 -23
View File
@@ -70,45 +70,28 @@ rezBoxesWpCrit = do
h <- state $ randomR (40,40)
thecol <- rezColor
theweapon <- randBlockBreakWeapon
--horedge <- takeOne [OnEdge North,OnEdge South]
let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
onwardpassage <-
applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West)) <$> maybeBlockedPassage
let bottomEdgeTest (V2 _ y,_) = y < 1
aroom = rezInvBox thecol
let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
onwardpassage <-
applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West)) <$> maybeBlockedPassage
let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
i <- state $ randomR (0,n-3)
j <- state $ randomR (i,n-2)
let rezrooms = map adddoor
let rezrooms = map adddoor
$ insertAt i (wpAdd theweapon aroom)
$ insertAt j (crAdd aroom)
$ replicate (n-3) aroom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
]
(Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
where
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
adddoor rm = treeFromPost [PassDown $ door & rmConnectsTo .~ S.singleton (OnEdge North)] (PassDown rm)
crAdd :: Room -> Room
crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :)
corridorLRbranches :: RandomGen g => State g (SubCompTree Room)
corridorLRbranches = do
w <- state $ randomR (100,400)
h <- state $ randomR (40,40)
thecol <- rezColor
let bottomEdgeTest (V2 _ y,_) = y < 1
dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest
((roomRectAutoLinks w h) {_rmPmnts = []})
let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
rezBoxes :: RandomGen g => State g (SubCompTree Room)
rezBoxes = do
w <- state $ randomR (100,400)
src/Dodge/Room/Room.hs
+5 -6
View File
@@ -142,9 +142,8 @@ glassSwitchBackCrits = glassSwitchBack
] ++)
miniTree2 :: RandomGen g => State g (SubCompTree Room)
miniTree2 = glassSwitchBackCrits
>>= randomiseOutLinks
>>= changeLinkTo (\p -> (sndV2 . fst) p < 70)
miniTree2 = restrictInLinks (\p -> (sndV2 . fst) p < 70) <$> glassSwitchBackCrits
>>= randomiseAllLinks
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
miniRoom3 :: RandomGen g => State g (SubCompTree Room)
@@ -189,7 +188,7 @@ roomMiniIntro = do
return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor]
roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst)
roomCenterPillar = randomiseAllLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst)
$ set rmPmnts plmnts $ roomRect 240 240 2 2
where
plmnts =
@@ -385,7 +384,7 @@ longRoom = do
brls <- fmap (map (\p -> sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel) )
$ replicateM 5 $ randInRect (w-20) 900
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
changeLinkTo cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
return $ restrictInLinks cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
[sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
@@ -397,7 +396,7 @@ doubleCorridorBarrels :: RandomGen g => State g Room
doubleCorridorBarrels = do
h <- state $ randomR (200,300)
let cond x = (sndV2 . fst) x < h - 40
changeLinkTo cond $ roomRect 100 h 1 1 & rmPmnts .~
return $ restrictInLinks cond $ roomRect 100 h 1 1 & rmPmnts .~
[blockLine (V2 50 50) (V2 50 h)
,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit
,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel
src/Dodge/Room/Start.hs
+8 -6
View File
@@ -65,14 +65,16 @@ room2 :: RandomGen g => Int -> State g (SubCompTree Room)
room2 = lasCenSensEdge
startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
startRoom _ = join $ uncurry takeOneWeighted $ unzip
startRoom i = join $ uncurry takeOneWeighted $ unzip
-- [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
[ (,) (1::Float) rezBoxesWp
-- , (,) 1 rezBoxesThenWeaponRoom
-- , (,) 1 rezBoxThenWeaponRoom
-- , (,) 1 rezBoxesWpCrit
-- , (,) 1 $ runPastStart i
[ (,) one rezBoxesWp
, (,) 1 rezBoxesThenWeaponRoom
, (,) 1 rezBoxThenWeaponRoom
, (,) one rezBoxesWpCrit
, (,) 1 $ runPastStart i
]
where
one = (1::Float)
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
runPastStart i = do