diff options
author | Griffin Smith <root@gws.fyi> | 2019-10-12T16·59-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-10-12T16·59-0400 |
commit | f1197be1867385a98d545f37c21235dfe7985f18 (patch) | |
tree | 21b168d876c70757e7174ff06358080ffe8974b6 /src/Xanthous | |
parent | d2b81df6b882e702e321b55eba85a8bfab1f77c4 (diff) |
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!
Diffstat (limited to 'src/Xanthous')
-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 |
3 files changed, 19 insertions, 10 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index ac0a213f08..7ba4bc673a 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 0ab5425a04..bbcf19ede4 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 101de3021c..f49477a2db 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) |