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!
This commit is contained in:
Griffin Smith 2019-10-12 12:59:42 -04:00
parent d2b81df6b8
commit f1197be186
4 changed files with 68 additions and 25 deletions

View file

@ -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 ()

View file

@ -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

View file

@ -8,6 +8,7 @@ module Xanthous.Game
, GamePromptState(..)
, getInitialState
, initialStateFromSeed
, positionedCharacter
, character

View file

@ -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)