first attempt at implementing support for keys with modifiers
authorXeli
Thu, 07 Jun 2012 01:10:57 +0200
changeset 7191 9419294e5f33
parent 7190 aa8d68817c32
child 7192 e6c379b486d5
first attempt at implementing support for keys with modifiers to use it, the keybinding have to be of the form mod:<modkey>:..:<modkey> <function> <keycode> for instance in an ini file change findhh=h to findhh=mod:lshift h
hedgewars/SDLh.pas
hedgewars/uConsts.pas
hedgewars/uInputHandler.pas
hedgewars/uTeams.pas
hedgewars/uTypes.pas
hedgewars/uUtils.pas
--- a/hedgewars/SDLh.pas	Wed Jun 06 17:56:39 2012 -0400
+++ b/hedgewars/SDLh.pas	Thu Jun 07 01:10:57 2012 +0200
@@ -270,6 +270,19 @@
     AShift = 0;
 {$ENDIF}
 
+    KMOD_NONE   = $0000;
+    KMOD_LSHIFT = $0001;
+    KMOD_RSHIFT = $0002;
+    KMOD_LCTRL  = $0040;
+    KMOD_RCTRL  = $0080;
+    KMOD_LALT   = $0100;
+    KMOD_RALT   = $0200;
+    KMOD_LMETA  = $0400;
+    KMOD_RMETA  = $0800;
+    KMOD_NUM    = $1000;
+    KMOD_CAPS   = $2000;
+    KMOD_MODE   = $4000;
+
     {* SDL_mixer *}
     MIX_MAX_VOLUME = 128;
     MIX_INIT_FLAC  = $00000001;
--- a/hedgewars/uConsts.pas	Wed Jun 06 17:56:39 2012 -0400
+++ b/hedgewars/uConsts.pas	Thu Jun 07 01:10:57 2012 +0200
@@ -147,6 +147,7 @@
     cBlowTorchC    = 6;
 
     cKeyMaxIndex = 1023;
+    cKbdMaxIndex = 65536;//need more room for the modifier keys
 
     cHHFileName = 'Hedgehog';
     cCHFileName = 'Crosshair';
--- a/hedgewars/uInputHandler.pas	Wed Jun 06 17:56:39 2012 -0400
+++ b/hedgewars/uInputHandler.pas	Thu Jun 07 01:10:57 2012 +0200
@@ -25,7 +25,9 @@
 procedure initModule;
 procedure freeModule;
 
-function  KeyNameToCode(name: shortstring): word;
+function  KeyNameToCode(name: shortstring; Modifier: shortstring = ''): LongInt;
+procedure MaskModifier(var code: LongInt; modifier: LongWord);
+procedure MaskModifier(Modifier: shortstring; var code: LongInt);
 procedure ProcessMouse(event: TSDL_MouseButtonEvent; ButtonDown: boolean);
 procedure ProcessKey(event: TSDL_KeyboardEvent); inline;
 procedure ProcessKey(code: LongInt; KeyDown: boolean);
@@ -45,37 +47,73 @@
 implementation
 uses uConsole, uCommands, uMisc, uVariables, uConsts, uUtils, uDebug;
 
-var tkbd: array[0..cKeyMaxIndex] of boolean;
+var tkbd: array[0..cKbdMaxIndex] of boolean;
     quitKeyCode: Byte;
     KeyNames: array [0..cKeyMaxIndex] of string[15];
     CurrentBinds: TBinds;
 
-function KeyNameToCode(name: shortstring): word;
-var code: Word;
+function KeyNameToCode(name: shortstring; Modifier: shortstring): LongInt;
+var code: LongInt;
 begin
     name:= LowerCase(name);
     code:= cKeyMaxIndex;
     while (code > 0) and (KeyNames[code] <> name) do dec(code);
+
+
+    MaskModifier(Modifier, code);
+    WriteLnToConsole(inttostr(code));
+
     KeyNameToCode:= code;
 end;
 
+procedure MaskModifier(var code: LongInt; Modifier: LongWord);
+begin
+    WriteLnToConsole(inttostr(code));
+    code:= code or (modifier shl 10);
+    WriteLnToConsole(inttostr(code));
+end;
+
+procedure MaskModifier(Modifier: shortstring; var code: LongInt);
+var mod_ : shortstring;
+    ModifierCount, i: LongInt;
+    c : char;
+begin
+if Modifier = '' then exit;
+ModifierCount:= 0;
+for c in Modifier do
+    if(c = ':') then inc(ModifierCount);
+
+SplitByChar(Modifier, mod_, ':');//remove the first mod: part
+Modifier:= mod_;
+for i:= 0 to ModifierCount do
+    begin 
+    mod_:= '';
+    SplitByChar(Modifier, mod_, ':');
+    WriteLnToConsole(Modifier + ' baaaaa' );
+    if (Modifier = 'lshift')                    then code:= code or (KMOD_LSHIFT shl 10);
+    if (Modifier = 'rshift')                    then code:= code or (KMOD_RSHIFT shl 10);
+    if (Modifier = 'lalt')                      then code:= code or (KMOD_LALT   shl 10);
+    if (Modifier = 'ralt')                      then code:= code or (KMOD_RALT   shl 10);
+    if (Modifier = 'lctrl') or (mod_ = 'lmeta') then code:= code or (KMOD_LCTRL  shl 10);
+    if (Modifier = 'rctrl') or (mod_ = 'rmeta') then code:= code or (KMOD_RCTRL  shl 10);
+    Modifier:= mod_;
+    end;
+end;
+
 procedure ProcessKey(code: LongInt; KeyDown: boolean);
 var
     Trusted: boolean;
     s      : string;
 begin
