File: Input.hs

package info (click to toggle)
allure 0.11.0.0-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 2,028 kB
  • sloc: haskell: 12,463; makefile: 227
file content (276 lines) | stat: -rw-r--r-- 11,809 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
-- Copyright (c) 2008--2011 Andres Loeh
-- Copyright (c) 2010--2021 Mikolaj Konarski and others (see git history)
-- This file is a part of the computer game Allure of the Stars
-- and is released under the terms of the GNU Affero General Public License.
-- For license and copyright information, see the file LICENSE.
--
-- | 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 $ map evalKeyDef $
  -- 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.
  [ ("I", ( [CmdMinimal, CmdItem, CmdDashboard]
          , "manage the shared inventory stash"
          , ChooseItemMenu (MStore CStash) ))
  , ("O", ( [CmdItem, CmdDashboard]
          , "manage the equipment outfit of the pointman"
          , ChooseItemMenu (MStore CEqp) ))
  , ("g", addCmdCategory CmdMinimal $ grabItems "grab item(s)")
  , ("Escape", ( [CmdMinimal, CmdAim]
               , "clear messages/open main menu/finish aiming"
               , ByAimMode AimModeCmd
                             { exploration = ExecuteIfClear MainMenuAutoOff
                             , aiming = Cancel } ))
  , ("C-Escape", ([], "", MainMenuAutoOn))
      -- required by frontends; not shown
  , ("Return", ( [CmdMinimal, CmdAim]
               , "open dashboard/accept target"
               , ByAimMode AimModeCmd { exploration = Dashboard
                                      , aiming = Accept } ))
  , ("space", ( [CmdMinimal, CmdAim]
              , "clear messages/show history/cycle detail level"
              , ByAimMode AimModeCmd { exploration = ExecuteIfClear AllHistory
                                     , aiming = DetailCycle } ))
  , ("Tab", memberCycle Forward [CmdMinimal, CmdMove])
      -- listed here to keep proper order of the minimal cheat sheet
  , ("BackTab", memberCycle Backward [CmdMove])
  , ("A-Tab", memberCycleLevel Forward [])
  , ("A-BackTab", memberCycleLevel Backward [])
  , ("C-Tab", memberCycleLevel Forward [CmdMove])
  , ("C-BackTab", memberCycleLevel Backward [CmdMove])
  , ("*", ( [CmdMinimal, CmdAim]
          , "cycle crosshair among enemies"
          , AimEnemy ))
  , ("/", ([CmdMinimal, CmdAim], "cycle crosshair among items", AimItem))
  , ("m", ([CmdMove], "modify door by closing it", CloseDir))
  , ("M", ([CmdMinimal, CmdMove], "modify any admissible terrain", AlterDir))
  , ("%", ([CmdMinimal, CmdMeta], "yell or yawn and stop sleeping", Yell))

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

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

  -- Dashboard, in addition to commands marked above
  , ("safeD0", ([CmdInternal, CmdDashboard], "", Cancel))  -- blank line
  ]
  ++
  zipWith (\k slore -> ("safeD" ++ show (k :: Int)
                       , ( [CmdInternal, CmdDashboard]
                         , "display" <+> ppSLore slore <+> "lore"
                           <+> if slore == SEmbed
                               then "(including crafting recipes)"
                               else ""
                        , ChooseItemMenu (MLore slore) )))
          [1..] [minBound..SEmbed]
  ++
  [ ("safeD96", ( [CmdInternal, CmdDashboard]
                , "display place lore"
                , ChooseItemMenu MPlaces) )
  , ("safeD97", ( [CmdInternal, CmdDashboard]
                , "display faction lore"
                , ChooseItemMenu MFactions) )
  , ("safeD98", ( [CmdInternal, CmdDashboard]
                , "display adventure lore"
                , ChooseItemMenu MModes) )
  , ("safeD99", ([CmdInternal, CmdDashboard], "", Cancel))  -- blank line

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

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

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

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

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

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