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, version 3 of the License ONLY.
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.
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/>.
15 // ////////////////////////////////////////////////////////////////////////// //
17 TBindArgLessCB = procedure ();
18 TBindToggleCB = procedure (arg: Integer); // -1: no arg
19 TBindStringCB = procedure (s: AnsiString);
21 PHolmesCommand = ^THolmesCommand;
22 THolmesCommand = record
24 type TType = (TArgLess, TToggle, TString);
34 // command name already taken
35 procedure execute (pr: TTextParser);
38 PHolmesBinding = ^THolmesBinding;
39 THolmesBinding = record
40 key: AnsiString; // or mouse
43 function cmdName (): AnsiString;
46 TCmdHash = specialize THashBase<AnsiString, PHolmesCommand, THashKeyStr>;
49 // ////////////////////////////////////////////////////////////////////////// //
50 function THolmesBinding.cmdName (): AnsiString;
52 pr: TTextParser = nil;
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
67 // ////////////////////////////////////////////////////////////////////////// //
68 // command name already taken
69 procedure THolmesCommand.execute (pr: TTextParser);
74 if not assigned(cb) then exit;
78 if (pr.tokType <> pr.TTEOF) then
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;
89 if (pr.tokType <> pr.TTEOF) then begin conwritefln('%s: too many arguments', [name]); exit; end;
94 if (pr.tokType <> pr.TTEOF) then
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;
101 conwritefln('%s: string argument expected', [name]);
104 TBindStringCB(cb)(s);
111 // ////////////////////////////////////////////////////////////////////////// //
112 function hashNewCommand (): TCmdHash;
114 result := TCmdHash.Create();
118 // ////////////////////////////////////////////////////////////////////////// //
121 THBA = array of THolmesBinding;
125 cmdlist: TCmdHash = nil;
126 keybinds: THBA = nil;
128 keybindsInited: Boolean = false;
131 // ////////////////////////////////////////////////////////////////////////// //
132 function cmdNewInternal (const aname: AnsiString; const ahelp: AnsiString; const asection: AnsiString): PHolmesCommand;
134 if (cmdlist = nil) then cmdlist := hashNewCommand();
135 if not cmdlist.get(aname, result) then
137 GetMem(result, sizeof(THolmesCommand));
138 FillChar(result^, sizeof(THolmesCommand), 0);
139 result.name := aname;
140 result.help := ahelp;
141 result.section := asection;
143 result.ctype := result.TType.TArgLess;
144 cmdlist.put(aname, result);
148 result.help := ahelp;
149 result.section := asection;
154 // ////////////////////////////////////////////////////////////////////////// //
155 procedure cmdAdd (const aname: AnsiString; cb: TBindArgLessCB; const ahelp: AnsiString; const asection: AnsiString); overload;
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;
166 procedure cmdAdd (const aname: AnsiString; cb: TBindToggleCB; const ahelp: AnsiString; const asection: AnsiString); overload;
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;
177 procedure cmdAdd (const aname: AnsiString; cb: TBindStringCB; const ahelp: AnsiString; const asection: AnsiString); overload;
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;
188 // ////////////////////////////////////////////////////////////////////////// //
189 function getCommandHelp (const aname: AnsiString): AnsiString;
191 cmd: PHolmesCommand = nil;
193 if not cmdlist.get(aname, cmd) then result := '' else result := cmd.help;
197 function getCommandSection (const aname: AnsiString): AnsiString;
199 cmd: PHolmesCommand = nil;
201 if not cmdlist.get(aname, cmd) then result := '' else result := cmd.section;
205 // ////////////////////////////////////////////////////////////////////////// //
206 function internalBindAdd (ba: PHBA; const akey: AnsiString; const acmd: AnsiString): Boolean;
210 for f := 0 to High(ba^) do
212 if (CompareText(ba^[f].key, akey) = 0) then
214 if (Length(acmd) = 0) then
218 for c := f+1 to High(ba^) do ba^[c-1] := ba^[c];
219 SetLength(ba^, Length(ba^)-1);
230 if (Length(acmd) > 0) then
233 SetLength(ba^, Length(ba^)+1);
234 ba^[High(ba^)].key := akey;
235 ba^[High(ba^)].cmd := acmd;
244 procedure keybindAdd (const akey: AnsiString; const acmd: AnsiString);
246 internalBindAdd(@keybinds, akey, acmd);
247 keybindsInited := true;
250 procedure msbindAdd (const akey: AnsiString; const acmd: AnsiString);
252 internalBindAdd(@msbinds, akey, acmd);
253 keybindsInited := true;
257 procedure execCommand (const s: AnsiString);
259 pr: TTextParser = nil;
263 if (cmdlist = nil) then
265 conwriteln('holmes command system is not initialized!');
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
274 conwritefln('error executing holmes command: [%s]', [s]);
275 //conwritefln('* [%s] [%s]', [Integer(pr.tokType), E.message]);
282 function keybindExecute (var ev: TFUIEvent): Boolean;
287 for f := 0 to High(keybinds) do
289 if (ev = keybinds[f].key) then
292 //conwritefln('found command [%s] for keybind <%s>', [keybinds[f].cmd, keybinds[f].key]);
293 execCommand(keybinds[f].cmd);
300 function msbindExecute (var ev: TFUIEvent): Boolean;
305 for f := 0 to High(msbinds) do
307 if (ev = msbinds[f].key) then
310 execCommand(msbinds[f].cmd);