From 18551cdf30c0a13bce40fae9be829e5318612e71 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Mon, 2 Sep 2019 10:36:15 -0400
Subject: Add a previous message command

Add a "previous message" command, triggered via ctrl+p.

I attempted here to get the message area to still take up a row of space
post-hiding the message, but failed - should revisit that at some point
---
 src/Xanthous/App.hs       |  8 ++++++--
 src/Xanthous/Command.hs   |  5 ++++-
 src/Xanthous/Game.hs      | 12 ++++++++++++
 src/Xanthous/Game/Draw.hs |  8 +++++++-
 4 files changed, 29 insertions(+), 4 deletions(-)

(limited to 'src/Xanthous')

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index c543ad468f6d..3561d35a3bb2 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -35,7 +35,8 @@ startEvent = say ["welcome"]
 handleEvent :: BrickEvent Name () -> AppM (Next GameState)
 handleEvent (VtyEvent (EvKey k mods))
   | Just command <- commandFromKey k mods
-  = handleCommand command
+  = do messageHistory %= hideMessage
+       handleCommand command
 handleEvent _ = continue
 
 handleCommand :: Command -> AppM (Next GameState)
@@ -43,4 +44,7 @@ handleCommand Quit = halt
 handleCommand (Move dir) = do
   characterPosition %= move dir
   continue
-handleCommand _ = error "unimplemented"
+
+handleCommand PreviousMessage = do
+  messageHistory %= popMessage
+  continue
diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs
index 50fe4abb4561..10fa552b342f 100644
--- a/src/Xanthous/Command.hs
+++ b/src/Xanthous/Command.hs
@@ -8,8 +8,8 @@ import Xanthous.Data (Direction(..))
 data Command
   = Quit
   | Move Direction
-  | PickUp
   | PreviousMessage
+  -- | PickUp
 
 commandFromKey :: Key -> [Modifier] -> Maybe Command
 commandFromKey (KChar 'q') [] = Just Quit
@@ -17,4 +17,7 @@ commandFromKey (KChar 'h') [] = Just $ Move Left
 commandFromKey (KChar 'j') [] = Just $ Move Down
 commandFromKey (KChar 'k') [] = Just $ Move Up
 commandFromKey (KChar 'l') [] = Just $ Move Right
+
+commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage
+
 commandFromKey _ _ = Nothing
diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs
index 39066c23b622..dffd0a9c6a6d 100644
--- a/src/Xanthous/Game.hs
+++ b/src/Xanthous/Game.hs
@@ -14,6 +14,8 @@ module Xanthous.Game
 
   , MessageHistory(..)
   , pushMessage
+  , popMessage
+  , hideMessage
   ) where
 
 import           Data.List.NonEmpty ( NonEmpty((:|)))
@@ -43,6 +45,16 @@ pushMessage :: Text -> MessageHistory -> MessageHistory
 pushMessage msg NoMessageHistory = MessageHistory (msg :| []) True
 pushMessage msg (MessageHistory msgs _) = MessageHistory (NonEmpty.cons msg msgs) True
 
+popMessage :: MessageHistory -> MessageHistory
+popMessage NoMessageHistory = NoMessageHistory
+popMessage (MessageHistory msgs False) = MessageHistory msgs True
+popMessage (MessageHistory msgs@(_ :| []) _) = MessageHistory msgs True
+popMessage (MessageHistory (_ :| (msg : msgs)) True) = MessageHistory (msg :| msgs) True
+
+hideMessage :: MessageHistory -> MessageHistory
+hideMessage NoMessageHistory = NoMessageHistory
+hideMessage (MessageHistory msgs _) = MessageHistory msgs False
+
 data GameState = GameState
   { _entities          :: EntityMap SomeEntity
   , _characterEntityID :: EntityID
diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs
index 5a2f773c1b18..6527af743953 100644
--- a/src/Xanthous/Game/Draw.hs
+++ b/src/Xanthous/Game/Draw.hs
@@ -26,7 +26,13 @@ import Xanthous.Orphans ()
 drawMessages :: MessageHistory -> Widget Name
 drawMessages NoMessageHistory = emptyWidget
 drawMessages (MessageHistory _ False) = emptyWidget
-drawMessages (MessageHistory (lastMessage :| _) True) = str $ unpack lastMessage
+drawMessages (MessageHistory (lastMessage :| _) True) = txt lastMessage
+
+-- an attempt to still take up a row even when no messages
+-- drawMessages msgs = vLimit 1 . Widget Greedy Fixed . render $ case msgs of
+--   NoMessageHistory -> padTop (Pad 2) $ str " "
+--   (MessageHistory _ False) -> padTop (Pad 2) $ str " "
+--   (MessageHistory (lastMessage :| _) True) -> txt lastMessage
 
 drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name
 drawEntities em@(fromNullable . positions -> Just entityPositions)
-- 
cgit 1.4.1