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, THashKeyStr>;
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 hashNewCommand (): TCmdHash;
115 result := TCmdHash.Create();
119 // ////////////////////////////////////////////////////////////////////////// //
122 THBA = array of THolmesBinding;
126 cmdlist: TCmdHash = nil;
127 keybinds: THBA = nil;
129 keybindsInited: Boolean = false;
132 // ////////////////////////////////////////////////////////////////////////// //
133 function cmdNewInternal (const aname: AnsiString; const ahelp: AnsiString; const asection: AnsiString): PHolmesCommand;
135 if (cmdlist = nil) then cmdlist := hashNewCommand();
136 if not cmdlist.get(aname, result) then
138 GetMem(result, sizeof(THolmesCommand));
139 FillChar(result^, sizeof(THolmesCommand), 0);
140 result.name := aname;
141 result.help := ahelp;
142 result.section := asection;
144 result.ctype := result.TType.TArgLess;
145 cmdlist.put(aname, result);
149 result.help := ahelp;
150 result.section := asection;
155 // ////////////////////////////////////////////////////////////////////////// //
156 procedure cmdAdd (const aname: AnsiString; cb: TBindArgLessCB; const ahelp: AnsiString; const asection: AnsiString); overload;
160 if (Length(aname) = 0) or not assigned(cb) then exit;
161 cmd := cmdNewInternal(aname, ahelp, asection);
162 cmd.cb := Pointer(@cb);
163 cmd.ctype := cmd.TType.TArgLess;
167 procedure cmdAdd (const aname: AnsiString; cb: TBindToggleCB; const ahelp: AnsiString; const asection: AnsiString); overload;
171 if (Length(aname) = 0) or not assigned(cb) then exit;
172 cmd := cmdNewInternal(aname, ahelp, asection);
173 cmd.cb := Pointer(@cb);
174 cmd.ctype := cmd.TType.TToggle;
178 procedure cmdAdd (const aname: AnsiString; cb: TBindStringCB; const ahelp: AnsiString; const asection: AnsiString); overload;
182 if (Length(aname) = 0) or not assigned(cb) then exit;
183 cmd := cmdNewInternal(aname, ahelp, asection);
184 cmd.cb := Pointer(@cb);
185 cmd.ctype := cmd.TType.TString;
189 // ////////////////////////////////////////////////////////////////////////// //
190 function getCommandHelp (const aname: AnsiString): AnsiString;
192 cmd: PHolmesCommand = nil;
194 if not cmdlist.get(aname, cmd) then result := '' else result := cmd.help;
198 function getCommandSection (const aname: AnsiString): AnsiString;
200 cmd: PHolmesCommand = nil;
202 if not cmdlist.get(aname, cmd) then result := '' else result := cmd.section;
206 // ////////////////////////////////////////////////////////////////////////// //
207 function internalBindAdd (ba: PHBA; const akey: AnsiString; const acmd: AnsiString): Boolean;
211 for f := 0 to High(ba^) do
213 if (CompareText(ba^[f].key, akey) = 0) then
215 if (Length(acmd) = 0) then
219 for c := f+1 to High(ba^) do ba^[c-1] := ba^[c];
220 SetLength(ba^, Length(ba^)-1);
231 if (Length(acmd) > 0) then
234 SetLength(ba^, Length(ba^)+1);
235 ba^[High(ba^)].key := akey;
236 ba^[High(ba^)].cmd := acmd;
245 procedure keybindAdd (const akey: AnsiString; const acmd: AnsiString);
247 internalBindAdd(@keybinds, akey, acmd);
248 keybindsInited := true;
251 procedure msbindAdd (const akey: AnsiString; const acmd: AnsiString);
253 internalBindAdd(@msbinds, akey, acmd);
254 keybindsInited := true;
258 procedure execCommand (const s: AnsiString);
260 pr: TTextParser = nil;
264 if (cmdlist = nil) then
266 conwriteln('holmes command system is not initialized!');
270 pr := TStrTextParser.Create(s);
271 if (pr.tokType = pr.TTStr) then cmd := pr.expectStr(false) else cmd := pr.expectId();
272 if cmdlist.get(cmd, cc) then cc.execute(pr) else conwritefln('holmes command ''%s'' not found', [cmd]);
273 except on E: Exception do
275 conwritefln('error executing holmes command: [%s]', [s]);
276 //conwritefln('* [%s] [%s]', [Integer(pr.tokType), E.message]);
283 function keybindExecute (var ev: TFUIKeyEvent): Boolean;
288 for f := 0 to High(keybinds) do
290 if (ev = keybinds[f].key) then
293 //conwritefln('found command [%s] for keybind <%s>', [keybinds[f].cmd, keybinds[f].key]);
294 execCommand(keybinds[f].cmd);
301 function msbindExecute (var ev: TFUIMouseEvent): Boolean;
306 for f := 0 to High(msbinds) do
308 if (ev = msbinds[f].key) then
311 execCommand(msbinds[f].cmd);