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   TBindStringCB = procedure (s: AnsiString);
  21
  22   PHolmesCommand = ^THolmesCommand;
  23   THolmesCommand = record
  24   public
  25     type TType = (TArgLess, TToggle, TString);
  26
  27   public
  28     name: AnsiString;
  29     help: AnsiString;
  30     section: AnsiString;
  31     cb: Pointer;
  32     ctype: TType;
  33     helpmark: Boolean;
  34
  35     // command name already taken
  36     procedure execute (pr: TTextParser);
  37   end;
  38
  39   PHolmesBinding = ^THolmesBinding;
  40   THolmesBinding = record
  41     key: AnsiString; // or mouse
  42     cmd: AnsiString;
  43
  44     function cmdName (): AnsiString;
  45   end;
  46
  47   TCmdHash = specialize THashBase<AnsiString, PHolmesCommand>;
  48
  49
  50 // ////////////////////////////////////////////////////////////////////////// //
  51 function THolmesBinding.cmdName (): AnsiString;
  52 var
  53   pr: TTextParser = nil;
  54 begin
  55   result := '';
  56   try
  57     pr := TStrTextParser.Create(cmd);
  58     if (pr.tokType = pr.TTStr) then result := pr.expectStr(false) else result := pr.expectId();
  59   except on E: Exception do
  60     begin
  61       result := '';
  62     end;
  63   end;
  64   pr.Free();
  65 end;
  66
  67
  68 // ////////////////////////////////////////////////////////////////////////// //
  69 // command name already taken
  70 procedure THolmesCommand.execute (pr: TTextParser);
  71 var
  72   a: Integer = -1;
  73   s: AnsiString = '';
  74 begin
  75   if not assigned(cb) then exit;
  76   case ctype of
  77     TType.TToggle:
  78       begin
  79         if (pr.tokType <> pr.TTEOF) then
  80         begin
  81                if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then a := 1
  82           else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then a := 0
  83           else begin conwritefln('%s: invalid argument', [name]); exit; end;
  84           if (pr.tokType <> pr.TTEOF) then begin conwritefln('%s: too many arguments', [name]); exit; end;
  85         end;
  86         TBindToggleCB(cb)(a);
  87       end;
  88     TType.TArgLess:
  89       begin
  90         if (pr.tokType <> pr.TTEOF) then begin conwritefln('%s: too many arguments', [name]); exit; end;
  91         TBindArgLessCB(cb)();
  92       end;
  93     TType.TString:
  94       begin
  95         if (pr.tokType <> pr.TTEOF) then
  96         begin
  97           if (pr.tokType = pr.TTStr) then s := pr.expectStr(false) else s := pr.expectId;
  98           if (pr.tokType <> pr.TTEOF) then begin conwritefln('%s: too many arguments', [name]); exit; end;
  99         end
 100         else
 101         begin
 102           conwritefln('%s: string argument expected', [name]);
 103           exit;
 104         end;
 105         TBindStringCB(cb)(s);
 106       end;
 107     else assert(false);
 108   end;
 109 end;
 110
 111
 112 // ////////////////////////////////////////////////////////////////////////// //
 113 function ansistrEquCB (constref a, b: AnsiString): Boolean; begin result := (a = b); end;
 114 function ansistrHashCB (constref a: AnsiString): LongWord; begin if (Length(a) > 0) then result := fnvHash(PChar(a)^, Length(a)) else result := 0; end;
 115
 116 function hashNewCommand (): TCmdHash;
 117 begin
 118   result := TCmdHash.Create(ansistrHashCB, ansistrEquCB);
 119 end;
 120
 121
 122 // ////////////////////////////////////////////////////////////////////////// //
 123 type
 124   PHBA = ^THBA;
 125   THBA = array of THolmesBinding;
 126
 127
 128 var
 129   cmdlist: TCmdHash = nil;
 130   keybinds: THBA = nil;
 131   msbinds: THBA = nil;
 132   keybindsInited: Boolean = false;
 133
 134
 135 // ////////////////////////////////////////////////////////////////////////// //
 136 function cmdNewInternal (const aname: AnsiString; const ahelp: AnsiString; const asection: AnsiString): PHolmesCommand;
 137 begin
 138   if (cmdlist = nil) then cmdlist := hashNewCommand();
 139   if not cmdlist.get(aname, result) then
 140   begin
 141     GetMem(result, sizeof(THolmesCommand));
 142     FillChar(result^, sizeof(THolmesCommand), 0);
 143     result.name := aname;
 144     result.help := ahelp;
 145     result.section := asection;
 146     result.cb := nil;
 147     result.ctype := result.TType.TArgLess;
 148     cmdlist.put(aname, result);
 149   end
 150   else
 151   begin
 152     result.help := ahelp;
 153     result.section := asection;
 154   end;
 155 end;
 156
 157
 158 // ////////////////////////////////////////////////////////////////////////// //
 159 procedure cmdAdd (const aname: AnsiString; cb: TBindArgLessCB; const ahelp: AnsiString; const asection: AnsiString); overload;
 160 var
 161   cmd: PHolmesCommand;
 162 begin
 163   if (Length(aname) = 0) or not assigned(cb) then exit;
 164   cmd := cmdNewInternal(aname, ahelp, asection);
 165   cmd.cb := Pointer(@cb);
 166   cmd.ctype := cmd.TType.TArgLess;
 167 end;
 168
 169
 170 procedure cmdAdd (const aname: AnsiString; cb: TBindToggleCB; const ahelp: AnsiString; const asection: AnsiString); overload;
 171 var
 172   cmd: PHolmesCommand;
 173 begin
 174   if (Length(aname) = 0) or not assigned(cb) then exit;
 175   cmd := cmdNewInternal(aname, ahelp, asection);
 176   cmd.cb := Pointer(@cb);
 177   cmd.ctype := cmd.TType.TToggle;
 178 end;
 179
 180
 181 procedure cmdAdd (const aname: AnsiString; cb: TBindStringCB; const ahelp: AnsiString; const asection: AnsiString); overload;
 182 var
 183   cmd: PHolmesCommand;
 184 begin
 185   if (Length(aname) = 0) or not assigned(cb) then exit;
 186   cmd := cmdNewInternal(aname, ahelp, asection);
 187   cmd.cb := Pointer(@cb);
 188   cmd.ctype := cmd.TType.TString;
 189 end;
 190
 191
 192 // ////////////////////////////////////////////////////////////////////////// //
 193 function getCommandHelp (const aname: AnsiString): AnsiString;
 194 var
 195   cmd: PHolmesCommand = nil;
 196 begin
 197   if not cmdlist.get(aname, cmd) then result := '' else result := cmd.help;
 198 end;
 199
 200
 201 function getCommandSection (const aname: AnsiString): AnsiString;
 202 var
 203   cmd: PHolmesCommand = nil;
 204 begin
 205   if not cmdlist.get(aname, cmd) then result := '' else result := cmd.section;
 206 end;
 207
 208
 209 // ////////////////////////////////////////////////////////////////////////// //
 210 function internalBindAdd (ba: PHBA; const akey: AnsiString; const acmd: AnsiString): Boolean;
 211 var
 212   f, c: Integer;
 213 begin
 214   for f := 0 to High(ba^) do
 215   begin
 216     if (CompareText(ba^[f].key, akey) = 0) then
 217     begin
 218       if (Length(acmd) = 0) then
 219       begin
 220         // remove
 221         result := false;
 222         for c := f+1 to High(ba^) do ba^[c-1] := ba^[c];
 223         SetLength(ba^, Length(ba^)-1);
 224       end
 225       else
 226       begin
 227         // replace
 228         result := true;
 229         ba^[f].cmd := acmd;
 230       end;
 231       exit;
 232     end;
 233   end;
 234   if (Length(acmd) > 0) then
 235   begin
 236     result := true;
 237     SetLength(ba^, Length(ba^)+1);
 238     ba^[High(ba^)].key := akey;
 239     ba^[High(ba^)].cmd := acmd;
 240   end
 241   else
 242   begin
 243     result := false;
 244   end;
 245 end;
 246
 247
 248 procedure keybindAdd (const akey: AnsiString; const acmd: AnsiString);
 249 begin
 250   internalBindAdd(@keybinds, akey, acmd);
 251   keybindsInited := true;
 252 end;
 253
 254 procedure msbindAdd (const akey: AnsiString; const acmd: AnsiString);
 255 begin
 256   internalBindAdd(@msbinds, akey, acmd);
 257   keybindsInited := true;
 258 end;
 259
 260
 261 procedure execCommand (const s: AnsiString);
 262 var
 263   pr: TTextParser = nil;
 264   cmd: AnsiString;
 265   cc: PHolmesCommand;
 266 begin
 267   if (cmdlist = nil) then
 268   begin
 269     conwriteln('holmes command system is not initialized!');
 270     exit;
 271   end;
 272   try
 273     pr := TStrTextParser.Create(s);
 274     if (pr.tokType = pr.TTStr) then cmd := pr.expectStr(false) else cmd := pr.expectId();
 275     if cmdlist.get(cmd, cc) then cc.execute(pr) else conwritefln('holmes command ''%s'' not found', [cmd]);
 276   except on E: Exception do
 277     begin
 278       conwritefln('error executing holmes command: [%s]', [s]);
 279       //conwritefln('* [%s] [%s]', [Integer(pr.tokType), E.message]);
 280     end;
 281   end;
 282   pr.Free();
 283 end;
 284
 285
 286 function keybindExecute (var ev: THKeyEvent): Boolean;
 287 var
 288   f: Integer;
 289 begin
 290   result := false;
 291   for f := 0 to High(keybinds) do
 292   begin
 293     if (ev = keybinds[f].key) then
 294     begin
 295       result := true;
 296       //conwritefln('found command [%s] for keybind <%s>', [keybinds[f].cmd, keybinds[f].key]);
 297       execCommand(keybinds[f].cmd);
 298       exit;
 299     end;
 300   end;
 301 end;
 302
 303
 304 function msbindExecute (var ev: THMouseEvent): Boolean;
 305 var
 306   f: Integer;
 307 begin
 308   result := false;
 309   for f := 0 to High(msbinds) do
 310   begin
 311     if (ev = msbinds[f].key) then
 312     begin
 313       result := true;
 314       execCommand(msbinds[f].cmd);
 315       exit;
 316     end;
 317   end;
 318 end;