diff options
| -rw-r--r-- | src/Main.hs | 64 | ||||
| -rw-r--r-- | src/Xanthous/App.hs | 15 | ||||
| -rw-r--r-- | src/Xanthous/Game.hs | 1 | ||||
| -rw-r--r-- | src/Xanthous/Game/Lenses.hs | 13 |
4 files changed, 68 insertions, 25 deletions
diff --git a/src/Main.hs b/src/Main.hs index 547dc92f4023..61640c364654 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 ac0a213f08a1..7ba4bc673ace 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 0ab5425a04f4..bbcf19ede4af 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 101de3021c48..f49477a2db23 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) |