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   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   s: AnsiString = '';
  73 begin
  74   if not assigned(cb) then exit;
  75   case ctype of
  76     TType.TToggle:
  77       begin
  78         if (pr.tokType <> pr.TTEOF) then
  79         begin
  80                if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then a := 1
  81           else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then a := 0
  82           else begin conwritefln('%s: invalid argument', [name]); exit; end;
  83           if (pr.tokType <> pr.TTEOF) then begin conwritefln('%s: too many arguments', [name]); exit; end;
  84         end;
  85         TBindToggleCB(cb)(a);
  86       end;
  87     TType.TArgLess:
  88       begin
  89         if (pr.tokType <> pr.TTEOF) then begin conwritefln('%s: too many arguments', [name]); exit; end;
  90         TBindArgLessCB(cb)();
  91       end;
  92     TType.TString:
  93       begin
  94         if (pr.tokType <> pr.TTEOF) then
  95         begin
  96           if (pr.tokType = pr.TTStr) then s := pr.expectStr(false) else s := pr.expectId;
  97           if (pr.tokType <> pr.TTEOF) then begin conwritefln('%s: too many arguments', [name]); exit; end;
  98         end
  99         else
 100         begin
 101           conwritefln('%s: string argument expected', [name]);
 102           exit;
 103         end;
 104         TBindStringCB(cb)(s);
 105       end;
 106     else assert(false);
 107   end;
 108 end;
 109
 110
 111 // ////////////////////////////////////////////////////////////////////////// //
 112 function hashNewCommand (): TCmdHash;
 113 begin
 114   result := TCmdHash.Create();
 115 end;
 116
 117
 118 // ////////////////////////////////////////////////////////////////////////// //
 119 type
 120   PHBA = ^THBA;
 121   THBA = array of THolmesBinding;
 122
 123
 124 var
 125   cmdlist: TCmdHash = nil;
 126   keybinds: THBA = nil;
 127   msbinds: THBA = nil;
 128   keybindsInited: Boolean = false;
 129
 130
 131 // ////////////////////////////////////////////////////////////////////////// //
 132 function cmdNewInternal (const aname: AnsiString; const ahelp: AnsiString; const asection: AnsiString): PHolmesCommand;
 133 begin
 134   if (cmdlist = nil) then cmdlist := hashNewCommand();
 135   if not cmdlist.get(aname, result) then
 136   begin
 137     GetMem(result, sizeof(THolmesCommand));
 138     FillChar(result^, sizeof(THolmesCommand), 0);
 139     result.name := aname;
 140     result.help := ahelp;
 141     result.section := asection;
 142     result.cb := nil;
 143     result.ctype := result.TType.TArgLess;
 144     cmdlist.put(aname, result);
 145   end
 146   else
 147   begin
 148     result.help := ahelp;
 149     result.section := asection;
 150   end;
 151 end;
 152
 153
 154 // ////////////////////////////////////////////////////////////////////////// //
 155 procedure cmdAdd (const aname: AnsiString; cb: TBindArgLessCB; const ahelp: AnsiString; const asection: AnsiString); overload;
 156 var
 157   cmd: PHolmesCommand;
 158 begin
 159   if (Length(aname) = 0) or not assigned(cb) then exit;
 160   cmd := cmdNewInternal(aname, ahelp, asection);
 161   cmd.cb := Pointer(@cb);
 162   cmd.ctype := cmd.TType.TArgLess;
 163 end;
 164
 165
 166 procedure cmdAdd (const aname: AnsiString; cb: TBindToggleCB; const ahelp: AnsiString; const asection: AnsiString); overload;
 167 var
 168   cmd: PHolmesCommand;
 169 begin
 170   if (Length(aname) = 0) or not assigned(cb) then exit;
 171   cmd := cmdNewInternal(aname, ahelp, asection);
 172   cmd.cb := Pointer(@cb);
 173   cmd.ctype := cmd.TType.TToggle;
 174 end;
 175
 176
 177 procedure cmdAdd (const aname: AnsiString; cb: TBindStringCB; const ahelp: AnsiString; const asection: AnsiString); overload;
 178 var
 179   cmd: PHolmesCommand;
 180 begin
 181   if (Length(aname) = 0) or not assigned(cb) then exit;
 182   cmd := cmdNewInternal(aname, ahelp, asection);
 183   cmd.cb := Pointer(@cb);
 184   cmd.ctype := cmd.TType.TString;
 185 end;
 186
 187
 188 // ////////////////////////////////////////////////////////////////////////// //
 189 function getCommandHelp (const aname: AnsiString): AnsiString;
 190 var
 191   cmd: PHolmesCommand = nil;
 192 begin
 193   if not cmdlist.get(aname, cmd) then result := '' else result := cmd.help;
 194 end;
 195
 196
 197 function getCommandSection (const aname: AnsiString): AnsiString;
 198 var
 199   cmd: PHolmesCommand = nil;
 200 begin
 201   if not cmdlist.get(aname, cmd) then result := '' else result := cmd.section;
 202 end;
 203
 204
 205 // ////////////////////////////////////////////////////////////////////////// //
 206 function internalBindAdd (ba: PHBA; const akey: AnsiString; const acmd: AnsiString): Boolean;
 207 var
 208   f, c: Integer;
 209 begin
 210   for f := 0 to High(ba^) do
 211   begin
 212     if (CompareText(ba^[f].key, akey) = 0) then
 213     begin
 214       if (Length(acmd) = 0) then
 215       begin
 216         // remove
 217         result := false;
 218         for c := f+1 to High(ba^) do ba^[c-1] := ba^[c];
 219         SetLength(ba^, Length(ba^)-1);
 220       end
 221       else
 222       begin
 223         // replace
 224         result := true;
 225         ba^[f].cmd := acmd;
 226       end;
 227       exit;
 228     end;
 229   end;
 230   if (Length(acmd) > 0) then
 231   begin
 232     result := true;
 233     SetLength(ba^, Length(ba^)+1);
 234     ba^[High(ba^)].key := akey;
 235     ba^[High(ba^)].cmd := acmd;
 236   end
 237   else
 238   begin
 239     result := false;
 240   end;
 241 end;
 242
 243
 244 procedure keybindAdd (const akey: AnsiString; const acmd: AnsiString);
 245 begin
 246   internalBindAdd(@keybinds, akey, acmd);
 247   keybindsInited := true;
 248 end;
 249
 250 procedure msbindAdd (const akey: AnsiString; const acmd: AnsiString);
 251 begin
 252   internalBindAdd(@msbinds, akey, acmd);
 253   keybindsInited := true;
 254 end;
 255
 256
 257 procedure execCommand (const s: AnsiString);
 258 var
 259   pr: TTextParser = nil;
 260   cmd: AnsiString;
 261   cc: PHolmesCommand;
 262 begin
 263   if (cmdlist = nil) then
 264   begin
 265     conwriteln('holmes command system is not initialized!');
 266     exit;
 267   end;
 268   try
 269     pr := TStrTextParser.Create(s);
 270     if (pr.tokType = pr.TTStr) then cmd := pr.expectStr(false) else cmd := pr.expectId();
 271     if cmdlist.get(cmd, cc) then cc.execute(pr) else conwritefln('holmes command ''%s'' not found', [cmd]);
 272   except 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;