about summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--src/Main.hs64
-rw-r--r--src/Xanthous/App.hs15
-rw-r--r--src/Xanthous/Game.hs1
-rw-r--r--src/Xanthous/Game/Lenses.hs13
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)