about summary refs log tree commit diff
path: root/src/Xanthous
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xanthous')
-rw-r--r--src/Xanthous/App.hs15
-rw-r--r--src/Xanthous/Game.hs1
-rw-r--r--src/Xanthous/Game/Lenses.hs13
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)