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:
parent
79aceaec17
commit
3c294fbabd
6 changed files with 100 additions and 7 deletions
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
--
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
q: Quit
|
||||
?: Help
|
||||
.: Wait
|
||||
C-p: PreviousMessage
|
||||
',': PickUp
|
||||
|
|
|
@ -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...
|
||||
|
|
Loading…
Reference in a new issue