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:
parent
d2b81df6b8
commit
f1197be186
4 changed files with 68 additions and 25 deletions
64
src/Main.hs
64
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 ()
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -8,6 +8,7 @@ module Xanthous.Game
|
|||
, GamePromptState(..)
|
||||
|
||||
, getInitialState
|
||||
, initialStateFromSeed
|
||||
|
||||
, positionedCharacter
|
||||
, character
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue