From 71b628c604556bc2d829f12980db99c9a526ec84 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sat, 30 Nov 2019 19:55:43 -0500
Subject: Add messages on the ground

Add support for a "GroundMessage" entity type, support for a Read
command to read them, and randomly place an initial, tone-setting
tutorial message on the ground near the character at the beginning of
the game.
---
 src/Xanthous/App.hs | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

(limited to 'src/Xanthous/App.hs')

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index b8cda3b77721..df76eadc3bbc 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -44,7 +44,8 @@ import           Xanthous.Entities.Item (Item)
 import qualified Xanthous.Entities.Item as Item
 import           Xanthous.Entities.Creature (Creature)
 import qualified Xanthous.Entities.Creature as Creature
-import           Xanthous.Entities.Environment (Door, open, locked)
+import           Xanthous.Entities.Environment
+                 (Door, open, locked, GroundMessage(..))
 import           Xanthous.Entities.RawTypes (edible, eatMessage, hitpointsHealed)
 import           Xanthous.Generators
 import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
@@ -84,6 +85,7 @@ initLevel = do
   entities <>= (SomeEntity <$> level ^. levelWalls)
   entities <>= (SomeEntity <$> level ^. levelItems)
   entities <>= (SomeEntity <$> level ^. levelCreatures)
+  entities <>= (SomeEntity <$> level ^. levelTutorialMessage)
 
   characterPosition .= level ^. levelCharacterPosition
 
@@ -206,6 +208,29 @@ handleCommand Eat = do
   stepGame -- TODO
   continue
 
+handleCommand Read = do
+  -- TODO allow reading things in the inventory (combo direction+menu prompt?)
+  prompt_ @'DirectionPrompt ["read", "prompt"] Cancellable
+    $ \(DirectionResult dir) -> do
+      pos <- uses characterPosition $ move dir
+      uses entities
+        (fmap snd . entitiesAtPositionWithType @GroundMessage pos) >>= \case
+          Empty -> say_ ["read", "nothing"]
+          GroundMessage msg :< Empty ->
+            say ["read", "result"] $ object ["message" A..= msg]
+          msgs ->
+            let readAndContinue Empty = pure ()
+                readAndContinue (msg :< msgs') =
+                  prompt @'Continue
+                    ["read", "result"]
+                    (object ["message" A..= msg])
+                    Cancellable
+                  . const
+                  $ readAndContinue msgs'
+                readAndContinue _ = error "this is total"
+            in readAndContinue msgs
+  continue
+
 handleCommand Save = do
   -- TODO default save locations / config file?
   prompt_ @'StringPrompt ["save", "location"] Cancellable
@@ -413,3 +438,5 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem
 
 -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity)
 -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity
+
+--------------------------------------------------------------------------------
-- 
cgit 1.4.1