-
+WriteLnToConsole(inttostr(code) + ' KeyDown:' + inttostr(ord(keydown)) + CurrentBinds[code]) ; 
 if not(tkbd[code] xor KeyDown) then exit;
 tkbd[code]:= KeyDown;
 
-
 hideAmmoMenu:= false;
 Trusted:= (CurrentTeam <> nil)
           and (not CurrentTeam^.ExtDriven)
           and (CurrentHedgehog^.BotLevel = 0);
 
-
-
 // ctrl/cmd + q to close engine and frontend
 if(KeyDown and (code = quitKeyCode)) then
     begin
@@ -109,8 +147,12 @@
 end;
 
 procedure ProcessKey(event: TSDL_KeyboardEvent); inline;
+var code: LongInt;
 begin
-    ProcessKey(event.keysym.sym, event.type_ = SDL_KEYDOWN);
+    code:= event.keysym.sym;
+    MaskModifier(code, event.keysym.modifier);
+    
+    ProcessKey(code, event.type_ = SDL_KEYDOWN);
 end;
 
 procedure ProcessMouse(event: TSDL_MouseButtonEvent; ButtonDown: boolean);
@@ -132,7 +174,7 @@
 procedure ResetKbd;
 var t: LongInt;
 begin
-for t:= 0 to cKeyMaxIndex do
+for t:= 0 to cKbdMaxIndex do
     if tkbd[t] then
         ProcessKey(t, False);
 end;
@@ -248,7 +290,7 @@
     binds:= binds; // avoid hint
     CurrentBinds:= DefaultBinds;
 {$ELSE}
-for t:= 0 to cKeyMaxIndex do
+for t:= 0 to cKbdMaxIndex do
     if (CurrentBinds[t] <> binds[t]) and tkbd[t] then
         ProcessKey(t, False);
 
--- a/hedgewars/uTeams.pas	Wed Jun 06 17:56:39 2012 -0400
+++ b/hedgewars/uTeams.pas	Thu Jun 07 01:10:57 2012 +0200
@@ -552,22 +552,33 @@
 end;
 
 procedure chBind(var id: shortstring);
-var s: shortstring;
+var KeyName, Modifier, tmp: shortstring;
     b: LongInt;
 begin
-s:= '';
+KeyName:= '';
+Modifier:= '';
+
 if CurrentTeam = nil then
     exit;
-SplitBySpace(id, s);
-if s[1]='"' then
-    Delete(s, 1, 1);
-if s[byte(s[0])]='"' then
-    Delete(s, byte(s[0]), 1);
-b:= KeyNameToCode(id);
+
+if(Pos('mod:', id) <> 0)then
+    begin
+    tmp:= '';
+    SplitBySpace(id, tmp);
+    Modifier:= id;
+    id:= tmp;
+    end;
+
+SplitBySpace(id, KeyName);
+if KeyName[1]='"' then
+    Delete(KeyName, 1, 1);
+if KeyName[byte(KeyName[0])]='"' then
+    Delete(KeyName, byte(KeyName[0]), 1);
+b:= KeyNameToCode(id, Modifier);
 if b = 0 then
     OutError(errmsgUnknownVariable + ' "' + id + '"', false)
 else
-    CurrentTeam^.Binds[b]:= s
+    CurrentTeam^.Binds[b]:= KeyName;
 end;
 
 procedure chTeamGone(var s:shortstring);
--- a/hedgewars/uTypes.pas	Wed Jun 06 17:56:39 2012 -0400
+++ b/hedgewars/uTypes.pas	Thu Jun 07 01:10:57 2012 +0200
@@ -308,7 +308,7 @@
         TeamDamage : Longword;
         end;
 
-    TBinds = array[0..cKeyMaxIndex] of shortstring;
+    TBinds = array[0..cKbdMaxIndex] of shortstring;
     TKeyboardState = array[0..cKeyMaxIndex] of Byte;
 
     PVoicepack = ^TVoicepack;
--- a/hedgewars/uUtils.pas	Wed Jun 06 17:56:39 2012 -0400
+++ b/hedgewars/uUtils.pas	Thu Jun 07 01:10:57 2012 +0200
@@ -24,6 +24,7 @@
 uses uTypes, uFloat, GLunit;
 
 procedure SplitBySpace(var a, b: shortstring);
+procedure SplitByChar(var a, b: shortstring; c: char);
 procedure SplitByChar(var a, b: ansistring; c: char);
 
 {$IFNDEF PAS2C}
@@ -83,11 +84,16 @@
 {$ENDIF}
 var CharArray: array[byte] of Char;
 
+procedure SplitBySpace(var a,b: shortstring);
+begin
+SplitByChar(a,b,' ');
+end;
+
 // should this include "strtolower()" for the split string?
-procedure SplitBySpace(var a, b: shortstring);
+procedure SplitByChar(var a, b: shortstring; c : char);
 var i, t: LongInt;
 begin
-i:= Pos(' ', a);
+i:= Pos(c, a);
 if i > 0 then
     begin
     for t:= 1 to Pred(i) do