1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
16 // ////////////////////////////////////////////////////////////////////////// //
18 TBindArgLessCB = procedure ();
19 TBindToggleCB = procedure (arg: Integer); // -1: no arg
20 TBindStringCB = procedure (s: AnsiString);
22 PHolmesCommand = ^THolmesCommand;
23 THolmesCommand = record
25 type TType = (TArgLess, TToggle, TString);
35 // command name already taken
36 procedure execute (pr: TTextParser);
39 PHolmesBinding = ^THolmesBinding;
40 THolmesBinding = record
41 key: AnsiString; // or mouse
44 function cmdName (): AnsiString;
47 TCmdHash = specialize THashBase<AnsiString, PHolmesCommand>;
50 // ////////////////////////////////////////////////////////////////////////// //
51 function THolmesBinding.cmdName (): AnsiString;
53 pr: TTextParser = nil;
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
68 // ////////////////////////////////////////////////////////////////////////// //
69 // command name already taken
70 procedure THolmesCommand.execute (pr: TTextParser);
75 if not assigned(cb) then exit;
79 if (pr.tokType <> pr.TTEOF) then
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;
90 if (pr.tokType <> pr.TTEOF) then begin conwritefln('%s: too many arguments', [name]); exit; end;
95 if (pr.tokType <> pr.TTEOF) then
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;
102 conwritefln('%s: string argument expected', [name]);
105 TBindStringCB(cb)(s);
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;
116 function hashNewCommand (): TCmdHash;
118 result := TCmdHash.Create(ansistrHashCB, ansistrEquCB);
122 // ////////////////////////////////////////////////////////////////////////// //
125 THBA = array of THolmesBinding;
129 cmdlist: TCmdHash = nil;
130 keybinds: THBA = nil;
132 keybindsInited: Boolean = false;
135 // ////////////////////////////////////////////////////////////////////////// //
136 function cmdNewInternal (const aname: AnsiString; const ahelp: AnsiString; const asection: AnsiString): PHolmesCommand;
138 if (cmdlist = nil) then cmdlist := hashNewCommand();
139 if not cmdlist.get(aname, result) then
141 GetMem(result, sizeof(THolmesCommand));
142 FillChar(result^, sizeof(THolmesCommand), 0);
143 result.name := aname;
144 result.help := ahelp;
145 result.section := asection;
147 result.ctype := result.TType.TArgLess;
148 cmdlist.put(aname, result);
152 result.help := ahelp;
153 result.section := asection;
158 // ////////////////////////////////////////////////////////////////////////// //
159 procedure cmdAdd (const aname: AnsiString; cb: TBindArgLessCB; const ahelp: AnsiString; const asection: AnsiString); overload;
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;
170 procedure cmdAdd (const aname: AnsiString; cb: TBindToggleCB; const ahelp: AnsiString; const asection: AnsiString); overload;
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;
181 procedure cmdAdd (const aname: AnsiString; cb: TBindStringCB; const ahelp: AnsiString; const asection: AnsiString); overload;
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;
192 // ////////////////////////////////////////////////////////////////////////// //
193 function getCommandHelp (const aname: AnsiString): AnsiString;
195 cmd: PHolmesCommand = nil;
197 if not cmdlist.get(aname, cmd) then result := '' else result := cmd.help;
201 function getCommandSection (const aname: AnsiString): AnsiString;
203 cmd: PHolmesCommand = nil;
205 if not cmdlist.get(aname, cmd) then result := '' else result := cmd.section;
209 // ////////////////////////////////////////////////////////////////////////// //
210 function internalBindAdd (ba: PHBA; const akey: AnsiString; const acmd: AnsiString): Boolean;
214 for f := 0 to High(ba^) do
216 if (CompareText(ba^[f].key, akey) = 0) then
218 if (Length(acmd) = 0) then
222 for c := f+1 to High(ba^) do ba^[c-1] := ba^[c];
223 SetLength(ba^, Length(ba^)-1);
234 if (Length(acmd) > 0) then
237 SetLength(ba^, Length(ba^)+1);
238 ba^[High(ba^)].key := akey;
239 ba^[High(ba^)].cmd := acmd;
248 procedure keybindAdd (const akey: AnsiString; const acmd: AnsiString);
250 internalBindAdd(@keybinds, akey, acmd);
251 keybindsInited := true;
254 procedure msbindAdd (const akey: AnsiString; const acmd: AnsiString);
256 internalBindAdd(@msbinds, akey, acmd);
257 keybindsInited := true;
261 procedure execCommand (const s: AnsiString);
263 pr: TTextParser = nil;
267 if (cmdlist = nil) then
269 conwriteln('holmes command system is not initialized!');
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
278 conwritefln('error executing holmes command: [%s]', [s]);
279 //conwritefln('* [%s] [%s]', [Integer(pr.tokType), E.message]);
286 function keybindExecute (var ev: THKeyEvent): Boolean;
291 for f := 0 to High(keybinds) do
293 if (ev = keybinds[f].key) then
296 //conwritefln('found command [%s] for keybind <%s>', [keybinds[f].cmd, keybinds[f].key]);
297 execCommand(keybinds[f].cmd);
304 function msbindExecute (var ev: THMouseEvent): Boolean;
309 for f := 0 to High(msbinds) do
311 if (ev = msbinds[f].key) then
314 execCommand(msbinds[f].cmd);