hedgewars/uKeys.pas
author unc0rr
Fri, 01 May 2009 09:01:44 +0000
changeset 2021 a591afb43768
parent 2008 fc2fb5c938c3
child 2152 a2811690da1b
permissions -rw-r--r--
Some changes in try to fix issue when you enter room with painted map, but frontend shows generated one (most probably bug is triggered by template filters) Untested.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     1
(*
1066
1f1b3686a2b0 Update copyright headers a bit
unc0rr
parents: 1051
diff changeset
     2
 * Hedgewars, a free turn based strategy game
883
07a568ba44e0 Update copyright info in source files headers
unc0rr
parents: 846
diff changeset
     3
 * Copyright (c) 2004-2008 Andrey Korotaev <unC0Rr@gmail.com>
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     4
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     8
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
    12
 * GNU General Public License for more details.
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    13
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
    14
 * You should have received a copy of the GNU General Public License
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
    15
 * along with this program; if not, write to the Free Software
57c2ef19f719 Relicense to GPL
unc0rr
parents: 176
diff changeset
    16
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    17
 *)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    18
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    19
unit uKeys;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    20
interface
345
fa39c61be4de Some fixes, revert debug code
unc0rr
parents: 299
diff changeset
    21
uses uConsts;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    22
{$INCLUDE options.inc}
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    23
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    24
type TBinds = array[0..cKeyMaxIndex] of shortstring;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    25
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    26
function KeyNameToCode(name: string): word;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    27
procedure ProcessKbd;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    28
procedure ResetKbd;
948
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
    29
procedure FreezeEnterKey;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    30
procedure InitKbdKeyTable;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    31
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    32
procedure SetBinds(var binds: TBinds);
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    33
procedure SetDefaultBinds;
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    34
161
d8870bbf960e - AmmoMenu
unc0rr
parents: 109
diff changeset
    35
var KbdKeyPressed: boolean;
d8870bbf960e - AmmoMenu
unc0rr
parents: 109
diff changeset
    36
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    37
implementation
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    38
uses SDLh, uTeams, uConsole, uMisc;
109
ab0340f580c2 - Initialize translations earlier
unc0rr
parents: 42
diff changeset
    39
const KeyNumber = 1024;
ab0340f580c2 - Initialize translations earlier
unc0rr
parents: 42
diff changeset
    40
type TKeyboardState = array[0..cKeyMaxIndex] of Byte;
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    41
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    42
var tkbd: TKeyboardState;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    43
    KeyNames: array [0..cKeyMaxIndex] of string[15];
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    44
    DefaultBinds, CurrentBinds: TBinds;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    45
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    46
function KeyNameToCode(name: string): word;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 345
diff changeset
    47
var Result: Word;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    48
begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    49
Result:= cKeyMaxIndex;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 345
diff changeset
    50
while (Result > 0) and (KeyNames[Result] <> name) do dec(Result);
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 345
diff changeset
    51
KeyNameToCode:= Result
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    52
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    53
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    54
procedure ProcessKbd;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    55
var  i: LongInt;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    56
     s: shortstring;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    57
     pkbd: PByteArray;
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    58
     Trusted: boolean;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    59
begin
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    60
KbdKeyPressed:= false;
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
    61
Trusted:= (CurrentTeam <> nil)
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 345
diff changeset
    62
          and (not CurrentTeam^.ExtDriven)
846
08c3f0bc766c Fix bug with handling keys while it is AI's turn
unc0rr
parents: 626
diff changeset
    63
          and (CurrentHedgehog^.BotLevel = 0);
161
d8870bbf960e - AmmoMenu
unc0rr
parents: 109
diff changeset
    64
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    65
pkbd:= SDL_GetKeyState(nil);
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    66
i:= SDL_GetMouseState(nil, nil);
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    67
pkbd^[1]:= (i and 1);
161
d8870bbf960e - AmmoMenu
unc0rr
parents: 109
diff changeset
    68
pkbd^[2]:= ((i shr 1) and 1);
d8870bbf960e - AmmoMenu
unc0rr
parents: 109
diff changeset
    69
pkbd^[3]:= ((i shr 2) and 1);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    70
for i:= 1 to cKeyMaxIndex do
947
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    71
if CurrentBinds[i][0] <> #0 then
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    72
	begin
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    73
	if (i > 3) and (pkbd^[i] <> 0) then KbdKeyPressed:= true;
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    74
	if (tkbd[i] = 0) and (pkbd^[i] <> 0) then ParseCommand(CurrentBinds[i], Trusted)
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    75
	else if (CurrentBinds[i][1] = '+')
948
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
    76
			and (pkbd^[i] = 0)
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
    77
			and (tkbd[i] <> 0) then
