feat(grfn/xanthous): Add a help panel r/3945

Change-Id: I581a37df0a20fa54878da4446007dbe677e057da
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5444
Autosubmit: grfn <grfn@gws.fyi>
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI

6 files changed, 100 insertions, 7 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs
index a251833955..d4ffb22630 100644
--- a/users/grfn/xanthous/src/Xanthous/App.hs
+++ b/users/grfn/xanthous/src/Xanthous/App.hs
@@ -135,6 +135,9 @@ handleNoPromptEvent _ = continue
 
 handleCommand :: Command -> AppM (Next GameState)
 handleCommand Quit = confirm_ ["quit", "confirm"] (liftIO exitSuccess) >> continue
+
+handleCommand Help = showPanel HelpPanel >> continue
+
 handleCommand (Move dir) = do
   newPos <- uses characterPosition $ move dir
   collisionAt newPos >>= \case
diff --git a/users/grfn/xanthous/src/Xanthous/Command.hs b/users/grfn/xanthous/src/Xanthous/Command.hs
index 30ed86ee40..6e6274a02c 100644
--- a/users/grfn/xanthous/src/Xanthous/Command.hs
+++ b/users/grfn/xanthous/src/Xanthous/Command.hs
@@ -1,7 +1,10 @@
 {-# LANGUAGE TemplateHaskell #-}
 --------------------------------------------------------------------------------
 module Xanthous.Command
-  ( Command(..)
+  ( -- * Commands
+    Command(..)
+  , commandIsHidden
+    -- * Keybindings
   , Keybinding(..)
   , keybindings
   , commands
@@ -29,6 +32,7 @@ import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
 
 data Command
   = Quit
+  | Help
   | Move !Direction
   | StartAutoMove !Direction
   | PreviousMessage
@@ -58,6 +62,16 @@ data Command
        via WithOptions '[ SumEnc UntaggedVal ]
            Command
 
+-- | Should the command be hidden from the help menu?
+--
+-- Note that this is true for both debug commands and movement commands, as the
+-- latter is documented non-automatically
+commandIsHidden :: Command -> Bool
+commandIsHidden (Move _) = True
+commandIsHidden (StartAutoMove _) = True
+commandIsHidden ToggleRevealAll = True
+commandIsHidden _ = False
+
 --------------------------------------------------------------------------------
 
 data Keybinding = Keybinding !Key ![Modifier]
diff --git a/users/grfn/xanthous/src/Xanthous/Data/App.hs b/users/grfn/xanthous/src/Xanthous/Data/App.hs
index a2cfcb8001..13c4b5d610 100644
--- a/users/grfn/xanthous/src/Xanthous/Data/App.hs
+++ b/users/grfn/xanthous/src/Xanthous/Data/App.hs
@@ -16,7 +16,9 @@ import Xanthous.Util.QuickCheck
 
 -- | Enum for "panels" displayed in the game's UI.
 data Panel
-  = -- | A panel displaying the character's inventory
+  = -- | A panel providing help with the game's commands
+    HelpPanel
+  | -- | A panel displaying the character's inventory
     InventoryPanel
   | -- | A panel describing an item in the inventory in detail
     --
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs
index 53ea1c96f8..291dfd8b5e 100644
--- a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs
+++ b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs
@@ -27,6 +27,11 @@ import           Xanthous.Game
                  )
 import           Xanthous.Game.Prompt
 import           Xanthous.Orphans ()
+import Brick.Widgets.Center (hCenter)
+import Xanthous.Command (Keybinding (..), keybindings, Command, commandIsHidden)
+import Graphics.Vty.Input.Events (Modifier(..))
+import Graphics.Vty.Input (Key(..))
+import Brick.Widgets.Table
 --------------------------------------------------------------------------------
 
 cursorPosition :: GameState -> Widget ResourceName -> Widget ResourceName
@@ -111,16 +116,84 @@ drawInventoryPanel game
               (txtWrap . ((bullet <| " ") <>) . description)
               backpackItems)
 
+drawHelpPanel :: Widget ResourceName
+drawHelpPanel
+  = txtWrap "To move in a direction or attack, use vi keys (hjklyubn):"
+  <=> txt " "
+  <=> hCenter keyStar
+  <=> txt " "
+  <=> cmds
+  where
+    keyStar
+      =   txt "y k u"
+      <=> txt " \\|/"
+      <=> txt "h-.-l"
+      <=> txt " /|\\"
+      <=> txt "b j n"
+
+    cmds
+      = renderTable
+      . alignRight 0
+      . setDefaultRowAlignment AlignTop
+      . surroundingBorder False
+      . rowBorders False
+      . columnBorders False
+      . table $ help <&> \(key, cmd) -> [ txt $ key <> " : "
+                                       , hLimitPercent 100 $ txtWrap cmd]
+
+    help =
+      extraHelp <>
+      keybindings
+        ^.. ifolded
+          . filtered (not . commandIsHidden)
+          . withIndex
+          . to (bimap displayKeybinding displayCommand)
+    extraHelp
+      = [("Shift-Dir", "Auto-move")]
+
+    displayCommand = tshow @Command
+    displayKeybinding (Keybinding k mods) = foldMap showMod mods <> showKey k
+
+    showMod MCtrl  = "Ctrl-"
+    showMod MShift = "Shift-"
+    showMod MAlt   = "Alt-"
+    showMod MMeta  = "Meta-"
+
+    showKey (KChar c) = pack [c]
+    showKey KEsc = "<Esc>"
+    showKey KBS = "<Backspace>"
+    showKey KEnter = "<Enter>"
+    showKey KLeft = "<Left>"
+    showKey KRight = "<Right>"
+    showKey KUp = "<Up>"
+    showKey KDown = "<Down>"
+    showKey KUpLeft = "<UpLeft>"
+    showKey KUpRight = "<UpRight>"
+    showKey KDownLeft = "<DownLeft>"
+    showKey KDownRight = "<DownRight>"
+    showKey KCenter = "<Center>"
+    showKey (KFun n) = "<F" <> tshow n <> ">"
+    showKey KBackTab = "<BackTab>"
+    showKey KPrtScr = "<PrtScr>"
+    showKey KPause = "<Pause>"
+    showKey KIns = "<Ins>"
+    showKey KHome = "<Home>"
+    showKey KPageUp = "<PageUp>"
+    showKey KDel = "<Del>"
+    showKey KEnd = "<End>"
+    showKey KPageDown = "<PageDown>"
+    showKey KBegin = "<Begin>"
+    showKey KMenu = "<Menu>"
 
 drawPanel :: GameState -> Panel -> Widget ResourceName
 drawPanel game panel
   = border
   . hLimit 35
   . viewport (Resource.Panel panel) Vertical
-  . case panel of
-      InventoryPanel -> drawInventoryPanel
-      ItemDescriptionPanel desc -> const $ txtWrap desc
-  $ game
+  $ case panel of
+      HelpPanel -> drawHelpPanel
+      InventoryPanel -> drawInventoryPanel game
+      ItemDescriptionPanel desc -> txtWrap desc
 
 drawCharacterInfo :: Character -> Widget ResourceName
 drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints
diff --git a/users/grfn/xanthous/src/Xanthous/keybindings.yaml b/users/grfn/xanthous/src/Xanthous/keybindings.yaml
index 29a52d2798..cffb27cb03 100644
--- a/users/grfn/xanthous/src/Xanthous/keybindings.yaml
+++ b/users/grfn/xanthous/src/Xanthous/keybindings.yaml
@@ -1,4 +1,5 @@
 q: Quit
+?: Help
 .: Wait
 C-p: PreviousMessage
 ',': PickUp
diff --git a/users/grfn/xanthous/src/Xanthous/messages.yaml b/users/grfn/xanthous/src/Xanthous/messages.yaml
index 27ee841dd9..62cb033d0c 100644
--- a/users/grfn/xanthous/src/Xanthous/messages.yaml
+++ b/users/grfn/xanthous/src/Xanthous/messages.yaml
@@ -1,4 +1,4 @@
-welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? Use hjklybnu to move.
+welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? Press ? for help.
 dead:
   - You have died...
   - You die...