From f1197be1867385a98d545f37c21235dfe7985f18 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sat, 12 Oct 2019 12:59:42 -0400
Subject: 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!
---
 src/Xanthous/App.hs         | 15 +++++++++------
 src/Xanthous/Game.hs        |  1 +
 src/Xanthous/Game/Lenses.hs | 13 +++++++++----
 3 files changed, 19 insertions(+), 10 deletions(-)

(limited to 'src/Xanthous')

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)
-- 
cgit 1.4.1