feat(grfn/xanthous): Add a help panel

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
This commit is contained in:
Griffin Smith 2022-04-10 12:06:10 -04:00 committed by clbot
parent 79aceaec17
commit 3c294fbabd
6 changed files with 100 additions and 7 deletions

View file

@ -135,6 +135,9 @@ handleNoPromptEvent _ = continue
handleCommand :: Command -> AppM (Next GameState) handleCommand :: Command -> AppM (Next GameState)
handleCommand Quit = confirm_ ["quit", "confirm"] (liftIO exitSuccess) >> continue handleCommand Quit = confirm_ ["quit", "confirm"] (liftIO exitSuccess) >> continue
handleCommand Help = showPanel HelpPanel >> continue
handleCommand (Move dir) = do handleCommand (Move dir) = do
newPos <- uses characterPosition $ move dir newPos <- uses characterPosition $ move dir
collisionAt newPos >>= \case collisionAt newPos >>= \case

View file

@ -1,7 +1,10 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
module Xanthous.Command module Xanthous.Command
( Command(..) ( -- * Commands
Command(..)
, commandIsHidden
-- * Keybindings
, Keybinding(..) , Keybinding(..)
, keybindings , keybindings
, commands , commands
@ -29,6 +32,7 @@ import Xanthous.Util.QuickCheck (GenericArbitrary(..))
data Command data Command
= Quit = Quit
| Help
| Move !Direction | Move !Direction
| StartAutoMove !Direction | StartAutoMove !Direction
| PreviousMessage | PreviousMessage
@ -58,6 +62,16 @@ data Command
via WithOptions '[ SumEnc UntaggedVal ] via WithOptions '[ SumEnc UntaggedVal ]
Command 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] data Keybinding = Keybinding !Key ![Modifier]

View file

@ -16,7 +16,9 @@ import Xanthous.Util.QuickCheck
-- | Enum for "panels" displayed in the game's UI. -- | Enum for "panels" displayed in the game's UI.
data Panel 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 InventoryPanel
| -- | A panel describing an item in the inventory in detail | -- | A panel describing an item in the inventory in detail
-- --

View file

@ -27,6 +27,11 @@ import Xanthous.Game
) )
import Xanthous.Game.Prompt import Xanthous.Game.Prompt
import Xanthous.Orphans () 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 cursorPosition :: GameState -> Widget ResourceName -> Widget ResourceName
@ -111,16 +116,84 @@ drawInventoryPanel game
(txtWrap . ((bullet <| " ") <>) . description) (txtWrap . ((bullet <| " ") <>) . description)
backpackItems) 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 :: GameState -> Panel -> Widget ResourceName
drawPanel game panel drawPanel game panel
= border = border
. hLimit 35 . hLimit 35
. viewport (Resource.Panel panel) Vertical . viewport (Resource.Panel panel) Vertical
. case panel of $ case panel of
InventoryPanel -> drawInventoryPanel HelpPanel -> drawHelpPanel
ItemDescriptionPanel desc -> const $ txtWrap desc InventoryPanel -> drawInventoryPanel game
$ game ItemDescriptionPanel desc -> txtWrap desc
drawCharacterInfo :: Character -> Widget ResourceName drawCharacterInfo :: Character -> Widget ResourceName
drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints

View file

@ -1,4 +1,5 @@
q: Quit q: Quit
?: Help
.: Wait .: Wait
C-p: PreviousMessage C-p: PreviousMessage
',': PickUp ',': PickUp

View file

@ -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: dead:
- You have died... - You have died...
- You die... - You die...