This commit is contained in:
2022-05-20 21:47:18 +01:00
parent da302aad0c
commit 61fe9b7df4
11 changed files with 36 additions and 30 deletions
+3 -3
View File
@@ -67,11 +67,11 @@ anoToRoomTree anos = case anos of
let lr = fst lr'
keyroom' <- fromJust $ lookup ii ks
let keyroom = fst keyroom'
(return $ overwriteLabel 0 UseNone lr [keyroom]
) <&> (,TreeSubLabelling ("PassthroughLockKeyLists-"++show ii)
return (overwriteLabel 0 UseNone lr [keyroom]
,TreeSubLabelling ("PassthroughLockKeyLists-"++show ii)
(Just $ treeFromPost [snd lr'] (snd keyroom'))
)
_ -> (,TreeSubLabelling "" Nothing) <$> anoToRoomTree' anos
_ -> (,TreeSubLabelling "no label" Nothing) <$> anoToRoomTree' anos
{- | Create a random room tree structure from a list of annotations. -}
anoToRoomTree' :: [Annotation] -> State StdGen (SubCompTree Room)
+5 -4
View File
@@ -37,7 +37,7 @@ import System.Random
--import qualified Data.IntMap.Strict as IM
initialAnoTree :: Tree [Annotation]
initialAnoTree = padSucWithDoors $ treeFromTrunk
initialAnoTree = padSucWithDoors $ treeFromPost
[[AnoApplyInt 0 startRoom]
, [SpecificRoom $ return (return . UseAll $ roomRectAutoLinks 400 400
& rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit chaseCrit)
@@ -90,10 +90,11 @@ initialAnoTree = padSucWithDoors $ treeFromTrunk
---- ,[SpecificRoom $ fmap (pure . UseAll) armouredCorridor]
-- ,[Corridor]
-- ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
-- ,[Corridor]
,[SpecificRoom $ (pure . UseAll <$> randomFourCornerRoom [])
<&>(,TreeSubLabelling "randomFourCornerRoom" Nothing )]
]
$ treeFromPost [[Corridor,SpecificRoom $ (pure . UseAll <$> randomFourCornerRoom [])
<&>(,TreeSubLabelling "randomFourCornerRoom" Nothing )]]
[SpecificRoom $ (fmap (pure . UseAll) (telRoomLev 1))
[SpecificRoom $ fmap (pure . UseAll) (telRoomLev 1)
<&> (,TreeSubLabelling "telRoomLev" Nothing)]
{- | A test level tree. -}
+1 -2
View File
@@ -57,8 +57,7 @@ layoutLevelFromSeed i seed = do
drawTreeSubLabelling :: Tree TreeSubLabelling -> String
drawTreeSubLabelling t = drawTree (fmap _topLabel t)
++ concat
(map f $ flatten t)
++ concatMap f (flatten t)
where
f (TreeSubLabelling _ Nothing) = ""
f (TreeSubLabelling l (Just t')) = l ++ ":\n" ++ drawTreeSubLabelling t'
+2 -2
View File
@@ -100,7 +100,7 @@ someCrits = do
corridorBoss :: RandomGen g => Creature -> State g (LabSubCompTree Room)
corridorBoss cr = do
endroom <- bossRoom cr
(return $ treeFromPost (replicate 5 $ PassDown corridor)
return (treeFromPost (replicate 5 $ PassDown corridor)
(PassDown endroom)
) <&> (,TreeSubLabelling "corridorBoss" Nothing)
,TreeSubLabelling "corridorBoss" Nothing)
+2 -1
View File
@@ -21,7 +21,8 @@ roomsContaining crs its = do
[ randomFourCornerRoomCrsIts crs its
, tanksRoom crs its
]
(return $ treeFromPost [] $ UseAll endroom) <&> (,TreeSubLabelling "roomsContaining" Nothing)
return (treeFromPost [] $ UseAll endroom
,TreeSubLabelling "roomsContaining" Nothing)
pedestalRoom :: RandomGen g => Item -> State g Room
pedestalRoom it = do
+9 -6
View File
@@ -77,10 +77,11 @@ keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (LabSubCompTree Room)
keyCardRoomRunPast keyid rmid = do
cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
let doorroom = triggerDoorRoom rmid
(return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
return (treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
[ treeFromPost [PassDown doorroom] (UseAll door)
, treeFromPost [PassDown door] (UseLabel 0 corridor)
]) <&> (,TreeSubLabelling "keyCardRoomRunPast" Nothing)
]
,TreeSubLabelling "keyCardRoomRunPast" Nothing)
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
keyCardAnalyserByDoor keyid = analyserByDoor
@@ -146,10 +147,11 @@ lasCenSensEdge :: RandomGen g => Int -> State g (LabSubCompTree Room)
lasCenSensEdge n = do
cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
let doorroom = triggerDoorRoom n
(return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
return (treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
[ treeFromPost [PassDown doorroom] (UseAll door)
, treeFromPost [PassDown door] (UseLabel 0 corridor)
]) <&> (,TreeSubLabelling "lasCenSensEdge" Nothing)
]
,TreeSubLabelling "lasCenSensEdge" Nothing)
lasTunnel :: RandomGen g => Float -> State g Room
lasTunnel y = do
@@ -191,7 +193,8 @@ lasTunnelRunPast y = do
r <- lasTunnel y
r1 <- takeOne [door,corridor]
r2 <- takeOne [door,corridor]
(return $ Node (PassDown r)
return (Node (PassDown r)
[ singleUseAll r1
, return (UseLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
]) <&> (,TreeSubLabelling "lasTunnelRunPast" Nothing)
]
,TreeSubLabelling "lasTunnelRunPast" Nothing)
+3 -2
View File
@@ -145,7 +145,8 @@ slowDoorRoom = do
slowDoorRoomRunPast :: RandomGen g => State g (LabSubCompTree Room)
slowDoorRoomRunPast = do
r <- slowDoorRoom
(return $ treeFromTrunk [PassDown door] $ Node (PassDown r)
return (treeFromTrunk [PassDown door] $ Node (PassDown r)
[ singleUseAll door
, return (UseLabel 0 $ door & rmConnectsTo .~ S.member InLink)
] ) <&> (,TreeSubLabelling "slowDoorRoomRunPast" Nothing)
]
,TreeSubLabelling "slowDoorRoomRunPast" Nothing)
+2 -2
View File
@@ -52,7 +52,7 @@ longRoom = do
longRoomRunPast :: RandomGen g => State g (LabSubCompTree Room)
longRoomRunPast = do
r <- longRoom
(return $ treeFromTrunk [PassDown door]
return (treeFromTrunk [PassDown door]
(Node (PassDown r)
[ singleUseAll door
--, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
@@ -61,4 +61,4 @@ longRoomRunPast = do
(UseLabel 0 door)
]
)
) <&> (,TreeSubLabelling "longRoomRunPast" Nothing)
,TreeSubLabelling "longRoomRunPast" Nothing)
+4 -4
View File
@@ -133,9 +133,9 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
roomMiniIntro :: RandomGen g => State g (LabSubCompTree Room)
roomMiniIntro = do
midroom <- join $ takeOne [miniTree2] --,glassLesson]
(return $ chainUses
return (chainUses
[return $ UseAll corridor,return $ UseAll corridor,return $ UseAll corridor,return $ UseAll door, midroom,return $ UseAll corridor]
) <&> (,TreeSubLabelling "roomMiniIntro" Nothing)
,TreeSubLabelling "roomMiniIntro" Nothing)
roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst)
@@ -422,7 +422,7 @@ shootingRange = do
rm3 <- shootersRoom >>= randomiseAllLinks
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(_,r) -> r == 0)
(return $ treeFromPost
return (treeFromPost
[PassDown rm1
,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
@@ -431,7 +431,7 @@ shootingRange = do
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
]
(UseAll rm3)
) <&> (,TreeSubLabelling "shootingRange" Nothing)
,TreeSubLabelling "shootingRange" Nothing)
spawnerRoom :: RandomGen g => State g (SubCompTree Room)
spawnerRoom = do
+3 -2
View File
@@ -45,11 +45,12 @@ sensorRoom senseType n = do
sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (LabSubCompTree Room)
sensorRoomRunPast dt n = do
t <- sensorRoom dt n
(return $ applyToSubforest [0] (++
return (applyToSubforest [0] (++
[treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
& rmName .~ "test"
] (UseLabel 0 corridor)]
) t ) <&> (,TreeSubLabelling "sensorRoomRunPast" Nothing)
) t
,TreeSubLabelling "sensorRoomRunPast" Nothing)
--[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink]
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
+2 -2
View File
@@ -50,7 +50,7 @@ powerFakeout = do
`treeFromPost` UseAll door
startRoom :: RandomGen g => Int -> State g (LabSubCompTree Room)
startRoom i = (join $ uncurry takeOneWeighted $ unzip
startRoom i = join (uncurry takeOneWeighted $ unzip
[ (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i])
<&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing))
, (,) one (rezBoxesWp <&> (,TreeSubLabelling "rezBoxesWp" Nothing))
@@ -69,7 +69,7 @@ randomChallenges = join (takeOne
[fmap (return . UseAll) doubleCorridorBarrels <&> (,TreeSubLabelling "doubleCorridorBarrels" Nothing)
,shootingRange
,fmap (return . UseAll) twinSlowDoorChasers <&> (,TreeSubLabelling "twinSlowDoorChasers" Nothing)
]) <&> (over (_2 . topLabel) ("randomChallenges:"++))
]) <&> over (_2 . topLabel) ("randomChallenges:"++)
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
runPastStart i = do