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