Add log when generating layout

This commit is contained in:
2022-05-20 21:15:44 +01:00
parent 20d041fc59
commit da302aad0c
16 changed files with 155 additions and 94 deletions
+20 -18
View File
@@ -49,25 +49,27 @@ powerFakeout = do
,PassDown keyholeCorridor,PassDown corridor])
`treeFromPost` UseAll door
startRoom :: RandomGen g => Int -> State g (SubCompTree Room,String)
startRoom i = join $ uncurry takeOneWeighted $ unzip
startRoom :: RandomGen g => Int -> State g (LabSubCompTree Room)
startRoom i = (join $ uncurry takeOneWeighted $ unzip
[ (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i])
<&> (,"chainUses <$> sequence [powerFakeout,weaponRoom i]"))
, (,) one (rezBoxesWp <&> (, "rezBoxesWp"))
<&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing))
, (,) one (rezBoxesWp <&> (,TreeSubLabelling "rezBoxesWp" Nothing))
, (,) one (rezBoxThenWeaponRoom i)
, (,) one (rezBoxesWpCrit <&> (,"rezBoxesWpCrit"))
, (,) one (runPastStart i <&> (,"runPastStart " ++ show i))
, (,) one (startCrafts >>= roomsContaining [] >>= rezBoxThenRooms <&>
(,"startCrafts >>= roomsContaining [] >>= rezBoxThenRooms"))
]
, (,) one (rezBoxesWpCrit <&> (,TreeSubLabelling "rezBoxesWpCrit" Nothing))
, (,) one (runPastStart i <&> (,TreeSubLabelling ("runPastStart " ++ show i) Nothing))
, (,) one (startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms <&>
(,TreeSubLabelling "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms" Nothing))
])
<&> over (_2 . topLabel) ("startRoom:"++)
where
roomsContaining' a b = fst <$> roomsContaining a b
one = 1::Float
randomChallenges :: RandomGen g => State g (SubCompTree Room)
randomChallenges = join $ takeOne
[fmap (return . UseAll) doubleCorridorBarrels
randomChallenges :: RandomGen g => State g (LabSubCompTree Room)
randomChallenges = join (takeOne
[fmap (return . UseAll) doubleCorridorBarrels <&> (,TreeSubLabelling "doubleCorridorBarrels" Nothing)
,shootingRange
,fmap (return . UseAll) twinSlowDoorChasers
]
,fmap (return . UseAll) twinSlowDoorChasers <&> (,TreeSubLabelling "twinSlowDoorChasers" Nothing)
]) <&> (over (_2 . topLabel) ("randomChallenges:"++))
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
runPastStart i = do
@@ -83,15 +85,15 @@ rezBoxStart = do
rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (SubCompTree Room,String)
rezBoxesThenWeaponRoom i = do
rboxes <- rezBoxes
wroom <- fmap fst $ weaponRoom i
wroom <- fst <$> weaponRoom i
return (rboxes `passUntilUseAll` [wroom] , "rezBoxesThenWeaponRoom " ++ show i)
rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (SubCompTree Room,String)
rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (LabSubCompTree Room)
rezBoxThenWeaponRoom i = do
rcol <- rezColor
(wroom,wroomname) <- weaponRoom i
return $ (treeFromTrunk [PassDown $ rezBox rcol,PassDown door] wroom
, "rezBoxThenWeaponRoom "++ show i ++ ":" ++ wroomname)
return (treeFromTrunk [PassDown $ rezBox rcol,PassDown door] wroom
, TreeSubLabelling ("rezBoxThenWeaponRoom "++ show i) (Just $ return wroomname))
rezBoxThenRoom :: RandomGen g => Room -> State g (SubCompTree Room)
rezBoxThenRoom r = do