From f1197be1867385a98d545f37c21235dfe7985f18 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 12 Oct 2019 12:59:42 -0400 Subject: Allow specifying seed on startup Allow specifying the seed for the game's global RNG on startup, and print the seed when the game exits. This'll allow us to more reliably reproduce bugs - yay! --- src/Main.hs | 64 ++++++++++++++++++++++++++++++++++----------- src/Xanthous/App.hs | 15 ++++++----- src/Xanthous/Game.hs | 1 + src/Xanthous/Game/Lenses.hs | 13 ++++++--- 4 files changed, 68 insertions(+), 25 deletions(-) (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index 547dc92f40..61640c3646 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,25 +1,50 @@ module Main ( main ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (finally) import Brick import qualified Options.Applicative as Opt import System.Random +import Control.Monad.Random (getRandom) +import Control.Exception (finally) -------------------------------------------------------------------------------- -import Xanthous.Game (getInitialState) +import qualified Xanthous.Game as Game import Xanthous.App (makeApp) import Xanthous.Generators - ( GeneratorInput - , parseGeneratorInput - , generateFromInput - , showCells - ) + ( GeneratorInput + , parseGeneratorInput + , generateFromInput + , showCells + ) +import qualified Xanthous.Entities.Character as Character import Xanthous.Generators.Util (regions) import Xanthous.Generators.LevelContents import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) import Data.Array.IArray ( amap ) -------------------------------------------------------------------------------- + +data RunParams = RunParams + { seed :: Maybe Int + , characterName :: Maybe Text + } + deriving stock (Show, Eq) + +parseRunParams :: Opt.Parser RunParams +parseRunParams = RunParams + <$> optional (Opt.option Opt.auto + ( Opt.long "seed" + <> Opt.help "Random seed for the game." + )) + <*> optional (Opt.strOption + ( Opt.short 'n' + <> Opt.long "name" + <> Opt.help + ( "Name for the character. If not set on the command line, " + <> "will be prompted for at runtime" + ) + )) + data Command - = Run + = Run RunParams | Generate GeneratorInput Dimensions parseDimensions :: Opt.Parser Dimensions @@ -34,10 +59,10 @@ parseDimensions = Dimensions ) parseCommand :: Opt.Parser Command -parseCommand = (<|> pure Run) $ Opt.subparser +parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser $ Opt.command "run" (Opt.info - (pure Run) + (Run <$> parseRunParams) (Opt.progDesc "Run the game")) <> Opt.command "generate" (Opt.info @@ -53,11 +78,20 @@ optParser = Opt.info (parseCommand <**> Opt.helper) (Opt.header "Xanthous: a WIP TUI RPG") -runGame :: IO () -runGame = do +runGame :: RunParams -> IO () +runGame rparams = do app <- makeApp - initialState <- getInitialState - _ <- defaultMain app initialState + gameSeed <- maybe getRandom pure $ seed rparams + let initialState = Game.initialStateFromSeed gameSeed &~ do + for_ (characterName rparams) $ \cn -> + Game.character . Character.characterName ?= cn + _game' <- defaultMain app initialState `finally` do + putStr "\n\n" + putStrLn "Thanks for playing Xanthous!" + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed + putStr "\n\n" pure () runGenerate :: GeneratorInput -> Dimensions -> IO () @@ -74,7 +108,7 @@ runGenerate input dims = do putStrLn $ showCells res runCommand :: Command -> IO () -runCommand Run = runGame +runCommand (Run runParams) = runGame runParams runCommand (Generate input dims) = runGenerate input dims main :: IO () diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index ac0a213f08..7ba4bc673a 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -64,10 +64,12 @@ startEvent :: AppM () startEvent = do initLevel modify updateCharacterVision - prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable - $ \(StringResult s) -> do - character . characterName ?= s - say ["welcome"] =<< use character + use (character . characterName) >>= \case + Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable + $ \(StringResult s) -> do + character . characterName ?= s + say ["welcome"] =<< use character + Just n -> say ["welcome"] $ object [ "characterName" A..= n ] initLevel :: AppM () initLevel = do @@ -178,6 +180,7 @@ handleCommand Eat = do character . characterHitpoints += edibleItem ^. hitpointsHealed . to fromIntegral message msg $ object ["item" A..= item] + stepGame continue handleCommand ToggleRevealAll = do @@ -201,11 +204,11 @@ handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = handlePromptEvent msg - (Prompt c SStringPrompt (StringPromptState edit) pi cb) + (Prompt c SStringPrompt (StringPromptState edit) pri cb) (VtyEvent ev) = do edit' <- lift $ handleEditorEvent ev edit - let prompt' = Prompt c SStringPrompt (StringPromptState edit') pi cb + let prompt' = Prompt c SStringPrompt (StringPromptState edit') pri cb promptState .= WaitingPrompt msg prompt' continue diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index 0ab5425a04..bbcf19ede4 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -8,6 +8,7 @@ module Xanthous.Game , GamePromptState(..) , getInitialState + , initialStateFromSeed , positionedCharacter , character diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 101de3021c..f49477a2db 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -6,6 +6,7 @@ module Xanthous.Game.Lenses , characterPosition , updateCharacterVision , getInitialState + , initialStateFromSeed -- * Collisions , Collision(..) @@ -16,6 +17,7 @@ import Xanthous.Prelude -------------------------------------------------------------------------------- import System.Random import Control.Monad.State +import Control.Monad.Random (getRandom) -------------------------------------------------------------------------------- import Xanthous.Game.State import Xanthous.Data @@ -28,9 +30,12 @@ import Xanthous.Entities.Creature (Creature) -------------------------------------------------------------------------------- getInitialState :: IO GameState -getInitialState = do - _randomGen <- getStdGen - let char = mkCharacter +getInitialState = initialStateFromSeed <$> getRandom + +initialStateFromSeed :: Int -> GameState +initialStateFromSeed seed = + let _randomGen = mkStdGen seed + char = mkCharacter (_characterEntityID, _entities) = EntityMap.insertAtReturningID (Position 0 0) @@ -42,7 +47,7 @@ getInitialState = do _debugState = DebugState { _allRevealed = False } - pure GameState {..} + in GameState {..} positionedCharacter :: Lens' GameState (Positioned Character) -- cgit 1.4.1