src/game/g_holmes_cmd.inc

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 // ////////////////////////////////////////////////////////////////////////// //
  17 type
  18   TBindArgLessCB = procedure ();
  19   TBindToggleCB = procedure (arg: Integer); // -1: no arg
  20
  21   PHolmesCommand = ^THolmesCommand;
  22   THolmesCommand = record
  23   public
  24     type TType = (TArgLess, TToggle);
  25
  26   public
  27     name: AnsiString;
  28     help: AnsiString;
  29     section: AnsiString;
  30     cb: Pointer;
  31     ctype: TType;
  32     helpmark: Boolean;
  33
  34     // command name already taken
  35     procedure execute (pr: TTextParser);
  36   end;
  37
  38   PHolmesBinding = ^THolmesBinding;
  39   THolmesBinding = record
  40     key: AnsiString; // or mouse
  41     cmd: AnsiString;
  42
  43     function cmdName (): AnsiString;
  44   end;
  45
  46   TCmdHash = specialize THashBase<AnsiString, PHolmesCommand>;
  47
  48
  49 // ////////////////////////////////////////////////////////////////////////// //
  50 function THolmesBinding.cmdName (): AnsiString;
  51 var
  52   pr: TTextParser = nil;
  53 begin
  54   result := '';
  55   try
  56     pr := TStrTextParser.Create(cmd);
  57     if (pr.tokType = pr.TTStr) then result := pr.expectStr(false) else result := pr.expectId();
  58   except on E: Exception do
  59     begin
  60       result := '';
  61     end;
  62   end;
  63   pr.Free();
  64 end;
  65
  66
  67 // ////////////////////////////////////////////////////////////////////////// //
  68 // command name already taken
  69 procedure THolmesCommand.execute (pr: TTextParser);
  70 var
  71   a: Integer = -1;
  72 begin
  73   if not assigned(cb) then exit;
  74   if (ctype = TType.TToggle) then
  75   begin
  76     if pr.skipBlanks() then
  77     begin
  78            if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then a := 1
  79       else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then a := 0
  80       else begin conwritefln('%s: invalid argument', [name]); exit; end;
  81     end;
  82   end;
  83   if pr.skipBlanks() then begin conwritefln('%s: too many arguments', [name]); exit; end;
  84   case ctype of
  85     TType.TArgLess: TBindArgLessCB(cb)();
  86     TType.TToggle: TBindToggleCB(cb)(a);
  87     else assert(false);
  88   end;
  89 end;
  90
  91
  92 // ////////////////////////////////////////////////////////////////////////// //
  93 function ansistrEquCB (constref a, b: AnsiString): Boolean; begin result := (a = b); end;
  94 function ansistrHashCB (constref a: AnsiString): LongWord; begin if (Length(a) > 0) then result := fnvHash(PChar(a)^, Length(a)) else result := 0; end;
  95
  96 function hashNewCommand (): TCmdHash;
  97 begin
  98   result := TCmdHash.Create(ansistrHashCB, ansistrEquCB);
  99 end;
 100
 101
 102 // ////////////////////////////////////////////////////////////////////////// //
 103 type
 104   PHBA = ^THBA;
 105   THBA = array of THolmesBinding;
 106
 107
 108 var
 109   cmdlist: TCmdHash = nil;
 110   keybinds: THBA = nil;
 111   msbinds: THBA = nil;
 112   keybindsInited: Boolean = false;
 113
 114
 115 // ////////////////////////////////////////////////////////////////////////// //
 116 function cmdNewInternal (const aname: AnsiString; const ahelp: AnsiString; const asection: AnsiString): PHolmesCommand;
 117 begin
 118   if (cmdlist = nil) then cmdlist := hashNewCommand();
 119   if not cmdlist.get(aname, result) then
 120   begin
 121     GetMem(result, sizeof(THolmesCommand));
 122     FillChar(result^, sizeof(THolmesCommand), 0);
 123     result.name := aname;
 124     result.help := ahelp;
 125     result.section := asection;
 126     result.cb := nil;
 127     result.ctype := result.TType.TArgLess;
 128     cmdlist.put(aname, result);
 129   end
 130   else
 131   begin
 132     result.help := ahelp;
 133     result.section := asection;
 134   end;
 135 end;
 136
 137
 138 procedure cmdAdd (const aname: AnsiString; cb: TBindArgLessCB; const ahelp: AnsiString; const asection: AnsiString); overload;
 139 var
 140   cmd: PHolmesCommand;
 141 begin
 142   if (Length(aname) = 0) or not assigned(cb) then exit;
 143   cmd := cmdNewInternal(aname, ahelp, asection);
 144   cmd.cb := Pointer(@cb);
 145   cmd.ctype := cmd.TType.TArgLess;
 146 end;
 147
 148
 149 procedure cmdAdd (const aname: AnsiString; cb: TBindToggleCB; const ahelp: AnsiString; const asection: AnsiString); overload;
 150 var
 151   cmd: PHolmesCommand;
 152 begin
 153   if (Length(aname) = 0) or not assigned(cb) then exit;
 154   cmd := cmdNewInternal(aname, ahelp, asection);
 155   cmd.cb := Pointer(@cb);
 156   cmd.ctype := cmd.TType.TToggle;
 157 end;
 158
 159
 160 function getCommandHelp (const aname: AnsiString): AnsiString;
 161 var
 162   cmd: PHolmesCommand = nil;
 163 begin
 164   if not cmdlist.get(aname, cmd) then result := '' else result := cmd.help;
 165 end;
 166
 167
 168 function getCommandSection (const aname: AnsiString): AnsiString;
 169 var
 170   cmd: PHolmesCommand = nil;
 171 begin
 172   if not cmdlist.get(aname, cmd) then result := '' else result := cmd.section;
 173 end;
 174
 175
 176 // ////////////////////////////////////////////////////////////////////////// //
 177 function internalBindAdd (ba: PHBA; const akey: AnsiString; const acmd: AnsiString): Boolean;
 178 var
 179   f, c: Integer;
 180 begin
 181   for f := 0 to High(ba^) do
 182   begin
 183     if (CompareText(ba^[f].key, akey) = 0) then
 184     begin
 185       if (Length(acmd) = 0) then
 186       begin
 187         // remove
 188         result := false;
 189         for c := f+1 to High(ba^) do ba^[c-1] := ba^[c];
 190         SetLength(ba^, Length(ba^)-1);
 191       end
 192       else
 193       begin
 194         // replace
 195         result := true;
 196         ba^[f].cmd := acmd;
 197       end;
 198       exit;
 199     end;
 200   end;
 201   if (Length(acmd) > 0) then
 202   begin
 203     result := true;
 204     SetLength(ba^, Length(ba^)+1);
 205     ba^[High(ba^)].key := akey;
 206     ba^[High(ba^)].cmd := acmd;
 207   end
 208   else
 209   begin
 210     result := false;
 211   end;
 212 end;
 213
 214
 215 procedure keybindAdd (const akey: AnsiString; const acmd: AnsiString);
 216 begin
 217   internalBindAdd(@keybinds, akey, acmd);
 218   keybindsInited := true;
 219 end;
 220
 221 procedure msbindAdd (const akey: AnsiString; const acmd: AnsiString);
 222 begin
 223   internalBindAdd(@msbinds, akey, acmd);
 224   keybindsInited := true;
 225 end;
 226
 227
 228 procedure execCommand (const s: AnsiString);
 229 var
 230   pr: TTextParser = nil;
 231   cmd: AnsiString;
 232   cc: PHolmesCommand;
 233 begin
 234   if (cmdlist = nil) then
 235   begin
 236     conwriteln('holmes command system is not initialized!');
 237     exit;
 238   end;
 239   try
 240     pr := TStrTextParser.Create(s);
 241     if (pr.tokType = pr.TTStr) then cmd := pr.expectStr(false) else cmd := pr.expectId();
 242     if cmdlist.get(cmd, cc) then cc.execute(pr) else conwritefln('holmes command ''%s'' not found', [cmd]);
 243   except on E: Exception do
 244     begin
 245       conwritefln('error executing holmes command: [%s]', [s]);
 246       //conwritefln('* [%s] [%s]', [Integer(pr.tokType), E.message]);
 247     end;
 248   end;
 249   pr.Free();
 250 end;
 251
 252
 253 function keybindExecute (var ev: THKeyEvent): Boolean;
 254 var
 255   f: Integer;
 256 begin
 257   result := false;
 258   for f := 0 to High(keybinds) do
 259   begin
 260     if (ev = keybinds[f].key) then
 261     begin
 262       result := true;
 263       //conwritefln('found command [%s] for keybind <%s>', [keybinds[f].cmd, keybinds[f].key]);
 264       execCommand(keybinds[f].cmd);
 265       exit;
 266     end;
 267   end;
 268 end;
 269
 270
 271 function msbindExecute (var ev: THMouseEvent): Boolean;
 272 var
 273   f: Integer;
 274 begin
 275   result := false;
 276   for f := 0 to High(msbinds) do
 277   begin
 278     if (ev = msbinds[f].key) then
 279     begin
 280       result := true;
 281       execCommand(msbinds[f].cmd);
 282       exit;
 283     end;
 284   end;
 285 end;