diff options
-rw-r--r-- | src/Main.hs | 6 | ||||
-rw-r--r-- | src/Xanthous/App.hs | 24 | ||||
-rw-r--r-- | src/Xanthous/Game/Arbitrary.hs | 1 | ||||
-rw-r--r-- | src/Xanthous/Game/Lenses.hs | 1 | ||||
-rw-r--r-- | src/Xanthous/Game/State.hs | 3 |
5 files changed, 17 insertions, 18 deletions
diff --git a/src/Main.hs b/src/Main.hs index b11f1b9f4960..95cfc9edbaff 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -9,7 +9,7 @@ import Control.Exception (finally) import System.Exit (die) -------------------------------------------------------------------------------- import qualified Xanthous.Game as Game -import Xanthous.App (makeApp) +import Xanthous.App import Xanthous.Generators ( GeneratorInput , parseGeneratorInput @@ -94,7 +94,7 @@ thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!" runGame :: RunParams -> IO () runGame rparams = do - app <- makeApp + app <- makeApp NewGame gameSeed <- maybe getRandom pure $ seed rparams when (isNothing $ seed rparams) . putStrLn @@ -113,7 +113,7 @@ runGame rparams = do loadGame :: FilePath -> IO () loadGame saveFile = do - app <- makeApp + app <- makeApp LoadGame gameState <- maybe (die "Invalid save file!") pure =<< Game.loadGame . fromStrict <$> readFile @IO saveFile _game' <- gameState `deepseq` defaultMain app gameState `finally` thanks diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index ab7c8f8e5049..24073c51097a 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -2,7 +2,10 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- -module Xanthous.App (makeApp) where +module Xanthous.App + ( makeApp + , RunType(..) + ) where -------------------------------------------------------------------------------- import Xanthous.Prelude import Brick hiding (App, halt, continue, raw) @@ -66,12 +69,17 @@ import qualified Xanthous.Generators.Dungeon as Dungeon type App = Brick.App GameState () Name -makeApp :: IO App -makeApp = pure $ Brick.App +data RunType = NewGame | LoadGame + deriving stock (Eq) + +makeApp :: RunType -> IO App +makeApp rt = pure $ Brick.App { appDraw = drawGame , appChooseCursor = const headMay , appHandleEvent = \game event -> runAppM (handleEvent event) game - , appStartEvent = runAppM $ startEvent >> get + , appStartEvent = case rt of + NewGame -> runAppM $ startEvent >> get + LoadGame -> pure , appAttrMap = const $ attrMap defAttr [] } @@ -86,12 +94,8 @@ startEvent = do Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable $ \(StringResult s) -> do character . characterName ?= s - whenM (uses sentWelcome not) $ say ["welcome"] =<< use character - sentWelcome .= True - Just n -> - whenM (uses sentWelcome not) $ do - say ["welcome"] $ object [ "characterName" A..= n ] - sentWelcome .= True + say ["welcome"] =<< use character + Just n -> say ["welcome"] $ object [ "characterName" A..= n ] initLevel :: AppM () initLevel = do diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 4a64a12be096..886a8c03d786 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -40,7 +40,6 @@ instance Arbitrary GameState where let _promptState = NoPrompt -- TODO _activePanel <- arbitrary _debugState <- arbitrary - _sentWelcome <- arbitrary pure $ GameState {..} diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index dc886f65c698..017d53652c4f 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -56,7 +56,6 @@ initialStateFromSeed seed = _debugState = DebugState { _allRevealed = False } - _sentWelcome = False in GameState {..} diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 100204c755c3..80137df7a721 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -12,7 +12,6 @@ module Xanthous.Game.State , messageHistory , randomGen , activePanel - , sentWelcome , promptState , characterEntityID , GamePromptState(..) @@ -434,7 +433,6 @@ data GameState = GameState , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory , _randomGen :: !StdGen - , _sentWelcome :: Bool -- | The active panel displayed in the UI, if any , _activePanel :: !(Maybe Panel) @@ -463,7 +461,6 @@ instance Eq GameState where , gs ^. revealedPositions , gs ^. characterEntityID , gs ^. messageHistory - , gs ^. sentWelcome , gs ^. activePanel , gs ^. debugState ) |