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

Commit mid big tree composing change

Browse Source
This commit is contained in:
justin
2022-06-09 21:25:22 +01:00
parent 8fb80f9691
commit 3edc7a0a58
20 changed files with 263 additions and 248 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/RezBox.hs
+21 -19
View File
@@ -1,5 +1,6 @@
module Dodge.Room.RezBox where
import Dodge.LevelGen.Data
import Dodge.UseAll
--import Dodge.PlacementSpot
--import Dodge.Room.RunPast
import Dodge.RoomLink
@@ -39,7 +40,7 @@ rezBox ls = roomRect 40 60 1 1
& restrictOutLinks (\(V2 _ h,_)-> h > 59)
& rmName .~ "rezBox"
rezBoxesWp :: RandomGen g => State g (SubCompTree Room)
rezBoxesWp :: RandomGen g => State g (Tree Room)
rezBoxesWp = do
w <- state $ randomR (100,400)
h <- state $ randomR (40,40)
@@ -53,16 +54,17 @@ rezBoxesWp = do
let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
let rezrooms = map adddoor
$ wpAdd theweapon aroom : replicate (n-2) aroom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
return $ treeFromTrunk [ rezBox thecol
, door
]
(Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
(Node ( centralRoom) (rezrooms ++ [onwardpassage]))
where
adddoor rm = treeFromPost [PassDown $ connectsToNorth door ] (PassDown rm)
adddoor rm = treeFromPost [ connectsToNorth door ] ( rm)
connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)
maybeBlockedPassage :: RandomGen g => State g (SubCompTree Room)
maybeBlockedPassage = fmap singleUseAll $ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room)
maybeBlockedPassage :: RandomGen g => State g (Tree Room)
maybeBlockedPassage = fmap (pure . useAll)
$ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
rezBoxesWpCrit :: RandomGen g => State g (Tree Room)
rezBoxesWpCrit = do
w <- state $ randomR (200,400)
h <- state $ randomR (40,40)
@@ -72,7 +74,7 @@ rezBoxesWpCrit = do
aroom = rezInvBox thecol
let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
onwardpassage <-
applyToCompRoot (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
over root (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
i <- state $ randomR (0,n-3)
j <- state $ randomR (i,n-2)
@@ -80,31 +82,31 @@ rezBoxesWpCrit = do
$ insertAt i (wpAdd theweapon aroom)
$ insertAt j (crAdd aroom)
$ replicate (n-3) aroom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
return $ treeFromTrunk [ rezBox thecol
, door
]
(Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
(Node ( centralRoom) (rezrooms ++ [onwardpassage]))
where
adddoor rm = treeFromPost [PassDown $ door & rmConnectsTo .~ S.member (OnEdge North)] (PassDown rm)
adddoor rm = treeFromPost [ door & rmConnectsTo .~ S.member (OnEdge North)] ( rm)
crAdd :: Room -> Room
crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5*pi) randC1
rezBoxes :: RandomGen g => State g (SubCompTree Room)
rezBoxes :: RandomGen g => State g (Tree Room)
rezBoxes = do
w <- state $ randomR (100,400)
h <- state $ randomR (40,40)
thecol <- rezColor
let bottomEdgeTest = S.member (OnEdge South) . _rlType
dbox = treeFromPost [PassDown $ door & rmConnectsTo .~ S.member (OnEdge South)]
(PassDown $ rezInvBox thecol)
dbox = treeFromPost [ door & rmConnectsTo .~ S.member (OnEdge South)]
(rezInvBox thecol)
centralRoom <- shuffleLinks $ (roomRectAutoLinks w h) {_rmPmnts = []}
& rmLinks %~ setInLinks bottomEdgeTest
let n = length $ filter bottomEdgeTest $_rmLinks centralRoom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
return $ treeFromTrunk [ rezBox thecol
, door
]
(Node (PassDown centralRoom) (replicate (n-1) dbox ++ [Node (UseAll door) []]))
(Node ( centralRoom) (replicate (n-1) dbox ++ [Node (useAll door) []]))
rezColor :: RandomGen g => State g LightSource
rezColor = do