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