Polymorphise meta tree labels

This commit is contained in:
2022-06-13 15:22:15 +01:00
parent 31e7f4290e
commit 7a07fc97c2
19 changed files with 67 additions and 97 deletions
+6 -6
View File
@@ -48,7 +48,7 @@ powerFakeout = do
, keyholeCorridor, corridor])
`treeFromPost` cleatOnward door
startRoom :: RandomGen g => Int -> State g (MetaTree Room)
startRoom :: RandomGen g => Int -> State g (MetaTree Room String)
startRoom i = join (takeOne
[-- (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i])
-- <&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing))
@@ -60,7 +60,7 @@ startRoom i = join (takeOne
-- , startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms
-- >>= rToOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms"
])
randomChallenges :: RandomGen g => State g (MetaTree Room)
randomChallenges :: RandomGen g => State g (MetaTree Room String)
randomChallenges = shootingRange
-- join (takeOne
-- [fmap (return . useAll) doubleCorridorBarrels <&> (,TreeSubLabelling "doubleCorridorBarrels" Nothing)
@@ -80,17 +80,17 @@ rezBoxStart = do
ls <- rezColor
return $ treePost [ rezBox ls, cleatOnward door ]
rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room String)
rezBoxesThenWeaponRoom i = do
rboxes <- rezBoxes
wroom <- weaponRoom i
return $ tToBTree rboxes `attachOnward` wroom
return $ tToBTree "rboxes" rboxes `attachOnward` wroom
rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room String)
rezBoxThenWeaponRoom i = do
rcol <- rezColor
wroom <- weaponRoom i
return $ tToBTree (treePost [rezBox rcol, cleatOnward door]) `attachOnward` wroom
return $ tToBTree "rezbox" (treePost [rezBox rcol, cleatOnward door]) `attachOnward` wroom
rezBoxThenRoom :: RandomGen g => Room -> State g (Tree Room)
rezBoxThenRoom r = do