diff options
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/App.hs | 10 | ||||
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/Generators/Level.hs | 10 |
2 files changed, 13 insertions, 7 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs index bf6a63e086..9318c71347 100644 --- a/users/grfn/xanthous/src/Xanthous/App.hs +++ b/users/grfn/xanthous/src/Xanthous/App.hs @@ -568,12 +568,14 @@ showPanel panel = do genLevel :: Word -- ^ Level number, starting at 0 -> AppM Level -genLevel _num = do +genLevel num = do let dims = Dimensions 80 80 generator <- choose $ CaveAutomata :| [Dungeon] - level <- case generator of - CaveAutomata -> generateLevel SCaveAutomata CaveAutomata.defaultParams dims - Dungeon -> generateLevel SDungeon Dungeon.defaultParams dims + let + doGen = case generator of + CaveAutomata -> generateLevel SCaveAutomata CaveAutomata.defaultParams + Dungeon -> generateLevel SDungeon Dungeon.defaultParams + level <- doGen dims num pure $!! level levelToGameLevel :: Level -> GameLevel diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level.hs index 81f21f55ff..ac97159f42 100644 --- a/users/grfn/xanthous/src/Xanthous/Generators/Level.hs +++ b/users/grfn/xanthous/src/Xanthous/Generators/Level.hs @@ -85,7 +85,7 @@ parseGeneratorInput = Opt.subparser generatorCommand sgen name desc parseParams = Opt.command name (Opt.info - (GeneratorInput <$> pure sgen <*> parseParams) + (GeneratorInput sgen <$> parseParams) (Opt.progDesc desc) ) @@ -132,8 +132,9 @@ generateLevel => SGenerator gen -> Params gen -> Dimensions + -> Word -- ^ Level number, starting at 0 -> m Level -generateLevel gen ps dims = do +generateLevel gen ps dims num = do rand <- mkStdGen <$> getRandom let cells = generate gen ps dims rand _levelWalls = cellsToWalls cells @@ -146,7 +147,10 @@ generateLevel gen ps dims = do let upStaircase = _EntityMap # [(_levelCharacterPosition, UpStaircase)] downStaircase <- placeDownStaircase cells let _levelStaircases = upStaircase <> downStaircase - _levelTutorialMessage <- tutorialMessage cells _levelCharacterPosition + _levelTutorialMessage <- + if num == 0 + then tutorialMessage cells _levelCharacterPosition + else pure mempty pure Level {..} levelToEntityMap :: Level -> EntityMap SomeEntity |