diff options
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 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) |