-- | The default game key-command mapping to be used for UI. Can be overridden
-- via macros in the config file.
module Client.UI.Content.Input
  ( standardKeysAndMouse
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , applyTs
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Game.LambdaHack.Client.UI.Content.Input
import Game.LambdaHack.Client.UI.HumanCmd
import Game.LambdaHack.Definition.Defs

-- | Description of default key-command bindings.
--
-- In addition to these commands, mouse and keys have a standard meaning
-- when navigating various menus.
standardKeysAndMouse :: InputContentRaw
standardKeysAndMouse :: InputContentRaw
standardKeysAndMouse = [(KM, CmdTriple)] -> InputContentRaw
InputContentRaw ([(KM, CmdTriple)] -> InputContentRaw)
-> [(KM, CmdTriple)] -> InputContentRaw
forall a b. (a -> b) -> a -> b
$ ((String, CmdTriple) -> (KM, CmdTriple))
-> [(String, CmdTriple)] -> [(KM, CmdTriple)]
forall a b. (a -> b) -> [a] -> [b]
map (String, CmdTriple) -> (KM, CmdTriple)
evalKeyDef ([(String, CmdTriple)] -> [(KM, CmdTriple)])
-> [(String, CmdTriple)] -> [(KM, CmdTriple)]
forall a b. (a -> b) -> a -> b
$
  -- All commands are defined here, except some movement and leader picking
  -- commands. All commands are shown on help screens except debug commands
  -- and macros with empty descriptions.
  -- The order below determines the order on the help screens.
  -- Remember to put commands that show information (e.g., enter aiming
  -- mode) first.

  -- Minimal command set, in the desired presentation order.
  -- A lot of these are not necessary, but may be familiar to new players.
  -- Also a few non-minimal item commands to keep proper order.
  [ (String
"I", ( [CmdCategory
CmdMinimal, CmdCategory
CmdItem, CmdCategory
CmdDashboard]
          , Text
"manage the shared inventory stash"
          , ItemDialogMode -> HumanCmd
ChooseItemMenu (CStore -> ItemDialogMode
MStore CStore
CStash) ))
  , (String
"O", ( [CmdCategory
CmdItem, CmdCategory
CmdDashboard]
          , Text
"manage the equipment outfit of the pointman"
          , ItemDialogMode -> HumanCmd
ChooseItemMenu (CStore -> ItemDialogMode
MStore CStore
CEqp) ))
  , (String
"g", CmdCategory -> CmdTriple -> CmdTriple
addCmdCategory CmdCategory
CmdMinimal (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ Text -> CmdTriple
grabItems Text
"grab item(s)")
  , (String
"Escape", ( [CmdCategory
CmdMinimal, CmdCategory
CmdAim]
               , Text
"clear messages/open main menu/finish aiming"
               , AimModeCmd -> HumanCmd
ByAimMode AimModeCmd :: HumanCmd -> HumanCmd -> AimModeCmd
AimModeCmd
                             { exploration :: HumanCmd
exploration = HumanCmd -> HumanCmd
ExecuteIfClear HumanCmd
MainMenuAutoOff
                             , aiming :: HumanCmd
aiming = HumanCmd
Cancel } ))
  , (String
"C-Escape", ([], Text
"", HumanCmd
MainMenuAutoOn))
      -- required by frontends; not shown
  , (String
"Return", ( [CmdCategory
CmdMinimal, CmdCategory
CmdAim]
               , Text
"open dashboard/accept target"
               , AimModeCmd -> HumanCmd
ByAimMode AimModeCmd :: HumanCmd -> HumanCmd -> AimModeCmd
AimModeCmd { exploration :: HumanCmd
exploration = HumanCmd
Dashboard
                                      , aiming :: HumanCmd
aiming = HumanCmd
Accept } ))
  , (String
"space", ( [CmdCategory
CmdMinimal, CmdCategory
CmdAim]
              , Text
"clear messages/show history/cycle detail level"
              , AimModeCmd -> HumanCmd
ByAimMode AimModeCmd :: HumanCmd -> HumanCmd -> AimModeCmd
AimModeCmd { exploration :: HumanCmd
exploration = HumanCmd -> HumanCmd
ExecuteIfClear HumanCmd
LastHistory
                                     , aiming :: HumanCmd
aiming = HumanCmd
DetailCycle } ))
  , (String
"Tab", Direction -> [CmdCategory] -> CmdTriple
memberCycle Direction
Forward [CmdCategory
CmdMinimal, CmdCategory
CmdMove])
      -- listed here to keep proper order of the minimal cheat sheet
  , (String
"BackTab", Direction -> [CmdCategory] -> CmdTriple
memberCycle Direction
Backward [CmdCategory
CmdMove])
  , (String
"A-Tab", Direction -> [CmdCategory] -> CmdTriple
memberCycleLevel Direction
Forward [])
  , (String
"A-BackTab", Direction -> [CmdCategory] -> CmdTriple
memberCycleLevel Direction
Backward [])
  , (String
"C-Tab", Direction -> [CmdCategory] -> CmdTriple
memberCycleLevel Direction
Forward [CmdCategory
CmdMove])
  , (String
"C-BackTab", Direction -> [CmdCategory] -> CmdTriple
memberCycleLevel Direction
Backward [CmdCategory
CmdMove])
  , (String
"*", ( [CmdCategory
CmdMinimal, CmdCategory
CmdAim]
          , Text
"cycle crosshair among enemies"
          , HumanCmd
AimEnemy ))
  , (String
"/", ([CmdCategory
CmdMinimal, CmdCategory
CmdAim], Text
"cycle crosshair among items", HumanCmd
AimItem))
  , (String
"m", ([CmdCategory
CmdMove], Text
"modify door by closing it", HumanCmd
CloseDir))
  , (String
"M", ([CmdCategory
CmdMinimal, CmdCategory
CmdMove], Text
"modify any admissible terrain", HumanCmd
AlterDir))
  , (String
"%", ([CmdCategory
CmdMinimal, CmdCategory
CmdMeta], Text
"yell or yawn and stop sleeping", HumanCmd
Yell))

  -- Item menu, first part of item use commands
  , (String
"comma", Text -> CmdTriple
grabItems Text
"")  -- only show extra key, not extra entry
  , (String
"r", Text -> CmdTriple
dropItems Text
"remove item(s)")
  , (String
"f", CmdCategory -> CmdTriple -> CmdTriple
addCmdCategory CmdCategory
CmdItemMenu (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ [TriggerItem] -> CmdTriple
projectA [TriggerItem]
flingTs)
  , (String
"C-f", CmdCategory -> CmdTriple -> CmdTriple
addCmdCategory CmdCategory
CmdItemMenu
            (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ Text -> CmdTriple -> CmdTriple
replaceDesc Text
"auto-fling and keep choice"
            (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ [TriggerItem] -> CmdTriple
projectI [TriggerItem]
flingTs)
  , (String
"t", CmdCategory -> CmdTriple -> CmdTriple
addCmdCategory CmdCategory
CmdItemMenu (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ [TriggerItem] -> CmdTriple
applyI [TriggerItem]
applyTs)
  , (String
"C-t", CmdCategory -> CmdTriple -> CmdTriple
addCmdCategory CmdCategory
CmdItemMenu
            (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ Text -> CmdTriple -> CmdTriple
replaceDesc Text
"trigger item and keep choice" (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ [TriggerItem] -> CmdTriple
applyIK [TriggerItem]
applyTs)
  , (String
"i", Text -> CmdTriple -> CmdTriple
replaceDesc Text
"stash item into shared inventory"
          (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ [CStore] -> CStore -> Part -> Bool -> CmdTriple
moveItemTriple [CStore
CGround, CStore
CEqp] CStore
CStash Part
"item" Bool
False)
  , (String
"o", Text -> CmdTriple -> CmdTriple
replaceDesc Text
"equip item into outfit of the pointman"
          (CmdTriple -> CmdTriple) -> CmdTriple -> CmdTriple
forall a b. (a -> b) -> a -> b
$ [CStore] -> CStore -> Part -> Bool -> CmdTriple
moveItemTriple [CStore
CGround, CStore
CStash] CStore
CEqp Part
"item" Bool
False)

  -- Remaining @ChooseItemMenu@ instances
  , (String
"G", ( [CmdCategory
CmdItem, CmdCategory
CmdDashboard]
          , Text
"manage items on the ground"
          , ItemDialogMode -> HumanCmd
ChooseItemMenu (CStore -> ItemDialogMode
MStore CStore
CGround) ))
  , (String
"T", ( [CmdCategory
CmdItem, CmdCategory
CmdDashboard]
          , Text
"manage our total team belongings"
          , ItemDialogMode -> HumanCmd
ChooseItemMenu ItemDialogMode
MOwned ))
  , (String
"@", ( [CmdCategory
CmdMeta, CmdCategory
CmdDashboard]
          , Text
"describe organs of the pointman"
          , ItemDialogMode -> HumanCmd
ChooseItemMenu ItemDialogMode
MOrgans ))
  , (String
"#", ( [CmdCategory
CmdMeta, CmdCategory
CmdDashboard]
          , Text
"show skill summary of the pointman"
          , ItemDialogMode -> HumanCmd
ChooseItemMenu ItemDialogMode
MSkills ))
  , (String
"~", ( [CmdCategory
CmdMeta]
          , Text
"display relevant lore"
          , ItemDialogMode -> HumanCmd
ChooseItemMenu (SLore -> ItemDialogMode
MLore SLore
SItem) ))

  -- Dashboard, in addition to commands marked above
  , (String
"safeD0", ([CmdCategory
CmdInternal, CmdCategory
CmdDashboard], Text
"", HumanCmd
Cancel))  -- blank line
  ]
  [(String, CmdTriple)]
-> [(String, CmdTriple)] -> [(String, CmdTriple)]
forall a. [a] -> [a] -> [a]
++
  ((Int, SLore) -> (String, CmdTriple))
-> [(Int, SLore)] -> [(String, CmdTriple)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
k, SLore
slore) -> (String
"safeD" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
k :: Int)
                      , ( [CmdCategory
CmdInternal, CmdCategory
CmdDashboard]
                        , Text
"display" Text -> Text -> Text
<+> SLore -> Text
ppSLore SLore
slore Text -> Text -> Text
<+> Text
"lore"
                        , ItemDialogMode -> HumanCmd
ChooseItemMenu (SLore -> ItemDialogMode
MLore SLore
slore) )))
      ([Int] -> [SLore] -> [(Int, SLore)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [SLore
forall a. Bounded a => a
minBound..SLore
forall a. Bounded a => a
maxBound])
  [(String, CmdTriple)]
-> [(String, CmdTriple)] -> [(String, CmdTriple)]
forall a. [a] -> [a] -> [a]
++
  [ (String
"safeD97", ( [CmdCategory
CmdInternal, CmdCategory
CmdDashboard]
                , Text
"display place lore"
                , ItemDialogMode -> HumanCmd
ChooseItemMenu ItemDialogMode
MPlaces) )
  , (String
"safeD98", ( [CmdCategory
CmdInternal, CmdCategory
CmdDashboard]
                , Text
"display adventure lore"
                , ItemDialogMode -> HumanCmd
ChooseItemMenu ItemDialogMode
MModes) )
  , (String
"safeD99", ([CmdCategory
CmdInternal, CmdCategory
CmdDashboard], Text
"", HumanCmd
Cancel))  -- blank line

  -- Terrain exploration and modification
  , (String
"=", ( [CmdCategory
CmdMove], Text
"select (or deselect) party member", HumanCmd
SelectActor) )
  , (String
"_", ([CmdCategory
CmdMove], Text
"deselect (or select) all on the level", HumanCmd
SelectNone))
  , (String
"semicolon", ( [CmdCategory
CmdMove]
                  , Text
"go to crosshair for 25 steps"
                  , [String] -> HumanCmd
Macro [String
"C-semicolon", String
"C-quotedbl", String
"C-v"] ))
  , (String
"colon", ( [CmdCategory
CmdMove]
              , Text
"run to crosshair collectively for 25 steps"
              , [String] -> HumanCmd
Macro [String
"C-colon", String
"C-quotedbl", String
"C-v"] ))
  , (String
"[", ( [CmdCategory
CmdMove]
          , Text
"explore nearest unknown spot"
          , HumanCmd
autoexploreCmd ))
  , (String
"]", ( [CmdCategory
CmdMove]
          , Text
"autoexplore 25 times"
          , HumanCmd
autoexplore25Cmd ))
  , (String
"R", ([CmdCategory
CmdMove], Text
"rest (wait 25 times)", [String] -> HumanCmd
Macro [String
"KP_Begin", String
"C-v"]))
  , (String
"C-R", ( [CmdCategory
CmdMove], Text
"heed (lurk 0.1 turns 100 times)"
            , [String] -> HumanCmd
Macro [String
"C-KP_Begin", String
"A-v"] ))

  -- Aiming
  , (String
"+", ([CmdCategory
CmdAim], Text
"swerve the aiming line", Direction -> HumanCmd
EpsIncr Direction
Forward))
  , (String
"-", ([CmdCategory
CmdAim], Text
"unswerve the aiming line", Direction -> HumanCmd
EpsIncr Direction
Backward))
  , (String
"\\", ([CmdCategory
CmdAim], Text
"cycle aiming modes", HumanCmd
AimFloor))
  , (String
"C-?", ( [CmdCategory
CmdAim]
            , Text
"set crosshair to nearest unknown spot"
            , HumanCmd
XhairUnknown ))
  , (String
"C-/", ( [CmdCategory
CmdAim]
            , Text
"set crosshair to nearest item"
            , HumanCmd
XhairItem ))
  , (String
"C-{", ( [CmdCategory
CmdAim]
            , Text
"aim at nearest upstairs"
            , Bool -> HumanCmd
XhairStair Bool
True ))
  , (String
"C-}", ( [CmdCategory
CmdAim]
            , Text
"aim at nearest downstairs"
            , Bool -> HumanCmd
XhairStair Bool
False ))
  , (String
"<", ([CmdCategory
CmdAim], Text
"move aiming one level up" , Int -> HumanCmd
AimAscend Int
1))
  , (String
"C-<", ([], Text
"move aiming 10 levels up", Int -> HumanCmd
AimAscend Int
10))
  , (String
">", ([CmdCategory
CmdAim], Text
"move aiming one level down", Int -> HumanCmd
AimAscend (-Int
1)))
      -- 'lower' would be misleading in some games, just as 'deeper'
  , (String
"C->", ([], Text
"move aiming 10 levels down", Int -> HumanCmd
AimAscend (-Int
10)))
  , (String
"BackSpace" , ( [CmdCategory
CmdAim]
                   , Text
"clear chosen item and crosshair"
                   , HumanCmd -> HumanCmd -> HumanCmd
ComposeUnlessError HumanCmd
ClearTargetIfItemClear HumanCmd
ItemClear))

  -- Assorted (first few cloned from main menu)
  , (String
"C-g", ([CmdCategory
CmdMeta], Text
"start new game", HumanCmd
GameRestart))
  , (String
"C-x", ([CmdCategory
CmdMeta], Text
"save and exit to desktop", HumanCmd
GameExit))
  , (String
"C-q", ([CmdCategory
CmdMeta], Text
"quit game and start autoplay", HumanCmd
GameQuit))
  , (String
"C-c", ([CmdCategory
CmdMeta], Text
"exit to desktop without saving", HumanCmd
GameDrop))
  , (String
"?", ([CmdCategory
CmdMeta], Text
"display help", HumanCmd
Hint))
  , (String
"F1", ([CmdCategory
CmdMeta, CmdCategory
CmdDashboard], Text
"display help immediately", HumanCmd
Help))
  , (String
"F12", ([CmdCategory
CmdMeta], Text
"open dashboard", HumanCmd
Dashboard))
  , (String
"v", Int -> [CmdCategory] -> CmdTriple
repeatLastTriple Int
1 [CmdCategory
CmdMeta])
  , (String
"C-v", Int -> [CmdCategory] -> CmdTriple
repeatLastTriple Int
25 [])
  , (String
"A-v", Int -> [CmdCategory] -> CmdTriple
repeatLastTriple Int
100 [])
  , (String
"V", Int -> [CmdCategory] -> CmdTriple
repeatTriple Int
1 [CmdCategory
CmdMeta])
  , (String
"C-V", Int -> [CmdCategory] -> CmdTriple
repeatTriple Int
25 [])
  , (String
"A-V", Int -> [CmdCategory] -> CmdTriple
repeatTriple Int
100 [])
  , (String
"'", ([CmdCategory
CmdMeta], Text
"start recording commands", HumanCmd
Record))
  , (String
"C-S", ([CmdCategory
CmdMeta], Text
"save game backup", HumanCmd
GameSave))
  , (String
"C-P", ([CmdCategory
CmdMeta], Text
"print screen", HumanCmd
PrintScreen))

  -- Dashboard, in addition to commands marked above
  , (String
"safeD101", ([CmdCategory
CmdInternal, CmdCategory
CmdDashboard], Text
"display history", HumanCmd
AllHistory))

  -- Mouse
  , ( String
"LeftButtonRelease"
    , HumanCmd -> Text -> CmdTriple
mouseLMB HumanCmd
goToCmd
               Text
"go to pointer for 25 steps/fling at enemy" )
  , ( String
"S-LeftButtonRelease"
    , HumanCmd -> Text -> CmdTriple
mouseLMB HumanCmd
runToAllCmd
               Text
"run to pointer collectively for 25 steps/fling at enemy" )
  , (String
"RightButtonRelease", CmdTriple
mouseRMB)
  , (String
"C-LeftButtonRelease", Text -> CmdTriple -> CmdTriple
replaceDesc Text
"" CmdTriple
mouseRMB)  -- Mac convention
  , ( String
"S-RightButtonRelease"
    , ([CmdCategory
CmdMouse], Text
"modify terrain at pointer", HumanCmd
AlterWithPointer) )
  , (String
"MiddleButtonRelease", CmdTriple
mouseMMB)
  , (String
"C-RightButtonRelease", Text -> CmdTriple -> CmdTriple
replaceDesc Text
"" CmdTriple
mouseMMB)
  , ( String
"C-S-LeftButtonRelease", let ([CmdCategory]
_, Text
_, HumanCmd
cmd) = CmdTriple
mouseMMB
                               in ([], Text
"", HumanCmd
cmd) )
  , (String
"A-MiddleButtonRelease", CmdTriple
mouseMMBMute)
  , (String
"WheelNorth", ([CmdCategory
CmdMouse], Text
"swerve the aiming line", [String] -> HumanCmd
Macro [String
"+"]))
  , (String
"WheelSouth", ([CmdCategory
CmdMouse], Text
"unswerve the aiming line", [String] -> HumanCmd
Macro [String
"-"]))

  -- Debug and others not to display in help screens
  , (String
"C-semicolon", ( []
                    , Text
"move one step towards the crosshair"
                    , HumanCmd
MoveOnceToXhair ))
  , (String
"C-colon", ( []
                , Text
"run collectively one step towards the crosshair"
                , HumanCmd
RunOnceToXhair ))
  , (String
"C-quotedbl", ( []
                   , Text
"continue towards the crosshair"
                   , HumanCmd
ContinueToXhair ))
  , (String
"C-comma", ([], Text
"run once ahead", HumanCmd
RunOnceAhead))
  , (String
"safe1", ( [CmdCategory
CmdInternal]
              , Text
"go to pointer for 25 steps"
              , HumanCmd
goToCmd ))
  , (String
"safe2", ( [CmdCategory
CmdInternal]
              , Text
"run to pointer collectively"
              , HumanCmd
runToAllCmd ))
  , (String
"safe3", ( [CmdCategory
CmdInternal]
              , Text
"pick new pointman on screen"
              , HumanCmd
PickLeaderWithPointer ))
  , (String
"safe4", ( [CmdCategory
CmdInternal]
              , Text
"select party member on screen"
              , HumanCmd
SelectWithPointer ))
  , (String
"safe5", ( [CmdCategory
CmdInternal]
              , Text
"set crosshair to enemy"
              , HumanCmd
AimPointerEnemy ))
  , (String
"safe6", ( [CmdCategory
CmdInternal]
              , Text
"fling at enemy under pointer"
              , HumanCmd
aimFlingCmd ))
  , (String
"safe7", ( [CmdCategory
CmdInternal, CmdCategory
CmdDashboard]
              , Text
"open main menu"
              , HumanCmd
MainMenuAutoOff ))
  , (String
"safe8", ( [CmdCategory
CmdInternal]
              , Text
"clear msgs and open main menu"
              , HumanCmd -> HumanCmd
ExecuteIfClear HumanCmd
MainMenuAutoOff ))
  , (String
"safe9", ( [CmdCategory
CmdInternal]
              , Text
"cancel aiming"
              , HumanCmd
Cancel ))
  , (String
"safe10", ( [CmdCategory
CmdInternal]
               , Text
"accept target"
               , HumanCmd
Accept ))
  , (String
"safe11", ( [CmdCategory
CmdInternal]
               , Text
"show history"
               , HumanCmd
LastHistory ))
  , (String
"safe12", ( [CmdCategory
CmdInternal]
               , Text
"wait a turn, bracing for impact"
               , HumanCmd
Wait ))
  , (String
"safe13", ( [CmdCategory
CmdInternal]
               , Text
"lurk 0.1 of a turn"
               , HumanCmd
Wait10 ))
  , (String
"safe14", ( [CmdCategory
CmdInternal]
               , Text
"snap crosshair to enemy"
               , HumanCmd
XhairPointerEnemy ))
  ]
  [(String, CmdTriple)]
-> [(String, CmdTriple)] -> [(String, CmdTriple)]
forall a. [a] -> [a] -> [a]
++ (Int -> (String, CmdTriple)) -> [Int] -> [(String, CmdTriple)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (String, CmdTriple)
defaultHeroSelect [Int
0..Int
9]

applyTs :: [TriggerItem]
applyTs :: [TriggerItem]
applyTs = [TriggerItem :: Part -> Part -> String -> TriggerItem
TriggerItem { tiverb :: Part
tiverb = Part
"trigger"
                       , tiobject :: Part
tiobject = Part
"consumable item"
                       , tisymbols :: String
tisymbols = String
"!,?/" }]