From 3c294fbabd6622b8cd60984d7ed0dd811e8885eb Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 10 Apr 2022 12:06:10 -0400 Subject: feat(grfn/xanthous): Add a help panel Change-Id: I581a37df0a20fa54878da4446007dbe677e057da Reviewed-on: https://cl.tvl.fyi/c/depot/+/5444 Autosubmit: grfn Reviewed-by: grfn Tested-by: BuildkiteCI --- users/grfn/xanthous/src/Xanthous/App.hs | 3 + users/grfn/xanthous/src/Xanthous/Command.hs | 16 ++++- users/grfn/xanthous/src/Xanthous/Data/App.hs | 4 +- users/grfn/xanthous/src/Xanthous/Game/Draw.hs | 81 +++++++++++++++++++++-- users/grfn/xanthous/src/Xanthous/keybindings.yaml | 1 + users/grfn/xanthous/src/Xanthous/messages.yaml | 2 +- 6 files changed, 100 insertions(+), 7 deletions(-) (limited to 'users/grfn/xanthous') 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 = "" + showKey KBS = "" + showKey KEnter = "" + showKey KLeft = "" + showKey KRight = "" + showKey KUp = "" + showKey KDown = "" + showKey KUpLeft = "" + showKey KUpRight = "" + showKey KDownLeft = "" + showKey KDownRight = "" + showKey KCenter = "
" + showKey (KFun n) = " tshow n <> ">" + showKey KBackTab = "" + showKey KPrtScr = "" + showKey KPause = "" + showKey KIns = "" + showKey KHome = "" + showKey KPageUp = "" + showKey KDel = "" + showKey KEnd = "" + showKey KPageDown = "" + showKey KBegin = "" + showKey KMenu = "" 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... -- cgit 1.4.1