947
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    78
			begin
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    79
			s:= CurrentBinds[i];
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    80
			s[1]:= '-';
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    81
			ParseCommand(s, Trusted)
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    82
			end;
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    83
	tkbd[i]:= pkbd^[i]
4e0c3ad89483 - 't' key for entering chat message
unc0rr
parents: 883
diff changeset
    84
	end
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    85
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    86
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    87
procedure ResetKbd;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    88
var i, t: LongInt;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    89
    pkbd: PByteArray;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    90
begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    91
pkbd:= PByteArray(SDL_GetKeyState(@i));
109
ab0340f580c2 - Initialize translations earlier
unc0rr
parents: 42
diff changeset
    92
TryDo(i < cKeyMaxIndex, 'SDL keys number is more than expected (' + inttostr(i) + ')', true);
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    93
for t:= 0 to Pred(i) do
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    94
    tkbd[i]:= pkbd^[i]
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    95
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    96
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    97
procedure InitKbdKeyTable;
371
731ad6d27bd1 integer -> LongInt
unc0rr
parents: 351
diff changeset
    98
var i, t: LongInt;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    99
    s: string[15];
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   100
begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   101
KeyNames[1]:= 'mousel';
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   102
KeyNames[2]:= 'mousem';
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   103
KeyNames[3]:= 'mouser';
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   104
for i:= 4 to cKeyMaxIndex do
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   105
    begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   106
    s:= SDL_GetKeyName(i);
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   107
    if s = 'unknown key' then KeyNames[i]:= ''
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   108
       else begin
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   109
       for t:= 1 to Length(s) do
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   110
           if s[t] = ' ' then s[t]:= '_';
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   111
       KeyNames[i]:= s
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   112
       end;
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   113
    end;
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   114
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   115
DefaultBinds[ 27]:= 'quit';
175
d226d976d836 - Some improvements to volume control
unc0rr
parents: 167
diff changeset
   116
DefaultBinds[ 48]:= '+volup';
d226d976d836 - Some improvements to volume control
unc0rr
parents: 167
diff changeset
   117
DefaultBinds[ 57]:= '+voldown';
2008
fc2fb5c938c3 Patch by koda:
unc0rr
parents: 1066
diff changeset
   118
DefaultBinds[ 44]:= 'history';	// , instead of `
991
d17c71ee074e Enable history (bound on ` key)
unc0rr
parents: 948
diff changeset
   119
DefaultBinds[ 96]:= 'history';
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   120
DefaultBinds[ 99]:= 'capture';
176
533d03041dcd 'h' marks out current hedgehog
unc0rr
parents: 175
diff changeset
   121
DefaultBinds[104]:= 'findhh';
299
098c722e13e1 Allow pause when wathing demos
unc0rr
parents: 183
diff changeset
   122
DefaultBinds[112]:= 'pause';
626
a30171dbcd19 's' key to speed up demo playing
unc0rr
parents: 539
diff changeset
   123
DefaultBinds[115]:= '+speedup';
948
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
   124
DefaultBinds[116]:= 'chat';
1022
f6a3fcb329ca Start exit confirmation implementation
unc0rr
parents: 991
diff changeset
   125
DefaultBinds[121]:= 'confirm';
539
6a9bf1852bbc Ability to choose which info is shown above hedgehogs
unc0rr
parents: 393
diff changeset
   126
DefaultBinds[127]:= 'rotmask';
1051
dfdd5dfe97d4 Enable fullscreen switching back, now it's bound on F12
unc0rr
parents: 1022
diff changeset
   127
dfdd5dfe97d4 Enable fullscreen switching back, now it's bound on F12
unc0rr
parents: 1022
diff changeset
   128
DefaultBinds[KeyNameToCode('f12')]:= 'fullscr';
dfdd5dfe97d4 Enable fullscreen switching back, now it's bound on F12
unc0rr
parents: 1022
diff changeset
   129
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   130
SetDefaultBinds
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   131
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   132
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   133
procedure SetBinds(var binds: TBinds);
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   134
begin
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   135
CurrentBinds:= binds
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   136
end;
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   137
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   138
procedure SetDefaultBinds;
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   139
begin
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   140
CurrentBinds:= DefaultBinds
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   141
end;
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   142
948
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
   143
procedure FreezeEnterKey;
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
   144
begin
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
   145
tkbd[13]:= 1;
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
   146
tkbd[271]:= 1
5d49a92c240a Fix chat behavior
unc0rr
parents: 947
diff changeset
   147
end;
167
805fa9a27e9e "Trusted" binds
unc0rr
parents: 161
diff changeset
   148
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   149
initialization
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   150
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   151
end.