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 :: 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
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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
|
||||||
--
|
--
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
q: Quit
|
q: Quit
|
||||||
|
?: Help
|
||||||
.: Wait
|
.: Wait
|
||||||
C-p: PreviousMessage
|
C-p: PreviousMessage
|
||||||
',': PickUp
|
',': 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:
|
dead:
|
||||||
- You have died...
|
- You have died...
|
||||||
- You die...
|
- You die...
|
||||||
|
|
Loading…
Reference in a new issue