about summary refs log tree commit diff
path: root/src/Xanthous/Monad.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-10-06T16·50-0400
committerGriffin Smith <root@gws.fyi>2019-10-06T16·50-0400
commitde8052cef8a9f749cdb2312a4f5ae5f5a44cf1b8 (patch)
tree734d38ad7279b0188b46f67e0288c5efddab7f8e /src/Xanthous/Monad.hs
parent262fc7fb41f14181ed34cecfcca9ef2d25102688 (diff)
Allow eating edible items
Add menu support to the prompt system, and an "Eat" command that prompts
for an item to eat and eats the item the character specifies, restoring
an amount of hitpoints configurable via the item raw type.
Diffstat (limited to 'src/Xanthous/Monad.hs')
-rw-r--r--src/Xanthous/Monad.hs37
1 files changed, 27 insertions, 10 deletions
diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs
index 3e567ee8fa5e..c11cb0e2d4df 100644
--- a/src/Xanthous/Monad.hs
+++ b/src/Xanthous/Monad.hs
@@ -1,22 +1,28 @@
+--------------------------------------------------------------------------------
 module Xanthous.Monad
   ( AppT(..)
   , AppM
   , runAppT
   , continue
   , halt
+    -- * Messages
   , say
   , say_
+  , message
+  , message_
   ) where
-
-import Xanthous.Prelude
-import Control.Monad.Random
-import Control.Monad.State
+--------------------------------------------------------------------------------
+import           Xanthous.Prelude
+import           Control.Monad.Random
+import           Control.Monad.State
 import qualified Brick
-import Brick (EventM, Next)
-import Data.Aeson
-
-import Xanthous.Game.State
-import Xanthous.Messages (message)
+import           Brick (EventM, Next)
+import           Data.Aeson
+--------------------------------------------------------------------------------
+import           Xanthous.Game.State
+import           Xanthous.Messages (Message)
+import qualified Xanthous.Messages as Messages
+--------------------------------------------------------------------------------
 
 runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState)
 runAppT appt initialState = flip runStateT initialState . unAppT $ appt
@@ -27,12 +33,23 @@ halt = lift . Brick.halt =<< get
 continue :: AppT (EventM n) (Next GameState)
 continue = lift . Brick.continue =<< get
 
+--------------------------------------------------------------------------------
 
 say :: (MonadRandom m, ToJSON params, MonadState GameState m)
     => [Text] -> params -> m ()
 say msgPath params = do
-  msg <- message msgPath params
+  msg <- Messages.message msgPath params
   messageHistory %= pushMessage msg
 
 say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m ()
 say_ msgPath = say msgPath $ object []
+
+message :: (MonadRandom m, ToJSON params, MonadState GameState m)
+        => Message -> params -> m ()
+message msg params = do
+  m <- Messages.render msg params
+  messageHistory %= pushMessage m
+
+message_ :: (MonadRandom m, MonadState GameState m)
+         => Message ->  m ()
+message_ msg = message msg $ object []