Don't run initEvent when loading the game
Rather than having a single sentWelcome boolean, avoid running the initEvent entirely when loading an already-initialized game. Among other things, this stops us from re-generating a level and then merging it with the existing one when the game is loaded (oops).
This commit is contained in:
		
							parent
							
								
									69ccf3a77d
								
							
						
					
					
						commit
						1265155ae4
					
				
					 5 changed files with 17 additions and 18 deletions
				
			
		|  | @ -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 | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -40,7 +40,6 @@ instance Arbitrary GameState where | |||
|     let _promptState = NoPrompt -- TODO | ||||
|     _activePanel <- arbitrary | ||||
|     _debugState <- arbitrary | ||||
|     _sentWelcome <- arbitrary | ||||
|     pure $ GameState {..} | ||||
| 
 | ||||
| 
 | ||||
|  |  | |||
|  | @ -56,7 +56,6 @@ initialStateFromSeed seed = | |||
|       _debugState = DebugState | ||||
|         { _allRevealed = False | ||||
|         } | ||||
|       _sentWelcome = False | ||||
|   in GameState {..} | ||||
| 
 | ||||
| 
 | ||||
|  |  | |||
|  | @ -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 | ||||
|     ) | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue