DEADSOFTWARE

more input related fixes
[d2df-sdl.git] / src / game / g_console.pas
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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
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.
12 *
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/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 unit g_console;
19 interface
21 uses
22 utils; // for SSArray
24 const
25 ACTION_JUMP = 0;
26 ACTION_MOVELEFT = 1;
27 ACTION_MOVERIGHT = 2;
28 ACTION_LOOKDOWN = 3;
29 ACTION_LOOKUP = 4;
30 ACTION_ATTACK = 5;
31 ACTION_SCORES = 6;
32 ACTION_ACTIVATE = 7;
33 ACTION_STRAFE = 8;
34 ACTION_WEAPNEXT = 9;
35 ACTION_WEAPPREV = 10;
37 FIRST_ACTION = ACTION_JUMP;
38 LAST_ACTION = ACTION_WEAPPREV;
40 procedure g_Console_Init ();
41 procedure g_Console_Update ();
42 procedure g_Console_Draw ();
43 procedure g_Console_Switch ();
44 procedure g_Console_Char (C: AnsiChar);
45 procedure g_Console_Control (K: Word);
46 procedure g_Console_Process (L: AnsiString; quiet: Boolean=false);
47 procedure g_Console_Add (L: AnsiString; show: Boolean=false);
48 procedure g_Console_Clear ();
49 function g_Console_CommandBlacklisted (C: AnsiString): Boolean;
50 procedure g_Console_ReadConfig (filename: String);
51 procedure g_Console_WriteConfig (filename: String);
53 function g_Console_Interactive: Boolean;
54 function g_Console_Action (action: Integer): Boolean;
55 function g_Console_FindBind (n: Integer; down: AnsiString; up: AnsiString = ''): Integer;
56 procedure g_Console_BindKey (key: Integer; down: AnsiString; up: AnsiString = '');
57 procedure g_Console_ProcessBind (key: Integer; down: Boolean);
58 procedure g_Console_ResetBinds;
60 procedure conwriteln (const s: AnsiString; show: Boolean=false);
61 procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
63 // <0: no arg; 0/1: true/false
64 function conGetBoolArg (p: SSArray; idx: Integer): Integer;
66 procedure g_Console_Chat_Switch (team: Boolean=false);
68 procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
69 procedure conRegVar (const conname: AnsiString; pvar: PSingle; amin, amax: Single; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
70 procedure conRegVar (const conname: AnsiString; pvar: PInteger; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
72 // poor man's floating literal parser; i'm sorry, but `StrToFloat()` sux cocks
73 function conParseFloat (var res: Single; const s: AnsiString): Boolean;
76 var
77 gConsoleShow: Boolean = false; // True - êîíñîëü îòêðûòà èëè îòêðûâàåòñÿ
78 gChatShow: Boolean = false;
79 gChatTeam: Boolean = false;
80 gAllowConsoleMessages: Boolean = true;
81 gJustChatted: Boolean = false; // ÷òîáû àäìèí â èíòåðå ÷àòÿñü íå ïðîìàòûâàë ñòàòèñòèêó
82 gPlayerAction: Array [0..1, 0..LAST_ACTION] of Boolean; // [player, action]
84 implementation
86 uses
87 g_textures, g_main, e_graphics, e_input, g_game,
88 SysUtils, g_basic, g_options, Math, g_touch,
89 g_menu, g_language, g_net, g_netmsg, e_log, conbuf;
92 type
93 PCommand = ^TCommand;
95 TCmdProc = procedure (p: SSArray);
96 TCmdProcEx = procedure (me: PCommand; p: SSArray);
98 TCommand = record
99 cmd: AnsiString;
100 proc: TCmdProc;
101 procEx: TCmdProcEx;
102 help: AnsiString;
103 hidden: Boolean;
104 ptr: Pointer; // various data
105 msg: AnsiString; // message for var changes
106 cheat: Boolean;
107 action: Integer; // >= 0 for action commands
108 player: Integer; // used for action commands
109 end;
111 TAlias = record
112 name: AnsiString;
113 commands: SSArray;
114 end;
117 const
118 Step = 32;
119 Alpha = 25;
120 MsgTime = 144;
121 MaxScriptRecursion = 16;
123 DEBUG_STRING = 'DEBUG MODE';
125 var
126 ID: DWORD;
127 RecursionDepth: Word = 0;
128 RecursionLimitHit: Boolean = False;
129 Cons_Y: SmallInt;
130 Cons_Shown: Boolean; // Ðèñîâàòü ëè êîíñîëü?
131 Line: AnsiString;
132 CPos: Word;
133 //ConsoleHistory: SSArray;
134 CommandHistory: SSArray;
135 Whitelist: SSArray;
136 commands: Array of TCommand = nil;
137 Aliases: Array of TAlias = nil;
138 CmdIndex: Word;
139 conSkipLines: Integer = 0;
140 MsgArray: Array [0..4] of record
141 Msg: AnsiString;
142 Time: Word;
143 end;
145 gInputBinds: Array [0..e_MaxInputKeys - 1] of record
146 down, up: SSArray;
147 end;
148 menu_toggled: BOOLEAN;
151 // poor man's floating literal parser; i'm sorry, but `StrToFloat()` sux cocks
152 function conParseFloat (var res: Single; const s: AnsiString): Boolean;
153 var
154 pos: Integer = 1;
155 frac: Single = 1;
156 slen: Integer;
157 begin
158 result := false;
159 res := 0;
160 slen := Length(s);
161 while (slen > 0) and (s[slen] <= ' ') do Dec(slen);
162 while (pos <= slen) and (s[pos] <= ' ') do Inc(pos);
163 if (pos > slen) then exit;
164 if (slen-pos = 1) and (s[pos] = '.') then exit; // single dot
165 // integral part
166 while (pos <= slen) do
167 begin
168 if (s[pos] < '0') or (s[pos] > '9') then break;
169 res := res*10+Byte(s[pos])-48;
170 Inc(pos);
171 end;
172 if (pos <= slen) then
173 begin
174 // must be a dot
175 if (s[pos] <> '.') then exit;
176 Inc(pos);
177 while (pos <= slen) do
178 begin
179 if (s[pos] < '0') or (s[pos] > '9') then break;
180 frac := frac/10;
181 res += frac*(Byte(s[pos])-48);
182 Inc(pos);
183 end;
184 end;
185 if (pos <= slen) then exit; // oops
186 result := true;
187 end;
190 // ////////////////////////////////////////////////////////////////////////// //
191 // <0: no arg; 0/1: true/false; 666: toggle
192 function conGetBoolArg (p: SSArray; idx: Integer): Integer;
193 begin
194 if (idx < 0) or (idx > High(p)) then begin result := -1; exit; end;
195 result := 0;
196 if (p[idx] = '1') or (CompareText(p[idx], 'on') = 0) or (CompareText(p[idx], 'true') = 0) or
197 (CompareText(p[idx], 'tan') = 0) or (CompareText(p[idx], 'yes') = 0) then result := 1
198 else if (CompareText(p[idx], 'toggle') = 0) or (CompareText(p[idx], 'switch') = 0) or
199 (CompareText(p[idx], 't') = 0) then result := 666;
200 end;
203 procedure boolVarHandler (me: PCommand; p: SSArray);
204 procedure binaryFlag (var flag: Boolean; msg: AnsiString);
205 begin
206 if (Length(p) > 2) then
207 begin
208 conwritefln('too many arguments to ''%s''', [p[0]]);
209 end
210 else
211 begin
212 case conGetBoolArg(p, 1) of
213 -1: begin end;
214 0: if not me.cheat or conIsCheatsEnabled then flag := false else begin conwriteln('not available'); exit; end;
215 1: if not me.cheat or conIsCheatsEnabled then flag := true else begin conwriteln('not available'); exit; end;
216 666: if not me.cheat or conIsCheatsEnabled then flag := not flag else begin conwriteln('not available'); exit; end;
217 end;
218 if (Length(msg) = 0) then msg := p[0] else msg += ':';
219 if flag then conwritefln('%s tan', [msg]) else conwritefln('%s ona', [msg]);
220 end;
221 end;
222 begin
223 binaryFlag(PBoolean(me.ptr)^, me.msg);
224 end;
227 procedure intVarHandler (me: PCommand; p: SSArray);
228 procedure binaryFlag (var flag: Boolean; msg: AnsiString);
229 begin
230 if (Length(p) > 2) then
231 begin
232 conwritefln('too many arguments to ''%s''', [p[0]]);
233 end
234 else
235 begin
236 case conGetBoolArg(p, 1) of
237 -1: begin end;
238 0: if not me.cheat or conIsCheatsEnabled then flag := false else begin conwriteln('not available'); exit; end;
239 1: if not me.cheat or conIsCheatsEnabled then flag := true else begin conwriteln('not available'); exit; end;
240 666: if not me.cheat or conIsCheatsEnabled then flag := not flag else begin conwriteln('not available'); exit; end;
241 end;
242 if (Length(msg) = 0) then msg := p[0] else msg += ':';
243 if flag then conwritefln('%s tan', [msg]) else conwritefln('%s ona', [msg]);
244 end;
245 end;
246 begin
247 if (Length(p) <> 2) then
248 begin
249 conwritefln('%s %d', [me.cmd, PInteger(me.ptr)^]);
250 end
251 else
252 begin
253 try
254 PInteger(me.ptr)^ := StrToInt(p[1]);
255 except
256 conwritefln('invalid integer value: "%s"', [p[1]]);
257 end;
258 end;
259 end;
262 procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
263 var
264 f: Integer;
265 cp: PCommand;
266 begin
267 f := Length(commands);
268 SetLength(commands, f+1);
269 cp := @commands[f];
270 cp.cmd := LowerCase(conname);
271 cp.proc := nil;
272 cp.procEx := boolVarHandler;
273 cp.help := ahelp;
274 cp.hidden := ahidden;
275 cp.ptr := pvar;
276 cp.msg := amsg;
277 cp.cheat := acheat;
278 cp.action := -1;
279 cp.player := -1;
280 end;
283 procedure conRegVar (const conname: AnsiString; pvar: PInteger; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
284 var
285 f: Integer;
286 cp: PCommand;
287 begin
288 f := Length(commands);
289 SetLength(commands, f+1);
290 cp := @commands[f];
291 cp.cmd := LowerCase(conname);
292 cp.proc := nil;
293 cp.procEx := intVarHandler;
294 cp.help := ahelp;
295 cp.hidden := ahidden;
296 cp.ptr := pvar;
297 cp.msg := amsg;
298 cp.cheat := acheat;
299 cp.action := -1;
300 cp.player := -1;
301 end;
304 // ////////////////////////////////////////////////////////////////////////// //
305 type
306 PVarSingle = ^TVarSingle;
307 TVarSingle = record
308 val: PSingle;
309 min, max, def: Single; // default will be starting value
310 end;
313 procedure singleVarHandler (me: PCommand; p: SSArray);
314 var
315 pv: PVarSingle;
316 nv: Single;
317 msg: AnsiString;
318 begin
319 if (Length(p) > 2) then
320 begin
321 conwritefln('too many arguments to ''%s''', [me.cmd]);
322 exit;
323 end;
324 pv := PVarSingle(me.ptr);
325 if (Length(p) = 2) then
326 begin
327 if me.cheat and (not conIsCheatsEnabled) then begin conwriteln('not available'); exit; end;
328 if (CompareText(p[1], 'default') = 0) or (CompareText(p[1], 'def') = 0) or
329 (CompareText(p[1], 'd') = 0) or (CompareText(p[1], 'off') = 0) or
330 (CompareText(p[1], 'ona') = 0) then
331 begin
332 pv.val^ := pv.def;
333 end
334 else
335 begin
336 if not conParseFloat(nv, p[1]) then
337 begin
338 conwritefln('%s: ''%s'' doesn''t look like a floating number', [me.cmd, p[1]]);
339 exit;
340 end;
341 if (nv < pv.min) then nv := pv.min;
342 if (nv > pv.max) then nv := pv.max;
343 pv.val^ := nv;
344 end;
345 end;
346 msg := me.msg;
347 if (Length(msg) = 0) then msg := me.cmd else msg += ':';
348 conwritefln('%s %s', [msg, pv.val^]);
349 end;
352 procedure conRegVar (const conname: AnsiString; pvar: PSingle; amin, amax: Single; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
353 var
354 f: Integer;
355 cp: PCommand;
356 pv: PVarSingle;
357 begin
358 GetMem(pv, sizeof(TVarSingle));
359 pv.val := pvar;
360 pv.min := amin;
361 pv.max := amax;
362 pv.def := pvar^;
363 f := Length(commands);
364 SetLength(commands, f+1);
365 cp := @commands[f];
366 cp.cmd := LowerCase(conname);
367 cp.proc := nil;
368 cp.procEx := singleVarHandler;
369 cp.help := ahelp;
370 cp.hidden := ahidden;
371 cp.ptr := pv;
372 cp.msg := amsg;
373 cp.cheat := acheat;
374 cp.action := -1;
375 cp.player := -1;
376 end;
379 // ////////////////////////////////////////////////////////////////////////// //
380 function GetStrACmd(var Str: AnsiString): AnsiString;
381 var
382 a: Integer;
383 begin
384 Result := '';
385 for a := 1 to Length(Str) do
386 if (a = Length(Str)) or (Str[a+1] = ';') then
387 begin
388 Result := Copy(Str, 1, a);
389 Delete(Str, 1, a+1);
390 Str := Trim(Str);
391 Exit;
392 end;
393 end;
395 function ParseAlias(Str: AnsiString): SSArray;
396 begin
397 Result := nil;
399 Str := Trim(Str);
401 if Str = '' then
402 Exit;
404 while Str <> '' do
405 begin
406 SetLength(Result, Length(Result)+1);
407 Result[High(Result)] := GetStrACmd(Str);
408 end;
409 end;
411 procedure ConsoleCommands(p: SSArray);
412 var
413 cmd, s: AnsiString;
414 a, b: Integer;
415 (* F: TextFile; *)
416 begin
417 cmd := LowerCase(p[0]);
418 s := '';
420 if cmd = 'clear' then
421 begin
422 //ConsoleHistory := nil;
423 cbufClear();
424 conSkipLines := 0;
426 for a := 0 to High(MsgArray) do
427 with MsgArray[a] do
428 begin
429 Msg := '';
430 Time := 0;
431 end;
432 end;
434 if cmd = 'clearhistory' then
435 CommandHistory := nil;
437 if cmd = 'showhistory' then
438 if CommandHistory <> nil then
439 begin
440 g_Console_Add('');
441 for a := 0 to High(CommandHistory) do
442 g_Console_Add(' '+CommandHistory[a]);
443 end;
445 if cmd = 'commands' then
446 begin
447 g_Console_Add('');
448 g_Console_Add('commands list:');
449 for a := High(commands) downto 0 do
450 begin
451 if (Length(commands[a].help) > 0) then
452 begin
453 g_Console_Add(' '+commands[a].cmd+' -- '+commands[a].help);
454 end
455 else
456 begin
457 g_Console_Add(' '+commands[a].cmd);
458 end;
459 end;
460 end;
462 if cmd = 'time' then
463 g_Console_Add(TimeToStr(Now), True);
465 if cmd = 'date' then
466 g_Console_Add(DateToStr(Now), True);
468 if cmd = 'echo' then
469 if Length(p) > 1 then
470 begin
471 if p[1] = 'ololo' then
472 gCheats := True
473 else
474 begin
475 s := '';
476 for a := 1 to High(p) do
477 s := s + p[a] + ' ';
478 g_Console_Add(b_Text_Format(s), True);
479 end;
480 end
481 else
482 g_Console_Add('');
484 if cmd = 'dump' then
485 begin
486 (*
487 if ConsoleHistory <> nil then
488 begin
489 if Length(P) > 1 then
490 s := P[1]
491 else
492 s := GameDir+'/console.txt';
494 {$I-}
495 AssignFile(F, s);
496 Rewrite(F);
497 if IOResult <> 0 then
498 begin
499 g_Console_Add(Format(_lc[I_CONSOLE_ERROR_WRITE], [s]));
500 CloseFile(F);
501 Exit;
502 end;
504 for a := 0 to High(ConsoleHistory) do
505 WriteLn(F, ConsoleHistory[a]);
507 CloseFile(F);
508 g_Console_Add(Format(_lc[I_CONSOLE_DUMPED], [s]));
509 {$I+}
510 end;
511 *)
512 end;
514 if cmd = 'exec' then
515 begin
516 // exec <filename>
517 if Length(p) = 2 then
518 g_Console_ReadConfig(GameDir + '/' + p[1])
519 else
520 g_Console_Add('exec <script file>');
521 end;
523 if cmd = 'writeconfig' then
524 begin
525 // writeconfig <filename>
526 if Length(p) = 2 then
527 g_Console_WriteConfig(GameDir + '/' + p[1])
528 else
529 g_Console_Add('writeconfig <file>');
530 end;
532 if (cmd = 'ver') or (cmd = 'version') then
533 begin
534 conwriteln('Doom 2D: Forever v. ' + GAME_VERSION);
535 conwritefln('Net protocol v. %d', [NET_PROTOCOL_VER]);
536 conwritefln('Build date: %s at %s', [GAME_BUILDDATE, GAME_BUILDTIME]);
537 end;
539 if cmd = 'alias' then
540 begin
541 // alias [alias_name] [commands]
542 if Length(p) > 1 then
543 begin
544 for a := 0 to High(Aliases) do
545 if Aliases[a].name = p[1] then
546 begin
547 if Length(p) > 2 then
548 Aliases[a].commands := ParseAlias(p[2])
549 else
550 for b := 0 to High(Aliases[a].commands) do
551 g_Console_Add(Aliases[a].commands[b]);
552 Exit;
553 end;
554 SetLength(Aliases, Length(Aliases)+1);
555 a := High(Aliases);
556 Aliases[a].name := p[1];
557 if Length(p) > 2 then
558 Aliases[a].commands := ParseAlias(p[2])
559 else
560 for b := 0 to High(Aliases[a].commands) do
561 g_Console_Add(Aliases[a].commands[b]);
562 end else
563 for a := 0 to High(Aliases) do
564 if Aliases[a].commands <> nil then
565 g_Console_Add(Aliases[a].name);
566 end;
568 if cmd = 'call' then
569 begin
570 // call <alias_name>
571 if Length(p) > 1 then
572 begin
573 if Aliases = nil then
574 Exit;
575 for a := 0 to High(Aliases) do
576 if Aliases[a].name = p[1] then
577 begin
578 if Aliases[a].commands <> nil then
579 begin
580 // with this system proper endless loop detection seems either impossible
581 // or very dirty to implement, so let's have this instead
582 // prevents endless loops
583 for b := 0 to High(Aliases[a].commands) do
584 begin
585 Inc(RecursionDepth);
586 RecursionLimitHit := (RecursionDepth > MaxScriptRecursion) or RecursionLimitHit;
587 if not RecursionLimitHit then
588 g_Console_Process(Aliases[a].commands[b], True);
589 Dec(RecursionDepth);
590 end;
591 if (RecursionDepth = 0) and RecursionLimitHit then
592 begin
593 g_Console_Add(Format(_lc[I_CONSOLE_ERROR_CALL], [s]));
594 RecursionLimitHit := False;
595 end;
596 end;
597 Exit;
598 end;
599 end
600 else
601 g_Console_Add('call <alias name>');
602 end;
603 end;
605 procedure WhitelistCommand(cmd: AnsiString);
606 var
607 a: Integer;
608 begin
609 SetLength(Whitelist, Length(Whitelist)+1);
610 a := High(Whitelist);
611 Whitelist[a] := LowerCase(cmd);
612 end;
614 procedure segfault (p: SSArray);
615 var
616 pp: PByte = nil;
617 begin
618 pp^ := 0;
619 end;
621 function GetCommandString (p: SSArray): AnsiString;
622 var i: Integer;
623 begin
624 result := '';
625 if Length(p) >= 1 then
626 begin
627 result := p[0];
628 for i := 1 to High(p) do
629 result := result + '; ' + p[i]
630 end
631 end;
633 procedure BindCommands (p: SSArray);
634 var cmd, key: AnsiString; i: Integer;
635 begin
636 cmd := LowerCase(p[0]);
637 case cmd of
638 'bind':
639 // bind <key> [down [up]]
640 if (Length(p) >= 2) and (Length(p) <= 4) then
641 begin
642 i := 0;
643 key := LowerCase(p[1]);
644 while (i < e_MaxInputKeys) and (key <> LowerCase(e_KeyNames[i])) do inc(i);
645 if i < e_MaxInputKeys then
646 begin
647 if Length(p) = 2 then
648 g_Console_Add('"' + e_KeyNames[i] + '" = "' + GetCommandString(gInputBinds[i].down) + '" "' + GetCommandString(gInputBinds[i].up) + '"')
649 else if Length(p) = 3 then
650 g_Console_BindKey(i, p[2], '')
651 else (* len = 4 *)
652 g_Console_BindKey(i, p[2], p[3])
653 end
654 else
655 g_Console_Add('bind: "' + p[1] + '" is not a key')
656 end
657 else
658 begin
659 g_Console_Add('bind <key> <down action> [up action]')
660 end;
661 'bindlist':
662 for i := 0 to e_MaxInputKeys - 1 do
663 if (gInputBinds[i].down <> nil) or (gInputBinds[i].up <> nil) then
664 g_Console_Add(e_KeyNames[i] + ' "' + GetCommandString(gInputBinds[i].down) + '" "' + GetCommandString(gInputBinds[i].up) + '"');
665 'unbind':
666 // unbind <key>
667 if Length(p) = 2 then
668 begin
669 key := LowerCase(p[1]);
670 i := 0;
671 while (i < e_MaxInputKeys) and (key <> LowerCase(e_KeyNames[i])) do inc(i);
672 if i < e_MaxInputKeys then
673 g_Console_BindKey(i, '')
674 else
675 g_Console_Add('unbind: "' + p[1] + '" is not a key')
676 end
677 else
678 g_Console_Add('unbind <key>');
679 'unbindall':
680 for i := 0 to e_MaxInputKeys - 1 do
681 g_Console_BindKey(i, '');
682 'showkeyboard':
683 g_Touch_ShowKeyboard(True);
684 'hidekeyboard':
685 g_Touch_ShowKeyboard(False);
686 'togglemenu':
687 begin
688 // this is HACK
689 KeyPress(VK_ESCAPE);
690 menu_toggled := True
691 end;
692 end
693 end;
695 procedure AddCommand(cmd: AnsiString; proc: TCmdProc; ahelp: AnsiString=''; ahidden: Boolean=false; acheat: Boolean=false);
696 var
697 a: Integer;
698 cp: PCommand;
699 begin
700 SetLength(commands, Length(commands)+1);
701 a := High(commands);
702 cp := @commands[a];
703 cp.cmd := LowerCase(cmd);
704 cp.proc := proc;
705 cp.procEx := nil;
706 cp.help := ahelp;
707 cp.hidden := ahidden;
708 cp.ptr := nil;
709 cp.msg := '';
710 cp.cheat := acheat;
711 cp.action := -1;
712 cp.player := -1;
713 end;
715 procedure AddAction (cmd: AnsiString; action: Integer; help: AnsiString = ''; hidden: Boolean = False; cheat: Boolean = False);
716 const
717 PrefixList: array [0..1] of AnsiString = ('+', '-');
718 PlayerList: array [0..1] of Integer = (1, 2);
719 var
720 s: AnsiString;
721 i: Integer;
723 procedure NewAction (cmd: AnsiString; player: Integer);
724 var cp: PCommand;
725 begin
726 SetLength(commands, Length(commands) + 1);
727 cp := @commands[High(commands)];
728 cp.cmd := LowerCase(cmd);
729 cp.proc := nil;
730 cp.procEx := nil;
731 cp.help := help;
732 cp.hidden := hidden;
733 cp.ptr := nil;
734 cp.msg := '';
735 cp.cheat := cheat;
736 cp.action := action;
737 cp.player := player;
738 end;
740 begin
741 ASSERT(action >= FIRST_ACTION);
742 ASSERT(action <= LAST_ACTION);
743 for s in PrefixList do
744 begin
745 NewAction(s + cmd, 0);
746 for i in PlayerList do
747 NewAction(s + 'p' + IntToStr(i) + '_' + cmd, i - 1)
748 end
749 end;
751 procedure g_Console_Init();
752 var
753 a: Integer;
754 begin
755 g_Texture_CreateWAD(ID, GameWAD+':TEXTURES\CONSOLE');
756 Cons_Y := -(gScreenHeight div 2);
757 gConsoleShow := False;
758 gChatShow := False;
759 Cons_Shown := False;
760 CPos := 1;
762 for a := 0 to High(MsgArray) do
763 with MsgArray[a] do
764 begin
765 Msg := '';
766 Time := 0;
767 end;
769 AddCommand('segfault', segfault, 'make segfault');
771 AddCommand('bind', BindCommands);
772 AddCommand('bindlist', BindCommands);
773 AddCommand('unbind', BindCommands);
774 AddCommand('unbindall', BindCommands);
775 AddCommand('showkeyboard', BindCommands);
776 AddCommand('hidekeyboard', BindCommands);
777 AddCommand('togglemenu', BindCommands);
779 AddCommand('clear', ConsoleCommands, 'clear console');
780 AddCommand('clearhistory', ConsoleCommands);
781 AddCommand('showhistory', ConsoleCommands);
782 AddCommand('commands', ConsoleCommands);
783 AddCommand('time', ConsoleCommands);
784 AddCommand('date', ConsoleCommands);
785 AddCommand('echo', ConsoleCommands);
786 AddCommand('dump', ConsoleCommands);
787 AddCommand('exec', ConsoleCommands);
788 AddCommand('writeconfig', ConsoleCommands);
789 AddCommand('alias', ConsoleCommands);
790 AddCommand('call', ConsoleCommands);
791 AddCommand('ver', ConsoleCommands);
792 AddCommand('version', ConsoleCommands);
794 AddCommand('d_window', DebugCommands);
795 AddCommand('d_sounds', DebugCommands);
796 AddCommand('d_frames', DebugCommands);
797 AddCommand('d_winmsg', DebugCommands);
798 AddCommand('d_monoff', DebugCommands);
799 AddCommand('d_botoff', DebugCommands);
800 AddCommand('d_monster', DebugCommands);
801 AddCommand('d_health', DebugCommands);
802 AddCommand('d_player', DebugCommands);
803 AddCommand('d_joy', DebugCommands);
804 AddCommand('d_mem', DebugCommands);
806 AddCommand('p1_name', GameCVars);
807 AddCommand('p2_name', GameCVars);
808 AddCommand('p1_color', GameCVars);
809 AddCommand('p2_color', GameCVars);
810 AddCommand('r_showtime', GameCVars);
811 AddCommand('r_showscore', GameCVars);
812 AddCommand('r_showlives', GameCVars);
813 AddCommand('r_showstat', GameCVars);
814 AddCommand('r_showkillmsg', GameCVars);
815 AddCommand('r_showspect', GameCVars);
816 AddCommand('r_showping', GameCVars);
817 AddCommand('g_gamemode', GameCVars);
818 AddCommand('g_friendlyfire', GameCVars);
819 AddCommand('g_weaponstay', GameCVars);
820 AddCommand('g_allow_exit', GameCVars);
821 AddCommand('g_allow_monsters', GameCVars);
822 AddCommand('g_bot_vsmonsters', GameCVars);
823 AddCommand('g_bot_vsplayers', GameCVars);
824 AddCommand('g_scorelimit', GameCVars);
825 AddCommand('g_timelimit', GameCVars);
826 AddCommand('g_maxlives', GameCVars);
827 AddCommand('g_warmuptime', GameCVars);
828 AddCommand('net_interp', GameCVars);
829 AddCommand('net_forceplayerupdate', GameCVars);
830 AddCommand('net_predictself', GameCVars);
831 AddCommand('sv_name', GameCVars);
832 AddCommand('sv_passwd', GameCVars);
833 AddCommand('sv_maxplrs', GameCVars);
834 AddCommand('sv_public', GameCVars);
835 AddCommand('sv_intertime', GameCVars);
837 AddCommand('quit', GameCommands);
838 AddCommand('exit', GameCommands);
839 AddCommand('pause', GameCommands);
840 AddCommand('endgame', GameCommands);
841 AddCommand('restart', GameCommands);
842 AddCommand('addbot', GameCommands);
843 AddCommand('bot_add', GameCommands);
844 AddCommand('bot_addlist', GameCommands);
845 AddCommand('bot_addred', GameCommands);
846 AddCommand('bot_addblue', GameCommands);
847 AddCommand('bot_removeall', GameCommands);
848 AddCommand('chat', GameCommands);
849 AddCommand('teamchat', GameCommands);
850 AddCommand('game', GameCommands);
851 AddCommand('host', GameCommands);
852 AddCommand('map', GameCommands);
853 AddCommand('nextmap', GameCommands);
854 AddCommand('endmap', GameCommands);
855 AddCommand('goodbye', GameCommands);
856 AddCommand('suicide', GameCommands);
857 AddCommand('spectate', GameCommands);
858 AddCommand('ready', GameCommands);
859 AddCommand('kick', GameCommands);
860 AddCommand('kick_id', GameCommands);
861 AddCommand('ban', GameCommands);
862 AddCommand('permban', GameCommands);
863 AddCommand('ban_id', GameCommands);
864 AddCommand('permban_id', GameCommands);
865 AddCommand('unban', GameCommands);
866 AddCommand('connect', GameCommands);
867 AddCommand('disconnect', GameCommands);
868 AddCommand('reconnect', GameCommands);
869 AddCommand('say', GameCommands);
870 AddCommand('tell', GameCommands);
871 AddCommand('overtime', GameCommands);
872 AddCommand('rcon_password', GameCommands);
873 AddCommand('rcon', GameCommands);
874 AddCommand('callvote', GameCommands);
875 AddCommand('vote', GameCommands);
876 AddCommand('clientlist', GameCommands);
877 AddCommand('event', GameCommands);
878 AddCommand('screenshot', GameCommands);
879 AddCommand('togglechat', GameCommands);
880 AddCommand('toggleteamchat', GameCommands);
881 AddCommand('weapon', GameCommands);
882 AddCommand('p1_weapon', GameCommands);
883 AddCommand('p2_weapon', GameCommands);
885 AddCommand('god', GameCheats);
886 AddCommand('notarget', GameCheats);
887 AddCommand('give', GameCheats); // "exit" too ;-)
888 AddCommand('open', GameCheats);
889 AddCommand('fly', GameCheats);
890 AddCommand('noclip', GameCheats);
891 AddCommand('speedy', GameCheats);
892 AddCommand('jumpy', GameCheats);
893 AddCommand('noreload', GameCheats);
894 AddCommand('aimline', GameCheats);
895 AddCommand('automap', GameCheats);
897 AddAction('jump', ACTION_JUMP);
898 AddAction('moveleft', ACTION_MOVELEFT);
899 AddAction('moveright', ACTION_MOVERIGHT);
900 AddAction('lookup', ACTION_LOOKUP);
901 AddAction('lookdown', ACTION_LOOKDOWN);
902 AddAction('attack', ACTION_ATTACK);
903 AddAction('scores', ACTION_SCORES);
904 AddAction('activate', ACTION_ACTIVATE);
905 AddAction('strafe', ACTION_STRAFE);
906 AddAction('weapnext', ACTION_WEAPNEXT);
907 AddAction('weapprev', ACTION_WEAPPREV);
909 WhitelistCommand('say');
910 WhitelistCommand('tell');
911 WhitelistCommand('overtime');
912 WhitelistCommand('ready');
913 WhitelistCommand('map');
914 WhitelistCommand('nextmap');
915 WhitelistCommand('endmap');
916 WhitelistCommand('restart');
917 WhitelistCommand('kick');
918 WhitelistCommand('ban');
920 WhitelistCommand('addbot');
921 WhitelistCommand('bot_add');
922 WhitelistCommand('bot_addred');
923 WhitelistCommand('bot_addblue');
924 WhitelistCommand('bot_removeall');
926 WhitelistCommand('g_gamemode');
927 WhitelistCommand('g_friendlyfire');
928 WhitelistCommand('g_weaponstay');
929 WhitelistCommand('g_allow_exit');
930 WhitelistCommand('g_allow_monsters');
931 WhitelistCommand('g_scorelimit');
932 WhitelistCommand('g_timelimit');
934 g_Console_ResetBinds;
935 g_Console_ReadConfig(GameDir + '/dfconfig.cfg');
936 g_Console_ReadConfig(GameDir + '/autoexec.cfg');
938 g_Console_Add(Format(_lc[I_CONSOLE_WELCOME], [GAME_VERSION]));
939 g_Console_Add('');
940 end;
942 procedure g_Console_Update();
943 var
944 a, b: Integer;
945 begin
946 if Cons_Shown then
947 begin
948 // Â ïðîöåññå îòêðûòèÿ:
949 if gConsoleShow and (Cons_Y < 0) then
950 begin
951 Cons_Y := Cons_Y+Step;
952 end;
954 // Â ïðîöåññå çàêðûòèÿ:
955 if (not gConsoleShow) and
956 (Cons_Y > -(gScreenHeight div 2)) then
957 Cons_Y := Cons_Y-Step;
959 // Îêîí÷àòåëüíî îòêðûëàñü:
960 if Cons_Y > 0 then
961 Cons_Y := 0;
963 // Îêîí÷àòåëüíî çàêðûëàñü:
964 if Cons_Y <= (-(gScreenHeight div 2)) then
965 begin
966 Cons_Y := -(gScreenHeight div 2);
967 Cons_Shown := False;
968 end;
969 end;
971 a := 0;
972 while a <= High(MsgArray) do
973 begin
974 if MsgArray[a].Time > 0 then
975 begin
976 if MsgArray[a].Time = 1 then
977 begin
978 if a < High(MsgArray) then
979 begin
980 for b := a to High(MsgArray)-1 do
981 MsgArray[b] := MsgArray[b+1];
983 MsgArray[High(MsgArray)].Time := 0;
985 a := a - 1;
986 end;
987 end
988 else
989 Dec(MsgArray[a].Time);
990 end;
992 a := a + 1;
993 end;
994 end;
997 procedure drawConsoleText ();
998 var
999 CWidth, CHeight: Byte;
1000 ty: Integer;
1001 sp, ep: LongWord;
1002 skip: Integer;
1004 procedure putLine (sp, ep: LongWord);
1005 var
1006 p: LongWord;
1007 wdt, cw: Integer;
1008 begin
1009 p := sp;
1010 wdt := 0;
1011 while p <> ep do
1012 begin
1013 cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
1014 if wdt+cw > gScreenWidth-8 then break;
1015 //e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1016 Inc(wdt, cw);
1017 cbufNext(p);
1018 end;
1019 if p <> ep then putLine(p, ep); // do rest of the line first
1020 // now print our part
1021 if skip = 0 then
1022 begin
1023 ep := p;
1024 p := sp;
1025 wdt := 2;
1026 while p <> ep do
1027 begin
1028 cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
1029 e_TextureFontPrintCharEx(wdt, ty, cbufAt(p), gStdFont);
1030 Inc(wdt, cw);
1031 cbufNext(p);
1032 end;
1033 Dec(ty, CHeight);
1034 end
1035 else
1036 begin
1037 Dec(skip);
1038 end;
1039 end;
1041 begin
1042 e_TextureFontGetSize(gStdFont, CWidth, CHeight);
1043 ty := (gScreenHeight div 2)-4-2*CHeight-Abs(Cons_Y);
1044 skip := conSkipLines;
1045 cbufLastLine(sp, ep);
1046 repeat
1047 putLine(sp, ep);
1048 if ty+CHeight <= 0 then break;
1049 until not cbufLineUp(sp, ep);
1050 end;
1052 procedure g_Console_Draw();
1053 var
1054 CWidth, CHeight: Byte;
1055 mfW, mfH: Word;
1056 a, b: Integer;
1057 begin
1058 e_TextureFontGetSize(gStdFont, CWidth, CHeight);
1060 for a := 0 to High(MsgArray) do
1061 if MsgArray[a].Time > 0 then
1062 e_TextureFontPrintFmt(0, CHeight*a, MsgArray[a].Msg,
1063 gStdFont, True);
1065 if not Cons_Shown then
1066 begin
1067 if gChatShow then
1068 begin
1069 if gChatTeam then
1070 begin
1071 e_TextureFontPrintEx(0, gScreenHeight - CHeight - 1, 'say team> ' + Line,
1072 gStdFont, 255, 255, 255, 1, True);
1073 e_TextureFontPrintEx((CPos + 9)*CWidth, gScreenHeight - CHeight - 1, '_',
1074 gStdFont, 255, 255, 255, 1, True);
1075 end
1076 else
1077 begin
1078 e_TextureFontPrintEx(0, gScreenHeight - CHeight - 1, 'say> ' + Line,
1079 gStdFont, 255, 255, 255, 1, True);
1080 e_TextureFontPrintEx((CPos + 4)*CWidth, gScreenHeight - CHeight - 1, '_',
1081 gStdFont, 255, 255, 255, 1, True);
1082 end;
1083 end;
1084 Exit;
1085 end;
1087 if gDebugMode then
1088 begin
1089 e_CharFont_GetSize(gMenuFont, DEBUG_STRING, mfW, mfH);
1090 a := (gScreenWidth - 2*mfW) div 2;
1091 b := Cons_Y + ((gScreenHeight div 2) - 2*mfH) div 2;
1092 e_CharFont_PrintEx(gMenuFont, a div 2, b div 2, DEBUG_STRING,
1093 _RGB(128, 0, 0), 2.0);
1094 end;
1096 e_DrawSize(ID, 0, Cons_Y, Alpha, False, False, gScreenWidth, gScreenHeight div 2);
1097 e_TextureFontPrint(0, Cons_Y+(gScreenHeight div 2)-CHeight-4, '> '+Line, gStdFont);
1099 drawConsoleText();
1100 (*
1101 if ConsoleHistory <> nil then
1102 begin
1103 b := 0;
1104 if CHeight > 0 then
1105 if Length(ConsoleHistory) > ((gScreenHeight div 2) div CHeight)-1 then
1106 b := Length(ConsoleHistory)-((gScreenHeight div 2) div CHeight)+1;
1108 b := Max(b-Offset, 0);
1109 d := Max(High(ConsoleHistory)-Offset, 0);
1111 c := 2;
1112 for a := d downto b do
1113 begin
1114 e_TextureFontPrintFmt(0, (gScreenHeight div 2)-4-c*CHeight-Abs(Cons_Y), ConsoleHistory[a],
1115 gStdFont, True);
1116 c := c + 1;
1117 end;
1118 end;
1119 *)
1121 e_TextureFontPrint((CPos+1)*CWidth, Cons_Y+(gScreenHeight div 2)-21, '_', gStdFont);
1122 end;
1124 procedure g_Console_Switch();
1125 begin
1126 gChatShow := False;
1127 gConsoleShow := not gConsoleShow;
1128 Cons_Shown := True;
1129 g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
1130 end;
1132 procedure g_Console_Chat_Switch(Team: Boolean = False);
1133 begin
1134 if not g_Game_IsNet then Exit;
1135 gConsoleShow := False;
1136 gChatShow := not gChatShow;
1137 gChatTeam := Team;
1138 Line := '';
1139 CPos := 1;
1140 g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
1141 end;
1143 procedure g_Console_Char(C: AnsiChar);
1144 begin
1145 // if gChatShow then
1146 // Exit;
1147 Insert(C, Line, CPos);
1148 CPos := CPos + 1;
1149 end;
1152 var
1153 tcomplist: array of AnsiString = nil;
1154 tcompidx: array of Integer = nil;
1156 procedure Complete ();
1157 var
1158 i, c: Integer;
1159 tused: Integer;
1160 ll, lpfx, cmd: AnsiString;
1161 begin
1162 if (Length(Line) = 0) then
1163 begin
1164 g_Console_Add('');
1165 for i := 0 to High(commands) do
1166 begin
1167 // hidden commands are hidden when cheats aren't enabled
1168 if commands[i].hidden and not conIsCheatsEnabled then continue;
1169 if (Length(commands[i].help) > 0) then
1170 begin
1171 g_Console_Add(' '+commands[i].cmd+' -- '+commands[i].help);
1172 end
1173 else
1174 begin
1175 g_Console_Add(' '+commands[i].cmd);
1176 end;
1177 end;
1178 exit;
1179 end;
1181 ll := LowerCase(Line);
1182 lpfx := '';
1184 if (Length(ll) > 1) and (ll[Length(ll)] = ' ') then
1185 begin
1186 ll := Copy(ll, 0, Length(ll)-1);
1187 for i := 0 to High(commands) do
1188 begin
1189 // hidden commands are hidden when cheats aren't enabled
1190 if commands[i].hidden and not conIsCheatsEnabled then continue;
1191 if (commands[i].cmd = ll) then
1192 begin
1193 if (Length(commands[i].help) > 0) then
1194 begin
1195 g_Console_Add(' '+commands[i].cmd+' -- '+commands[i].help);
1196 end;
1197 end;
1198 end;
1199 exit;
1200 end;
1202 // build completion list
1203 tused := 0;
1204 for i := 0 to High(commands) do
1205 begin
1206 // hidden commands are hidden when cheats aren't enabled
1207 if commands[i].hidden and not conIsCheatsEnabled then continue;
1208 cmd := commands[i].cmd;
1209 if (Length(cmd) >= Length(ll)) and (ll = Copy(cmd, 0, Length(ll))) then
1210 begin
1211 if (tused = Length(tcomplist)) then
1212 begin
1213 SetLength(tcomplist, Length(tcomplist)+128);
1214 SetLength(tcompidx, Length(tcompidx)+128);
1215 end;
1216 tcomplist[tused] := cmd;
1217 tcompidx[tused] := i;
1218 Inc(tused);
1219 if (Length(cmd) > Length(lpfx)) then lpfx := cmd;
1220 end;
1221 end;
1223 // get longest prefix
1224 for i := 0 to tused-1 do
1225 begin
1226 cmd := tcomplist[i];
1227 for c := 1 to Length(lpfx) do
1228 begin
1229 if (c > Length(cmd)) then break;
1230 if (cmd[c] <> lpfx[c]) then begin lpfx := Copy(lpfx, 0, c-1); break; end;
1231 end;
1232 end;
1234 if (tused = 0) then exit;
1236 if (tused = 1) then
1237 begin
1238 Line := tcomplist[0]+' ';
1239 CPos := Length(Line)+1;
1240 end
1241 else
1242 begin
1243 // has longest prefix?
1244 if (Length(lpfx) > Length(ll)) then
1245 begin
1246 Line := lpfx;
1247 CPos:= Length(Line)+1;
1248 end
1249 else
1250 begin
1251 g_Console_Add('');
1252 for i := 0 to tused-1 do
1253 begin
1254 if (Length(commands[tcompidx[i]].help) > 0) then
1255 begin
1256 g_Console_Add(' '+tcomplist[i]+' -- '+commands[tcompidx[i]].help);
1257 end
1258 else
1259 begin
1260 g_Console_Add(' '+tcomplist[i]);
1261 end;
1262 end;
1263 end;
1264 end;
1265 end;
1268 procedure g_Console_Control(K: Word);
1269 begin
1270 case K of
1271 IK_BACKSPACE:
1272 if (Length(Line) > 0) and (CPos > 1) then
1273 begin
1274 Delete(Line, CPos-1, 1);
1275 CPos := CPos-1;
1276 end;
1277 IK_DELETE:
1278 if (Length(Line) > 0) and (CPos <= Length(Line)) then
1279 Delete(Line, CPos, 1);
1280 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
1281 if CPos > 1 then
1282 CPos := CPos - 1;
1283 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
1284 if CPos <= Length(Line) then
1285 CPos := CPos + 1;
1286 IK_RETURN, IK_KPRETURN, VK_OPEN, VK_FIRE, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
1287 begin
1288 if Cons_Shown then
1289 g_Console_Process(Line)
1290 else
1291 if gChatShow then
1292 begin
1293 if (Length(Line) > 0) and g_Game_IsNet then
1294 begin
1295 if gChatTeam then
1296 begin
1297 if g_Game_IsClient then
1298 MC_SEND_Chat(b_Text_Format(Line), NET_CHAT_TEAM)
1299 else
1300 MH_SEND_Chat('[' + gPlayer1Settings.name + ']: ' + b_Text_Format(Line),
1301 NET_CHAT_TEAM, gPlayer1Settings.Team);
1302 end
1303 else
1304 begin
1305 if g_Game_IsClient then
1306 MC_SEND_Chat(b_Text_Format(Line), NET_CHAT_PLAYER)
1307 else
1308 MH_SEND_Chat('[' + gPlayer1Settings.name + ']: ' + b_Text_Format(Line),
1309 NET_CHAT_PLAYER);
1310 end;
1311 end;
1313 Line := '';
1314 CPos := 1;
1315 gChatShow := False;
1316 gJustChatted := True;
1317 g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
1318 end;
1319 end;
1320 IK_TAB:
1321 if not gChatShow then
1322 Complete();
1323 IK_DOWN, IK_KPDOWN, VK_DOWN, JOY0_DOWN, JOY1_DOWN, JOY2_DOWN, JOY3_DOWN:
1324 if not gChatShow then
1325 if (CommandHistory <> nil) and
1326 (CmdIndex < Length(CommandHistory)) then
1327 begin
1328 if CmdIndex < Length(CommandHistory)-1 then
1329 CmdIndex := CmdIndex + 1;
1330 Line := CommandHistory[CmdIndex];
1331 CPos := Length(Line) + 1;
1332 end;
1333 IK_UP, IK_KPUP, VK_UP, JOY0_UP, JOY1_UP, JOY2_UP, JOY3_UP:
1334 if not gChatShow then
1335 if (CommandHistory <> nil) and
1336 (CmdIndex <= Length(CommandHistory)) then
1337 begin
1338 if CmdIndex > 0 then
1339 CmdIndex := CmdIndex - 1;
1340 Line := CommandHistory[CmdIndex];
1341 Cpos := Length(Line) + 1;
1342 end;
1343 IK_PAGEUP, IK_KPPAGEUP, VK_PREV, JOY0_PREV, JOY1_PREV, JOY2_PREV, JOY3_PREV: // PgUp
1344 if not gChatShow then Inc(conSkipLines);
1345 IK_PAGEDN, IK_KPPAGEDN, VK_NEXT, JOY0_NEXT, JOY1_NEXT, JOY2_NEXT, JOY3_NEXT: // PgDown
1346 if not gChatShow and (conSkipLines > 0) then Dec(conSkipLines);
1347 IK_HOME, IK_KPHOME:
1348 CPos := 1;
1349 IK_END, IK_KPEND:
1350 CPos := Length(Line) + 1;
1351 end;
1352 end;
1354 function GetStr(var Str: AnsiString): AnsiString;
1355 var
1356 a, b: Integer;
1357 begin
1358 Result := '';
1359 if Str[1] = '"' then
1360 begin
1361 for b := 1 to Length(Str) do
1362 if (b = Length(Str)) or (Str[b+1] = '"') then
1363 begin
1364 Result := Copy(Str, 2, b-1);
1365 Delete(Str, 1, b+1);
1366 Str := Trim(Str);
1367 Exit;
1368 end;
1369 end;
1371 for a := 1 to Length(Str) do
1372 if (a = Length(Str)) or (Str[a+1] = ' ') then
1373 begin
1374 Result := Copy(Str, 1, a);
1375 Delete(Str, 1, a+1);
1376 Str := Trim(Str);
1377 Exit;
1378 end;
1379 end;
1381 function ParseString(Str: AnsiString): SSArray;
1382 begin
1383 Result := nil;
1385 Str := Trim(Str);
1387 if Str = '' then
1388 Exit;
1390 while Str <> '' do
1391 begin
1392 SetLength(Result, Length(Result)+1);
1393 Result[High(Result)] := GetStr(Str);
1394 end;
1395 end;
1397 procedure g_Console_Add (L: AnsiString; show: Boolean=false);
1399 procedure conmsg (s: AnsiString);
1400 var
1401 a: Integer;
1402 begin
1403 if length(s) = 0 then exit;
1404 for a := 0 to High(MsgArray) do
1405 begin
1406 with MsgArray[a] do
1407 begin
1408 if Time = 0 then
1409 begin
1410 Msg := s;
1411 Time := MsgTime;
1412 exit;
1413 end;
1414 end;
1415 end;
1416 for a := 0 to High(MsgArray)-1 do MsgArray[a] := MsgArray[a+1];
1417 with MsgArray[High(MsgArray)] do
1418 begin
1419 Msg := L;
1420 Time := MsgTime;
1421 end;
1422 end;
1424 var
1425 f: Integer;
1426 begin
1427 // put it to console
1428 cbufPut(L);
1429 if (length(L) = 0) or ((L[length(L)] <> #10) and (L[length(L)] <> #13)) then cbufPut(#10);
1431 // now show 'em out of console too
1432 show := show and gAllowConsoleMessages;
1433 if show and gShowMessages then
1434 begin
1435 // Âûâîä ñòðîê ñ ïåðåíîñàìè ïî î÷åðåäè
1436 while length(L) > 0 do
1437 begin
1438 f := Pos(#10, L);
1439 if f <= 0 then f := length(L)+1;
1440 conmsg(Copy(L, 1, f-1));
1441 Delete(L, 1, f);
1442 end;
1443 end;
1445 //SetLength(ConsoleHistory, Length(ConsoleHistory)+1);
1446 //ConsoleHistory[High(ConsoleHistory)] := L;
1448 (*
1449 {$IFDEF HEADLESS}
1450 e_WriteLog('CON: ' + L, MSG_NOTIFY);
1451 {$ENDIF}
1452 *)
1453 end;
1456 var
1457 consolewriterLastWasEOL: Boolean = false;
1459 procedure consolewriter (constref buf; len: SizeUInt);
1460 var
1461 b: PByte;
1462 begin
1463 if (len < 1) then exit;
1464 b := PByte(@buf);
1465 consolewriterLastWasEOL := (b[len-1] = 13) or (b[len-1] = 10);
1466 while (len > 0) do
1467 begin
1468 if (b[0] <> 13) and (b[0] <> 10) then
1469 begin
1470 cbufPut(AnsiChar(b[0]));
1471 end
1472 else
1473 begin
1474 if (len > 1) and (b[0] = 13) then begin len -= 1; b += 1; end;
1475 cbufPut(#10);
1476 end;
1477 len -= 1;
1478 b += 1;
1479 end;
1480 end;
1483 // returns formatted string if `writerCB` is `nil`, empty string otherwise
1484 //function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1485 //TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
1486 procedure conwriteln (const s: AnsiString; show: Boolean=false);
1487 begin
1488 g_Console_Add(s, show);
1489 end;
1492 procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
1493 begin
1494 if show then
1495 begin
1496 g_Console_Add(formatstrf(s, args), true);
1497 end
1498 else
1499 begin
1500 consolewriterLastWasEOL := false;
1501 formatstrf(s, args, consolewriter);
1502 if not consolewriterLastWasEOL then cbufPut(#10);
1503 end;
1504 end;
1507 procedure g_Console_Clear();
1508 begin
1509 //ConsoleHistory := nil;
1510 cbufClear();
1511 conSkipLines := 0;
1512 end;
1514 procedure AddToHistory(L: AnsiString);
1515 var
1516 len: Integer;
1517 begin
1518 len := Length(CommandHistory);
1520 if (len = 0) or
1521 (LowerCase(CommandHistory[len-1]) <> LowerCase(L)) then
1522 begin
1523 SetLength(CommandHistory, len+1);
1524 CommandHistory[len] := L;
1525 end;
1527 CmdIndex := Length(CommandHistory);
1528 end;
1530 function g_Console_CommandBlacklisted(C: AnsiString): Boolean;
1531 var
1532 Arr: SSArray;
1533 i: Integer;
1534 begin
1535 Result := True;
1537 Arr := nil;
1539 if Trim(C) = '' then
1540 Exit;
1542 Arr := ParseString(C);
1543 if Arr = nil then
1544 Exit;
1546 for i := 0 to High(Whitelist) do
1547 if Whitelist[i] = LowerCase(Arr[0]) then
1548 Result := False;
1549 end;
1551 procedure g_Console_Process(L: AnsiString; quiet: Boolean = False);
1552 var
1553 Arr: SSArray;
1554 i: Integer;
1555 begin
1556 Arr := nil;
1558 if Trim(L) = '' then
1559 Exit;
1561 conSkipLines := 0; // "unscroll"
1563 if L = 'goobers' then
1564 begin
1565 Line := '';
1566 CPos := 1;
1567 gCheats := true;
1568 g_Console_Add('Your memory serves you well.');
1569 exit;
1570 end;
1572 if not quiet then
1573 begin
1574 g_Console_Add('> '+L);
1575 Line := '';
1576 CPos := 1;
1577 end;
1579 Arr := ParseString(L);
1580 if Arr = nil then
1581 Exit;
1583 if commands = nil then
1584 Exit;
1586 if not quiet then
1587 AddToHistory(L);
1589 for i := 0 to High(commands) do
1590 begin
1591 if commands[i].cmd = LowerCase(Arr[0]) then
1592 begin
1593 if commands[i].action >= 0 then
1594 begin
1595 gPlayerAction[commands[i].player, commands[i].action] := commands[i].cmd[1] = '+';
1596 exit
1597 end;
1598 if assigned(commands[i].procEx) then
1599 begin
1600 commands[i].procEx(@commands[i], Arr);
1601 exit
1602 end;
1603 if assigned(commands[i].proc) then
1604 begin
1605 commands[i].proc(Arr);
1606 exit
1607 end
1608 end
1609 end;
1611 g_Console_Add(Format(_lc[I_CONSOLE_UNKNOWN], [Arr[0]]));
1612 end;
1615 function g_Console_Interactive: Boolean;
1616 begin
1617 Result := gConsoleShow
1618 end;
1620 procedure g_Console_BindKey (key: Integer; down: AnsiString; up: AnsiString = '');
1621 begin
1622 //e_LogWritefln('bind "%s" "%s" <%s>', [LowerCase(e_KeyNames[key]), cmd, key]);
1623 ASSERT(key >= 0);
1624 ASSERT(key < e_MaxInputKeys);
1625 if key > 0 then
1626 begin
1627 gInputBinds[key].down := ParseAlias(down);
1628 gInputBinds[key].up := ParseAlias(up)
1629 end
1630 end;
1632 function g_Console_FindBind (n: Integer; down: AnsiString; up: AnsiString = ''): Integer;
1633 var i: Integer;
1635 function EqualsCommandLists (a, b: SSArray): Boolean;
1636 var i, len: Integer;
1637 begin
1638 result := False;
1639 len := Length(a);
1640 if len = Length(b) then
1641 begin
1642 i := 0;
1643 while (i < len) and (a[i] = b[i]) do inc(i);
1644 if i >= len then
1645 result := True
1646 end
1647 end;
1649 begin
1650 ASSERT(n >= 1);
1651 result := 0;
1652 if commands = nil then Exit;
1653 i := 0;
1654 while (n >= 1) and (i < e_MaxInputKeys) do
1655 begin
1656 if EqualsCommandLists(ParseAlias(down), gInputBinds[i].down) then
1657 begin
1658 if EqualsCommandLists(ParseAlias(up), gInputBinds[i].up) then
1659 begin
1660 result := i;
1661 dec(n)
1662 end
1663 end;
1664 inc(i)
1665 end;
1666 if n >= 1 then
1667 result := 0
1668 end;
1670 function g_Console_Action (action: Integer): Boolean;
1671 var i, len: Integer;
1672 begin
1673 ASSERT(action >= FIRST_ACTION);
1674 ASSERT(action <= LAST_ACTION);
1675 i := 0;
1676 len := Length(gPlayerAction);
1677 while (i < len) and (not gPlayerAction[i, action]) do inc(i);
1678 Result := i < len
1679 end;
1681 procedure g_Console_ProcessBind (key: Integer; down: Boolean);
1682 var i: Integer;
1683 begin
1684 if (not gChatShow) and (not gConsoleShow) and (key >= 0) and (key < e_MaxInputKeys) and ((gInputBinds[key].down <> nil) or (gInputBinds[key].up <> nil)) then
1685 begin
1686 if down then
1687 for i := 0 to High(gInputBinds[key].down) do
1688 g_Console_Process(gInputBinds[key].down[i], True)
1689 else
1690 for i := 0 to High(gInputBinds[key].up) do
1691 g_Console_Process(gInputBinds[key].up[i], True)
1692 end;
1693 if down and not menu_toggled then
1694 KeyPress(key);
1695 menu_toggled := False
1696 end;
1698 procedure g_Console_ResetBinds;
1699 var i: Integer;
1700 begin
1701 for i := 0 to e_MaxInputKeys - 1 do
1702 g_Console_BindKey(i, '', '');
1704 g_Console_BindKey(IK_ESCAPE, 'togglemenu');
1705 g_Console_BindKey(IK_A, '+p1_moveleft', '-p1_moveleft');
1706 g_Console_BindKey(IK_D, '+p1_moveright', '-p1_moveright');
1707 g_Console_BindKey(IK_W, '+p1_lookup', '-p1_lookup');
1708 g_Console_BindKey(IK_S, '+p1_lookdown', '-p1_lookdown');
1709 g_Console_BindKey(IK_SPACE, '+p1_jump', '-p1_jump');
1710 g_Console_BindKey(IK_H, '+p1_attack', '-p1_attack');
1711 g_Console_BindKey(IK_J, '+p1_activate', '-p1_activate');
1712 g_Console_BindKey(IK_E, '+p1_weapnext', '-p1_weapnext');
1713 g_Console_BindKey(IK_Q, '+p1_weapprev', '-p1_weapprev');
1714 g_Console_BindKey(IK_ALT, '+p1_strafe', '-p1_strafe');
1715 g_Console_BindKey(IK_1, 'p1_weapon 1');
1716 g_Console_BindKey(IK_2, 'p1_weapon 2');
1717 g_Console_BindKey(IK_3, 'p1_weapon 3');
1718 g_Console_BindKey(IK_4, 'p1_weapon 4');
1719 g_Console_BindKey(IK_5, 'p1_weapon 5');
1720 g_Console_BindKey(IK_6, 'p1_weapon 6');
1721 g_Console_BindKey(IK_7, 'p1_weapon 7');
1722 g_Console_BindKey(IK_8, 'p1_weapon 8');
1723 g_Console_BindKey(IK_9, 'p1_weapon 9');
1724 g_Console_BindKey(IK_0, 'p1_weapon 10');
1725 g_Console_BindKey(IK_MINUS, 'p1_weapon 11');
1726 g_Console_BindKey(IK_T, 'togglechat');
1727 g_Console_BindKey(IK_Y, 'toggleteamchat');
1728 g_Console_BindKey(IK_F11, 'screenshot');
1729 g_Console_BindKey(IK_TAB, '+p1_scores', '-p1_scores');
1730 g_Console_BindKey(IK_PAUSE, 'pause');
1731 g_Console_BindKey(IK_F1, 'vote');
1733 (* for i := 0 to e_MaxJoys - 1 do *)
1734 for i := 0 to 1 do
1735 begin
1736 g_Console_BindKey(e_JoyHatToKey(i, 0, HAT_LEFT), '+p' + IntToStr(i mod 2 + 1) + '_moveleft', '-p' + IntToStr(i mod 2 + 1) + '_moveleft');
1737 g_Console_BindKey(e_JoyHatToKey(i, 0, HAT_RIGHT), '+p' + IntToStr(i mod 2 + 1) + '_moveright', '-p' + IntToStr(i mod 2 + 1) + '_moveright');
1738 g_Console_BindKey(e_JoyHatToKey(i, 0, HAT_UP), '+p' + IntToStr(i mod 2 + 1) + '_lookup', '-p' + IntToStr(i mod 2 + 1) + '_lookup');
1739 g_Console_BindKey(e_JoyHatToKey(i, 0, HAT_DOWN), '+p' + IntToStr(i mod 2 + 1) + '_lookdown', '-p' + IntToStr(i mod 2 + 1) + '_lookdown');
1740 g_Console_BindKey(e_JoyButtonToKey(i, 2), '+p' + IntToStr(i mod 2 + 1) + '_jump', '-p' + IntToStr(i mod 2 + 1) + '_jump');
1741 g_Console_BindKey(e_JoyButtonToKey(i, 0), '+p' + IntToStr(i mod 2 + 1) + '_attack', '-p' + IntToStr(i mod 2 + 1) + '_attack');
1742 g_Console_BindKey(e_JoyButtonToKey(i, 3), '+p' + IntToStr(i mod 2 + 1) + '_activate', '-p' + IntToStr(i mod 2 + 1) + '_activate');
1743 g_Console_BindKey(e_JoyButtonToKey(i, 1), '+p' + IntToStr(i mod 2 + 1) + '_weapnext', '-p' + IntToStr(i mod 2 + 1) + '_weapnext');
1744 g_Console_BindKey(e_JoyButtonToKey(i, 4), '+p' + IntToStr(i mod 2 + 1) + '_weapprev', '-p' + IntToStr(i mod 2 + 1) + '_weapprev');
1745 g_Console_BindKey(e_JoyButtonToKey(i, 7), '+p' + IntToStr(i mod 2 + 1) + '_strafe', '-p' + IntToStr(i mod 2 + 1) + '_strafe');
1746 g_Console_BindKey(e_JoyButtonToKey(i, 10), 'togglemenu');
1747 end;
1749 // HACK: VK_ESCAPE always used as togglemenu, so don't touch it!
1750 // VK_CONSOLE
1751 g_Console_BindKey(VK_LSTRAFE, '+moveleft; +strafe', '-moveleft; -strafe');
1752 g_Console_BindKey(VK_RSTRAFE, '+moveright; +strafe', '-moveright; -strafe');
1753 g_Console_BindKey(VK_LEFT, '+moveleft', '-moveleft');
1754 g_Console_BindKey(VK_RIGHT, '+moveright', '-moveright');
1755 g_Console_BindKey(VK_UP, '+lookup', '-lookup');
1756 g_Console_BindKey(VK_DOWN, '+lookdown', '-lookdown');
1757 g_Console_BindKey(VK_JUMP, '+jump', '-jump');
1758 g_Console_BindKey(VK_FIRE, '+attack', '-attack');
1759 g_Console_BindKey(VK_OPEN, '+activate', '-activate');
1760 g_Console_BindKey(VK_NEXT, '+weapnext', '-weapnext');
1761 g_Console_BindKey(VK_PREV, '+weapprev', '-weapprev');
1762 g_Console_BindKey(VK_STRAFE, '+strafe', '-strafe');
1763 g_Console_BindKey(VK_0, 'weapon 1');
1764 g_Console_BindKey(VK_1, 'weapon 2');
1765 g_Console_BindKey(VK_2, 'weapon 3');
1766 g_Console_BindKey(VK_3, 'weapon 4');
1767 g_Console_BindKey(VK_4, 'weapon 5');
1768 g_Console_BindKey(VK_5, 'weapon 6');
1769 g_Console_BindKey(VK_6, 'weapon 7');
1770 g_Console_BindKey(VK_7, 'weapon 8');
1771 g_Console_BindKey(VK_8, 'weapon 9');
1772 g_Console_BindKey(VK_9, 'weapon 10');
1773 g_Console_BindKey(VK_A, 'weapon 11');
1774 g_Console_BindKey(VK_CHAT, 'togglechat');
1775 g_Console_BindKey(VK_TEAM, 'toggleteamchat');
1776 g_Console_BindKey(VK_PRINTSCR, 'screenshot');
1777 g_Console_BindKey(VK_STATUS, '+scores', '-scores');
1778 g_Console_BindKey(VK_SHOWKBD, 'showkeyboard');
1779 g_Console_BindKey(VK_HIDEKBD, 'hidekeyboard');
1780 end;
1782 procedure g_Console_ReadConfig (filename: String);
1783 var f: TextFile; s: AnsiString; i, len: Integer;
1784 begin
1785 if FileExists(filename) then
1786 begin
1787 AssignFile(f, filename);
1788 Reset(f);
1789 while not EOF(f) do
1790 begin
1791 ReadLn(f, s);
1792 len := Length(s);
1793 if len > 0 then
1794 begin
1795 i := 1;
1796 (* skip spaces *)
1797 while (i <= len) and (s[i] <= ' ') do inc(i);
1798 (* skip comments *)
1799 if (i <= len) and ((s[i] <> '#') and ((i + 1 > len) or (s[i] <> '/') or (s[i + 1] <> '/'))) then
1800 g_Console_Process(s, True)
1801 end
1802 end;
1803 CloseFile(f)
1804 end
1805 end;
1807 procedure g_Console_WriteConfig (filename: String);
1808 var f: TextFile; i, j: Integer;
1809 begin
1810 AssignFile(f, filename);
1811 Rewrite(f);
1812 WriteLn(f, '// generated by doom2d, do not modify');
1813 WriteLn(f, 'unbindall');
1814 for i := 0 to e_MaxInputKeys - 1 do
1815 if (Length(gInputBinds[i].down) > 0) or (Length(gInputBinds[i].up) > 0) then
1816 WriteLn(f, 'bind ', e_KeyNames[i], ' "', GetCommandString(gInputBinds[i].down), '" "', GetCommandString(gInputBinds[i].up), '"');
1817 for i := 0 to High(commands) do
1818 begin
1819 if not commands[i].cheat then
1820 begin
1821 if @commands[i].procEx = @boolVarHandler then
1822 begin
1823 if PBoolean(commands[i].ptr)^ then j := 1 else j := 0;
1824 WriteLn(f, commands[i].cmd, ' "', j, '"')
1825 end
1826 else if @commands[i].procEx = @intVarHandler then
1827 begin
1828 WriteLn(f, commands[i].cmd, ' "', PInteger(commands[i].ptr)^, '"')
1829 end
1830 else if @commands[i].procEx = @singleVarHandler then
1831 begin
1832 WriteLn(f, commands[i].cmd, ' "', PVarSingle(commands[i].ptr).val^:0:6, '"')
1833 end
1834 end
1835 end;
1836 CloseFile(f)
1837 end;
1840 end.