DEADSOFTWARE

Refactor: Define constants for LiftType
[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 procedure g_Console_Init ();
25 procedure g_Console_Update ();
26 procedure g_Console_Draw ();
27 procedure g_Console_Switch ();
28 procedure g_Console_Char (C: AnsiChar);
29 procedure g_Console_Control (K: Word);
30 procedure g_Console_Process (L: AnsiString; quiet: Boolean=false);
31 procedure g_Console_Add (L: AnsiString; show: Boolean=false);
32 procedure g_Console_Clear ();
33 function g_Console_CommandBlacklisted (C: AnsiString): Boolean;
35 procedure conwriteln (const s: AnsiString; show: Boolean=false);
36 procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
38 // <0: no arg; 0/1: true/false
39 function conGetBoolArg (p: SSArray; idx: Integer): Integer;
41 procedure g_Console_Chat_Switch (team: Boolean=false);
43 procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
44 procedure conRegVar (const conname: AnsiString; pvar: PSingle; amin, amax: Single; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
45 procedure conRegVar (const conname: AnsiString; pvar: PInteger; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
47 // poor man's floating literal parser; i'm sorry, but `StrToFloat()` sux cocks
48 function conParseFloat (var res: Single; const s: AnsiString): Boolean;
51 var
52 gConsoleShow: Boolean = false; // True - êîíñîëü îòêðûòà èëè îòêðûâàåòñÿ
53 gChatShow: Boolean = false;
54 gChatTeam: Boolean = false;
55 gAllowConsoleMessages: Boolean = true;
56 gChatEnter: Boolean = true;
57 gJustChatted: Boolean = false; // ÷òîáû àäìèí â èíòåðå ÷àòÿñü íå ïðîìàòûâàë ñòàòèñòèêó
60 implementation
62 uses
63 g_textures, g_main, e_graphics, e_input, g_game,
64 SysUtils, g_basic, g_options, Math, g_touch,
65 g_menu, g_language, g_net, g_netmsg, e_log, conbuf;
68 type
69 PCommand = ^TCommand;
71 TCmdProc = procedure (p: SSArray);
72 TCmdProcEx = procedure (me: PCommand; p: SSArray);
74 TCommand = record
75 cmd: AnsiString;
76 proc: TCmdProc;
77 procEx: TCmdProcEx;
78 help: AnsiString;
79 hidden: Boolean;
80 ptr: Pointer; // various data
81 msg: AnsiString; // message for var changes
82 cheat: Boolean;
83 end;
85 TAlias = record
86 name: AnsiString;
87 commands: SSArray;
88 end;
91 const
92 Step = 32;
93 Alpha = 25;
94 MsgTime = 144;
95 MaxScriptRecursion = 16;
97 DEBUG_STRING = 'DEBUG MODE';
99 var
100 ID: DWORD;
101 RecursionDepth: Word = 0;
102 RecursionLimitHit: Boolean = False;
103 Cons_Y: SmallInt;
104 Cons_Shown: Boolean; // Ðèñîâàòü ëè êîíñîëü?
105 Line: AnsiString;
106 CPos: Word;
107 //ConsoleHistory: SSArray;
108 CommandHistory: SSArray;
109 Whitelist: SSArray;
110 commands: Array of TCommand = nil;
111 Aliases: Array of TAlias = nil;
112 CmdIndex: Word;
113 conSkipLines: Integer = 0;
114 MsgArray: Array [0..4] of record
115 Msg: AnsiString;
116 Time: Word;
117 end;
120 // poor man's floating literal parser; i'm sorry, but `StrToFloat()` sux cocks
121 function conParseFloat (var res: Single; const s: AnsiString): Boolean;
122 var
123 pos: Integer = 1;
124 frac: Single = 1;
125 slen: Integer;
126 begin
127 result := false;
128 res := 0;
129 slen := Length(s);
130 while (slen > 0) and (s[slen] <= ' ') do Dec(slen);
131 while (pos <= slen) and (s[pos] <= ' ') do Inc(pos);
132 if (pos > slen) then exit;
133 if (slen-pos = 1) and (s[pos] = '.') then exit; // single dot
134 // integral part
135 while (pos <= slen) do
136 begin
137 if (s[pos] < '0') or (s[pos] > '9') then break;
138 res := res*10+Byte(s[pos])-48;
139 Inc(pos);
140 end;
141 if (pos <= slen) then
142 begin
143 // must be a dot
144 if (s[pos] <> '.') then exit;
145 Inc(pos);
146 while (pos <= slen) do
147 begin
148 if (s[pos] < '0') or (s[pos] > '9') then break;
149 frac := frac/10;
150 res += frac*(Byte(s[pos])-48);
151 Inc(pos);
152 end;
153 end;
154 if (pos <= slen) then exit; // oops
155 result := true;
156 end;
159 // ////////////////////////////////////////////////////////////////////////// //
160 // <0: no arg; 0/1: true/false; 666: toggle
161 function conGetBoolArg (p: SSArray; idx: Integer): Integer;
162 begin
163 if (idx < 0) or (idx > High(p)) then begin result := -1; exit; end;
164 result := 0;
165 if (p[idx] = '1') or (CompareText(p[idx], 'on') = 0) or (CompareText(p[idx], 'true') = 0) or
166 (CompareText(p[idx], 'tan') = 0) or (CompareText(p[idx], 'yes') = 0) then result := 1
167 else if (CompareText(p[idx], 'toggle') = 0) or (CompareText(p[idx], 'switch') = 0) or
168 (CompareText(p[idx], 't') = 0) then result := 666;
169 end;
172 procedure boolVarHandler (me: PCommand; p: SSArray);
173 procedure binaryFlag (var flag: Boolean; msg: AnsiString);
174 begin
175 if (Length(p) > 2) then
176 begin
177 conwritefln('too many arguments to ''%s''', [p[0]]);
178 end
179 else
180 begin
181 case conGetBoolArg(p, 1) of
182 -1: begin end;
183 0: if not me.cheat or conIsCheatsEnabled then flag := false else begin conwriteln('not available'); exit; end;
184 1: if not me.cheat or conIsCheatsEnabled then flag := true else begin conwriteln('not available'); exit; end;
185 666: if not me.cheat or conIsCheatsEnabled then flag := not flag else begin conwriteln('not available'); exit; end;
186 end;
187 if (Length(msg) = 0) then msg := p[0] else msg += ':';
188 if flag then conwritefln('%s tan', [msg]) else conwritefln('%s ona', [msg]);
189 end;
190 end;
191 begin
192 binaryFlag(PBoolean(me.ptr)^, me.msg);
193 end;
196 procedure intVarHandler (me: PCommand; p: SSArray);
197 procedure binaryFlag (var flag: Boolean; msg: AnsiString);
198 begin
199 if (Length(p) > 2) then
200 begin
201 conwritefln('too many arguments to ''%s''', [p[0]]);
202 end
203 else
204 begin
205 case conGetBoolArg(p, 1) of
206 -1: begin end;
207 0: if not me.cheat or conIsCheatsEnabled then flag := false else begin conwriteln('not available'); exit; end;
208 1: if not me.cheat or conIsCheatsEnabled then flag := true else begin conwriteln('not available'); exit; end;
209 666: if not me.cheat or conIsCheatsEnabled then flag := not flag else begin conwriteln('not available'); exit; end;
210 end;
211 if (Length(msg) = 0) then msg := p[0] else msg += ':';
212 if flag then conwritefln('%s tan', [msg]) else conwritefln('%s ona', [msg]);
213 end;
214 end;
215 begin
216 if (Length(p) <> 2) then
217 begin
218 conwritefln('%s %d', [me.cmd, PInteger(me.ptr)^]);
219 end
220 else
221 begin
222 try
223 PInteger(me.ptr)^ := StrToInt(p[1]);
224 except
225 conwritefln('invalid integer value: "%s"', [p[1]]);
226 end;
227 end;
228 end;
231 procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
232 var
233 f: Integer;
234 cp: PCommand;
235 begin
236 f := Length(commands);
237 SetLength(commands, f+1);
238 cp := @commands[f];
239 cp.cmd := LowerCase(conname);
240 cp.proc := nil;
241 cp.procEx := boolVarHandler;
242 cp.help := ahelp;
243 cp.hidden := ahidden;
244 cp.ptr := pvar;
245 cp.msg := amsg;
246 cp.cheat := acheat;
247 end;
250 procedure conRegVar (const conname: AnsiString; pvar: PInteger; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
251 var
252 f: Integer;
253 cp: PCommand;
254 begin
255 f := Length(commands);
256 SetLength(commands, f+1);
257 cp := @commands[f];
258 cp.cmd := LowerCase(conname);
259 cp.proc := nil;
260 cp.procEx := intVarHandler;
261 cp.help := ahelp;
262 cp.hidden := ahidden;
263 cp.ptr := pvar;
264 cp.msg := amsg;
265 cp.cheat := acheat;
266 end;
269 // ////////////////////////////////////////////////////////////////////////// //
270 type
271 PVarSingle = ^TVarSingle;
272 TVarSingle = record
273 val: PSingle;
274 min, max, def: Single; // default will be starting value
275 end;
278 procedure singleVarHandler (me: PCommand; p: SSArray);
279 var
280 pv: PVarSingle;
281 nv: Single;
282 msg: AnsiString;
283 begin
284 if (Length(p) > 2) then
285 begin
286 conwritefln('too many arguments to ''%s''', [me.cmd]);
287 exit;
288 end;
289 pv := PVarSingle(me.ptr);
290 if (Length(p) = 2) then
291 begin
292 if me.cheat and (not conIsCheatsEnabled) then begin conwriteln('not available'); exit; end;
293 if (CompareText(p[1], 'default') = 0) or (CompareText(p[1], 'def') = 0) or
294 (CompareText(p[1], 'd') = 0) or (CompareText(p[1], 'off') = 0) or
295 (CompareText(p[1], 'ona') = 0) then
296 begin
297 pv.val^ := pv.def;
298 end
299 else
300 begin
301 if not conParseFloat(nv, p[1]) then
302 begin
303 conwritefln('%s: ''%s'' doesn''t look like a floating number', [me.cmd, p[1]]);
304 exit;
305 end;
306 if (nv < pv.min) then nv := pv.min;
307 if (nv > pv.max) then nv := pv.max;
308 pv.val^ := nv;
309 end;
310 end;
311 msg := me.msg;
312 if (Length(msg) = 0) then msg := me.cmd else msg += ':';
313 conwritefln('%s %s', [msg, pv.val^]);
314 end;
317 procedure conRegVar (const conname: AnsiString; pvar: PSingle; amin, amax: Single; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
318 var
319 f: Integer;
320 cp: PCommand;
321 pv: PVarSingle;
322 begin
323 GetMem(pv, sizeof(TVarSingle));
324 pv.val := pvar;
325 pv.min := amin;
326 pv.max := amax;
327 pv.def := pvar^;
328 f := Length(commands);
329 SetLength(commands, f+1);
330 cp := @commands[f];
331 cp.cmd := LowerCase(conname);
332 cp.proc := nil;
333 cp.procEx := singleVarHandler;
334 cp.help := ahelp;
335 cp.hidden := ahidden;
336 cp.ptr := pv;
337 cp.msg := amsg;
338 cp.cheat := acheat;
339 end;
342 // ////////////////////////////////////////////////////////////////////////// //
343 function GetStrACmd(var Str: AnsiString): AnsiString;
344 var
345 a: Integer;
346 begin
347 Result := '';
348 for a := 1 to Length(Str) do
349 if (a = Length(Str)) or (Str[a+1] = ';') then
350 begin
351 Result := Copy(Str, 1, a);
352 Delete(Str, 1, a+1);
353 Str := Trim(Str);
354 Exit;
355 end;
356 end;
358 function ParseAlias(Str: AnsiString): SSArray;
359 begin
360 Result := nil;
362 Str := Trim(Str);
364 if Str = '' then
365 Exit;
367 while Str <> '' do
368 begin
369 SetLength(Result, Length(Result)+1);
370 Result[High(Result)] := GetStrACmd(Str);
371 end;
372 end;
374 procedure ConsoleCommands(p: SSArray);
375 var
376 cmd, s: AnsiString;
377 a, b: Integer;
378 F: TextFile;
379 begin
380 cmd := LowerCase(p[0]);
381 s := '';
383 if cmd = 'clear' then
384 begin
385 //ConsoleHistory := nil;
386 cbufClear();
387 conSkipLines := 0;
389 for a := 0 to High(MsgArray) do
390 with MsgArray[a] do
391 begin
392 Msg := '';
393 Time := 0;
394 end;
395 end;
397 if cmd = 'clearhistory' then
398 CommandHistory := nil;
400 if cmd = 'showhistory' then
401 if CommandHistory <> nil then
402 begin
403 g_Console_Add('');
404 for a := 0 to High(CommandHistory) do
405 g_Console_Add(' '+CommandHistory[a]);
406 end;
408 if cmd = 'commands' then
409 begin
410 g_Console_Add('');
411 g_Console_Add('commands list:');
412 for a := High(commands) downto 0 do
413 begin
414 if (Length(commands[a].help) > 0) then
415 begin
416 g_Console_Add(' '+commands[a].cmd+' -- '+commands[a].help);
417 end
418 else
419 begin
420 g_Console_Add(' '+commands[a].cmd);
421 end;
422 end;
423 end;
425 if cmd = 'time' then
426 g_Console_Add(TimeToStr(Now), True);
428 if cmd = 'date' then
429 g_Console_Add(DateToStr(Now), True);
431 if cmd = 'echo' then
432 if Length(p) > 1 then
433 begin
434 if p[1] = 'ololo' then
435 gCheats := True
436 else
437 begin
438 s := '';
439 for a := 1 to High(p) do
440 s := s + p[a] + ' ';
441 g_Console_Add(b_Text_Format(s), True);
442 end;
443 end
444 else
445 g_Console_Add('');
447 if cmd = 'dump' then
448 begin
449 (*
450 if ConsoleHistory <> nil then
451 begin
452 if Length(P) > 1 then
453 s := P[1]
454 else
455 s := GameDir+'/console.txt';
457 {$I-}
458 AssignFile(F, s);
459 Rewrite(F);
460 if IOResult <> 0 then
461 begin
462 g_Console_Add(Format(_lc[I_CONSOLE_ERROR_WRITE], [s]));
463 CloseFile(F);
464 Exit;
465 end;
467 for a := 0 to High(ConsoleHistory) do
468 WriteLn(F, ConsoleHistory[a]);
470 CloseFile(F);
471 g_Console_Add(Format(_lc[I_CONSOLE_DUMPED], [s]));
472 {$I+}
473 end;
474 *)
475 end;
477 if cmd = 'exec' then
478 begin
479 // exec <filename>
480 if Length(p) > 1 then
481 begin
482 s := GameDir+'/'+p[1];
484 {$I-}
485 AssignFile(F, s);
486 Reset(F);
487 if IOResult <> 0 then
488 begin
489 g_Console_Add(Format(_lc[I_CONSOLE_ERROR_READ], [s]));
490 CloseFile(F);
491 Exit;
492 end;
493 g_Console_Add(Format(_lc[I_CONSOLE_EXEC], [s]));
495 while not EOF(F) do
496 begin
497 ReadLn(F, s);
498 if IOResult <> 0 then
499 begin
500 g_Console_Add(Format(_lc[I_CONSOLE_ERROR_READ], [s]));
501 CloseFile(F);
502 Exit;
503 end;
504 if Pos('#', s) <> 1 then // script comment
505 begin
506 // prevents endless loops
507 Inc(RecursionDepth);
508 RecursionLimitHit := (RecursionDepth > MaxScriptRecursion) or RecursionLimitHit;
509 if not RecursionLimitHit then
510 g_Console_Process(s, True);
511 Dec(RecursionDepth);
512 end;
513 end;
514 if (RecursionDepth = 0) and RecursionLimitHit then
515 begin
516 g_Console_Add(Format(_lc[I_CONSOLE_ERROR_CALL], [s]));
517 RecursionLimitHit := False;
518 end;
520 CloseFile(F);
521 {$I+}
522 end
523 else
524 g_Console_Add('exec <script file>');
525 end;
527 if (cmd = 'ver') or (cmd = 'version') then
528 begin
529 conwriteln('Doom 2D: Forever v. ' + GAME_VERSION);
530 conwritefln('Net protocol v. %d', [NET_PROTOCOL_VER]);
531 conwritefln('Build date: %s at %s', [GAME_BUILDDATE, GAME_BUILDTIME]);
532 end;
534 if cmd = 'alias' then
535 begin
536 // alias [alias_name] [commands]
537 if Length(p) > 1 then
538 begin
539 for a := 0 to High(Aliases) do
540 if Aliases[a].name = p[1] then
541 begin
542 if Length(p) > 2 then
543 Aliases[a].commands := ParseAlias(p[2])
544 else
545 for b := 0 to High(Aliases[a].commands) do
546 g_Console_Add(Aliases[a].commands[b]);
547 Exit;
548 end;
549 SetLength(Aliases, Length(Aliases)+1);
550 a := High(Aliases);
551 Aliases[a].name := p[1];
552 if Length(p) > 2 then
553 Aliases[a].commands := ParseAlias(p[2])
554 else
555 for b := 0 to High(Aliases[a].commands) do
556 g_Console_Add(Aliases[a].commands[b]);
557 end else
558 for a := 0 to High(Aliases) do
559 if Aliases[a].commands <> nil then
560 g_Console_Add(Aliases[a].name);
561 end;
563 if cmd = 'call' then
564 begin
565 // call <alias_name>
566 if Length(p) > 1 then
567 begin
568 if Aliases = nil then
569 Exit;
570 for a := 0 to High(Aliases) do
571 if Aliases[a].name = p[1] then
572 begin
573 if Aliases[a].commands <> nil then
574 begin
575 // with this system proper endless loop detection seems either impossible
576 // or very dirty to implement, so let's have this instead
577 // prevents endless loops
578 for b := 0 to High(Aliases[a].commands) do
579 begin
580 Inc(RecursionDepth);
581 RecursionLimitHit := (RecursionDepth > MaxScriptRecursion) or RecursionLimitHit;
582 if not RecursionLimitHit then
583 g_Console_Process(Aliases[a].commands[b], True);
584 Dec(RecursionDepth);
585 end;
586 if (RecursionDepth = 0) and RecursionLimitHit then
587 begin
588 g_Console_Add(Format(_lc[I_CONSOLE_ERROR_CALL], [s]));
589 RecursionLimitHit := False;
590 end;
591 end;
592 Exit;
593 end;
594 end
595 else
596 g_Console_Add('call <alias name>');
597 end;
598 end;
600 procedure WhitelistCommand(cmd: AnsiString);
601 var
602 a: Integer;
603 begin
604 SetLength(Whitelist, Length(Whitelist)+1);
605 a := High(Whitelist);
606 Whitelist[a] := LowerCase(cmd);
607 end;
609 procedure AddCommand(cmd: AnsiString; proc: TCmdProc; ahelp: AnsiString=''; ahidden: Boolean=false; acheat: Boolean=false);
610 var
611 a: Integer;
612 cp: PCommand;
613 begin
614 SetLength(commands, Length(commands)+1);
615 a := High(commands);
616 cp := @commands[a];
617 cp.cmd := LowerCase(cmd);
618 cp.proc := proc;
619 cp.procEx := nil;
620 cp.help := ahelp;
621 cp.hidden := ahidden;
622 cp.ptr := nil;
623 cp.msg := '';
624 cp.cheat := acheat;
625 end;
628 procedure segfault (p: SSArray);
629 var
630 pp: PByte = nil;
631 begin
632 pp^ := 0;
633 end;
636 procedure g_Console_Init();
637 var
638 a: Integer;
639 begin
640 g_Texture_CreateWAD(ID, GameWAD+':TEXTURES\CONSOLE');
641 Cons_Y := -(gScreenHeight div 2);
642 gConsoleShow := False;
643 gChatShow := False;
644 Cons_Shown := False;
645 CPos := 1;
647 for a := 0 to High(MsgArray) do
648 with MsgArray[a] do
649 begin
650 Msg := '';
651 Time := 0;
652 end;
654 AddCommand('segfault', segfault, 'make segfault');
656 AddCommand('clear', ConsoleCommands, 'clear console');
657 AddCommand('clearhistory', ConsoleCommands);
658 AddCommand('showhistory', ConsoleCommands);
659 AddCommand('commands', ConsoleCommands);
660 AddCommand('time', ConsoleCommands);
661 AddCommand('date', ConsoleCommands);
662 AddCommand('echo', ConsoleCommands);
663 AddCommand('dump', ConsoleCommands);
664 AddCommand('exec', ConsoleCommands);
665 AddCommand('alias', ConsoleCommands);
666 AddCommand('call', ConsoleCommands);
667 AddCommand('ver', ConsoleCommands);
668 AddCommand('version', ConsoleCommands);
670 AddCommand('d_window', DebugCommands);
671 AddCommand('d_sounds', DebugCommands);
672 AddCommand('d_frames', DebugCommands);
673 AddCommand('d_winmsg', DebugCommands);
674 AddCommand('d_monoff', DebugCommands);
675 AddCommand('d_botoff', DebugCommands);
676 AddCommand('d_monster', DebugCommands);
677 AddCommand('d_health', DebugCommands);
678 AddCommand('d_player', DebugCommands);
679 AddCommand('d_joy', DebugCommands);
680 AddCommand('d_mem', DebugCommands);
682 AddCommand('p1_name', GameCVars);
683 AddCommand('p2_name', GameCVars);
684 AddCommand('p1_color', GameCVars);
685 AddCommand('p2_color', GameCVars);
686 AddCommand('r_showfps', GameCVars);
687 AddCommand('r_showtime', GameCVars);
688 AddCommand('r_showscore', GameCVars);
689 AddCommand('r_showlives', GameCVars);
690 AddCommand('r_showstat', GameCVars);
691 AddCommand('r_showkillmsg', GameCVars);
692 AddCommand('r_showspect', GameCVars);
693 AddCommand('r_showping', GameCVars);
694 AddCommand('g_gamemode', GameCVars);
695 AddCommand('g_friendlyfire', GameCVars);
696 AddCommand('g_weaponstay', GameCVars);
697 AddCommand('g_allow_exit', GameCVars);
698 AddCommand('g_allow_monsters', GameCVars);
699 AddCommand('g_bot_vsmonsters', GameCVars);
700 AddCommand('g_bot_vsplayers', GameCVars);
701 AddCommand('g_scorelimit', GameCVars);
702 AddCommand('g_timelimit', GameCVars);
703 AddCommand('g_maxlives', GameCVars);
704 AddCommand('g_warmuptime', GameCVars);
705 AddCommand('net_interp', GameCVars);
706 AddCommand('net_forceplayerupdate', GameCVars);
707 AddCommand('net_predictself', GameCVars);
708 AddCommand('sv_name', GameCVars);
709 AddCommand('sv_passwd', GameCVars);
710 AddCommand('sv_maxplrs', GameCVars);
711 AddCommand('sv_public', GameCVars);
712 AddCommand('sv_intertime', GameCVars);
714 AddCommand('quit', GameCommands);
715 AddCommand('exit', GameCommands);
716 AddCommand('pause', GameCommands);
717 AddCommand('endgame', GameCommands);
718 AddCommand('restart', GameCommands);
719 AddCommand('addbot', GameCommands);
720 AddCommand('bot_add', GameCommands);
721 AddCommand('bot_addlist', GameCommands);
722 AddCommand('bot_addred', GameCommands);
723 AddCommand('bot_addblue', GameCommands);
724 AddCommand('bot_removeall', GameCommands);
725 AddCommand('chat', GameCommands);
726 AddCommand('teamchat', GameCommands);
727 AddCommand('game', GameCommands);
728 AddCommand('host', GameCommands);
729 AddCommand('map', GameCommands);
730 AddCommand('nextmap', GameCommands);
731 AddCommand('endmap', GameCommands);
732 AddCommand('goodbye', GameCommands);
733 AddCommand('suicide', GameCommands);
734 AddCommand('spectate', GameCommands);
735 AddCommand('ready', GameCommands);
736 AddCommand('kick', GameCommands);
737 AddCommand('kick_id', GameCommands);
738 AddCommand('ban', GameCommands);
739 AddCommand('permban', GameCommands);
740 AddCommand('ban_id', GameCommands);
741 AddCommand('permban_id', GameCommands);
742 AddCommand('unban', GameCommands);
743 AddCommand('connect', GameCommands);
744 AddCommand('disconnect', GameCommands);
745 AddCommand('reconnect', GameCommands);
746 AddCommand('say', GameCommands);
747 AddCommand('tell', GameCommands);
748 AddCommand('overtime', GameCommands);
749 AddCommand('rcon_password', GameCommands);
750 AddCommand('rcon', GameCommands);
751 AddCommand('callvote', GameCommands);
752 AddCommand('vote', GameCommands);
753 AddCommand('clientlist', GameCommands);
754 AddCommand('event', GameCommands);
756 AddCommand('god', GameCheats);
757 AddCommand('notarget', GameCheats);
758 AddCommand('give', GameCheats); // "exit" too ;-)
759 AddCommand('open', GameCheats);
760 AddCommand('fly', GameCheats);
761 AddCommand('noclip', GameCheats);
762 AddCommand('speedy', GameCheats);
763 AddCommand('jumpy', GameCheats);
764 AddCommand('noreload', GameCheats);
765 AddCommand('aimline', GameCheats);
766 AddCommand('automap', GameCheats);
768 WhitelistCommand('say');
769 WhitelistCommand('tell');
770 WhitelistCommand('overtime');
771 WhitelistCommand('ready');
772 WhitelistCommand('map');
773 WhitelistCommand('nextmap');
774 WhitelistCommand('endmap');
775 WhitelistCommand('restart');
776 WhitelistCommand('kick');
777 WhitelistCommand('ban');
779 WhitelistCommand('addbot');
780 WhitelistCommand('bot_add');
781 WhitelistCommand('bot_addred');
782 WhitelistCommand('bot_addblue');
783 WhitelistCommand('bot_removeall');
785 WhitelistCommand('g_gamemode');
786 WhitelistCommand('g_friendlyfire');
787 WhitelistCommand('g_weaponstay');
788 WhitelistCommand('g_allow_exit');
789 WhitelistCommand('g_allow_monsters');
790 WhitelistCommand('g_scorelimit');
791 WhitelistCommand('g_timelimit');
793 g_Console_Add(Format(_lc[I_CONSOLE_WELCOME], [GAME_VERSION]));
794 g_Console_Add('');
795 end;
797 procedure g_Console_Update();
798 var
799 a, b: Integer;
800 begin
801 if Cons_Shown then
802 begin
803 // Â ïðîöåññå îòêðûòèÿ:
804 if gConsoleShow and (Cons_Y < 0) then
805 begin
806 Cons_Y := Cons_Y+Step;
807 end;
809 // Â ïðîöåññå çàêðûòèÿ:
810 if (not gConsoleShow) and
811 (Cons_Y > -(gScreenHeight div 2)) then
812 Cons_Y := Cons_Y-Step;
814 // Îêîí÷àòåëüíî îòêðûëàñü:
815 if Cons_Y > 0 then
816 Cons_Y := 0;
818 // Îêîí÷àòåëüíî çàêðûëàñü:
819 if Cons_Y <= (-(gScreenHeight div 2)) then
820 begin
821 Cons_Y := -(gScreenHeight div 2);
822 Cons_Shown := False;
823 end;
824 end;
826 a := 0;
827 while a <= High(MsgArray) do
828 begin
829 if MsgArray[a].Time > 0 then
830 begin
831 if MsgArray[a].Time = 1 then
832 begin
833 if a < High(MsgArray) then
834 begin
835 for b := a to High(MsgArray)-1 do
836 MsgArray[b] := MsgArray[b+1];
838 MsgArray[High(MsgArray)].Time := 0;
840 a := a - 1;
841 end;
842 end
843 else
844 Dec(MsgArray[a].Time);
845 end;
847 a := a + 1;
848 end;
849 end;
852 procedure drawConsoleText ();
853 var
854 CWidth, CHeight: Byte;
855 ty: Integer;
856 sp, ep: LongWord;
857 skip: Integer;
859 procedure putLine (sp, ep: LongWord);
860 var
861 p: LongWord;
862 wdt, cw: Integer;
863 begin
864 p := sp;
865 wdt := 0;
866 while p <> ep do
867 begin
868 cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
869 if wdt+cw > gScreenWidth-8 then break;
870 //e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
871 Inc(wdt, cw);
872 cbufNext(p);
873 end;
874 if p <> ep then putLine(p, ep); // do rest of the line first
875 // now print our part
876 if skip = 0 then
877 begin
878 ep := p;
879 p := sp;
880 wdt := 2;
881 while p <> ep do
882 begin
883 cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
884 e_TextureFontPrintCharEx(wdt, ty, cbufAt(p), gStdFont);
885 Inc(wdt, cw);
886 cbufNext(p);
887 end;
888 Dec(ty, CHeight);
889 end
890 else
891 begin
892 Dec(skip);
893 end;
894 end;
896 begin
897 e_TextureFontGetSize(gStdFont, CWidth, CHeight);
898 ty := (gScreenHeight div 2)-4-2*CHeight-Abs(Cons_Y);
899 skip := conSkipLines;
900 cbufLastLine(sp, ep);
901 repeat
902 putLine(sp, ep);
903 if ty+CHeight <= 0 then break;
904 until not cbufLineUp(sp, ep);
905 end;
907 procedure g_Console_Draw();
908 var
909 CWidth, CHeight: Byte;
910 mfW, mfH: Word;
911 a, b: Integer;
912 begin
913 e_TextureFontGetSize(gStdFont, CWidth, CHeight);
915 for a := 0 to High(MsgArray) do
916 if MsgArray[a].Time > 0 then
917 e_TextureFontPrintFmt(0, CHeight*a, MsgArray[a].Msg,
918 gStdFont, True);
920 if not Cons_Shown then
921 begin
922 if gChatShow then
923 begin
924 if gChatTeam then
925 begin
926 e_TextureFontPrintEx(0, gScreenHeight - CHeight - 1, 'say team> ' + Line,
927 gStdFont, 255, 255, 255, 1, True);
928 e_TextureFontPrintEx((CPos + 9)*CWidth, gScreenHeight - CHeight - 1, '_',
929 gStdFont, 255, 255, 255, 1, True);
930 end
931 else
932 begin
933 e_TextureFontPrintEx(0, gScreenHeight - CHeight - 1, 'say> ' + Line,
934 gStdFont, 255, 255, 255, 1, True);
935 e_TextureFontPrintEx((CPos + 4)*CWidth, gScreenHeight - CHeight - 1, '_',
936 gStdFont, 255, 255, 255, 1, True);
937 end;
938 end;
939 Exit;
940 end;
942 if gDebugMode then
943 begin
944 e_CharFont_GetSize(gMenuFont, DEBUG_STRING, mfW, mfH);
945 a := (gScreenWidth - 2*mfW) div 2;
946 b := Cons_Y + ((gScreenHeight div 2) - 2*mfH) div 2;
947 e_CharFont_PrintEx(gMenuFont, a div 2, b div 2, DEBUG_STRING,
948 _RGB(128, 0, 0), 2.0);
949 end;
951 e_DrawSize(ID, 0, Cons_Y, Alpha, False, False, gScreenWidth, gScreenHeight div 2);
952 e_TextureFontPrint(0, Cons_Y+(gScreenHeight div 2)-CHeight-4, '> '+Line, gStdFont);
954 drawConsoleText();
955 (*
956 if ConsoleHistory <> nil then
957 begin
958 b := 0;
959 if CHeight > 0 then
960 if Length(ConsoleHistory) > ((gScreenHeight div 2) div CHeight)-1 then
961 b := Length(ConsoleHistory)-((gScreenHeight div 2) div CHeight)+1;
963 b := Max(b-Offset, 0);
964 d := Max(High(ConsoleHistory)-Offset, 0);
966 c := 2;
967 for a := d downto b do
968 begin
969 e_TextureFontPrintFmt(0, (gScreenHeight div 2)-4-c*CHeight-Abs(Cons_Y), ConsoleHistory[a],
970 gStdFont, True);
971 c := c + 1;
972 end;
973 end;
974 *)
976 e_TextureFontPrint((CPos+1)*CWidth, Cons_Y+(gScreenHeight div 2)-21, '_', gStdFont);
977 end;
979 procedure g_Console_Switch();
980 begin
981 if gChatShow then Exit;
982 gConsoleShow := not gConsoleShow;
983 Cons_Shown := True;
984 g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
985 end;
987 procedure g_Console_Chat_Switch(Team: Boolean = False);
988 begin
989 if gConsoleShow then Exit;
990 if not g_Game_IsNet then Exit;
991 gChatShow := not gChatShow;
992 gChatTeam := Team;
993 if gChatShow then
994 gChatEnter := False;
995 Line := '';
996 CPos := 1;
997 g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
998 end;
1000 procedure g_Console_Char(C: AnsiChar);
1001 begin
1002 if gChatShow and (not gChatEnter) then
1003 Exit;
1004 Insert(C, Line, CPos);
1005 CPos := CPos + 1;
1006 end;
1009 var
1010 tcomplist: array of AnsiString = nil;
1011 tcompidx: array of Integer = nil;
1013 procedure Complete ();
1014 var
1015 i, c: Integer;
1016 tused: Integer;
1017 ll, lpfx, cmd: AnsiString;
1018 begin
1019 if (Length(Line) = 0) then
1020 begin
1021 g_Console_Add('');
1022 for i := 0 to High(commands) do
1023 begin
1024 // hidden commands are hidden when cheats aren't enabled
1025 if commands[i].hidden and not conIsCheatsEnabled then continue;
1026 if (Length(commands[i].help) > 0) then
1027 begin
1028 g_Console_Add(' '+commands[i].cmd+' -- '+commands[i].help);
1029 end
1030 else
1031 begin
1032 g_Console_Add(' '+commands[i].cmd);
1033 end;
1034 end;
1035 exit;
1036 end;
1038 ll := LowerCase(Line);
1039 lpfx := '';
1041 if (Length(ll) > 1) and (ll[Length(ll)] = ' ') then
1042 begin
1043 ll := Copy(ll, 0, Length(ll)-1);
1044 for i := 0 to High(commands) do
1045 begin
1046 // hidden commands are hidden when cheats aren't enabled
1047 if commands[i].hidden and not conIsCheatsEnabled then continue;
1048 if (commands[i].cmd = ll) then
1049 begin
1050 if (Length(commands[i].help) > 0) then
1051 begin
1052 g_Console_Add(' '+commands[i].cmd+' -- '+commands[i].help);
1053 end;
1054 end;
1055 end;
1056 exit;
1057 end;
1059 // build completion list
1060 tused := 0;
1061 for i := 0 to High(commands) do
1062 begin
1063 // hidden commands are hidden when cheats aren't enabled
1064 if commands[i].hidden and not conIsCheatsEnabled then continue;
1065 cmd := commands[i].cmd;
1066 if (Length(cmd) >= Length(ll)) and (ll = Copy(cmd, 0, Length(ll))) then
1067 begin
1068 if (tused = Length(tcomplist)) then
1069 begin
1070 SetLength(tcomplist, Length(tcomplist)+128);
1071 SetLength(tcompidx, Length(tcompidx)+128);
1072 end;
1073 tcomplist[tused] := cmd;
1074 tcompidx[tused] := i;
1075 Inc(tused);
1076 if (Length(cmd) > Length(lpfx)) then lpfx := cmd;
1077 end;
1078 end;
1080 // get longest prefix
1081 for i := 0 to tused-1 do
1082 begin
1083 cmd := tcomplist[i];
1084 for c := 1 to Length(lpfx) do
1085 begin
1086 if (c > Length(cmd)) then break;
1087 if (cmd[c] <> lpfx[c]) then begin lpfx := Copy(lpfx, 0, c-1); break; end;
1088 end;
1089 end;
1091 if (tused = 0) then exit;
1093 if (tused = 1) then
1094 begin
1095 Line := tcomplist[0]+' ';
1096 CPos := Length(Line)+1;
1097 end
1098 else
1099 begin
1100 // has longest prefix?
1101 if (Length(lpfx) > Length(ll)) then
1102 begin
1103 Line := lpfx;
1104 CPos:= Length(Line)+1;
1105 end
1106 else
1107 begin
1108 g_Console_Add('');
1109 for i := 0 to tused-1 do
1110 begin
1111 if (Length(commands[tcompidx[i]].help) > 0) then
1112 begin
1113 g_Console_Add(' '+tcomplist[i]+' -- '+commands[tcompidx[i]].help);
1114 end
1115 else
1116 begin
1117 g_Console_Add(' '+tcomplist[i]);
1118 end;
1119 end;
1120 end;
1121 end;
1122 end;
1125 procedure g_Console_Control(K: Word);
1126 begin
1127 case K of
1128 IK_BACKSPACE:
1129 if (Length(Line) > 0) and (CPos > 1) then
1130 begin
1131 Delete(Line, CPos-1, 1);
1132 CPos := CPos-1;
1133 end;
1134 IK_DELETE:
1135 if (Length(Line) > 0) and (CPos <= Length(Line)) then
1136 Delete(Line, CPos, 1);
1137 IK_LEFT, IK_KPLEFT, VK_LEFT:
1138 if CPos > 1 then
1139 CPos := CPos - 1;
1140 IK_RIGHT, IK_KPRIGHT, VK_RIGHT:
1141 if CPos <= Length(Line) then
1142 CPos := CPos + 1;
1143 IK_RETURN, IK_KPRETURN, VK_OPEN, VK_FIRE:
1144 begin
1145 if Cons_Shown then
1146 g_Console_Process(Line)
1147 else
1148 if gChatShow then
1149 begin
1150 if (Length(Line) > 0) and g_Game_IsNet then
1151 begin
1152 if gChatTeam then
1153 begin
1154 if g_Game_IsClient then
1155 MC_SEND_Chat(b_Text_Format(Line), NET_CHAT_TEAM)
1156 else
1157 MH_SEND_Chat('[' + gPlayer1Settings.name + ']: ' + b_Text_Format(Line),
1158 NET_CHAT_TEAM, gPlayer1Settings.Team);
1159 end
1160 else
1161 begin
1162 if g_Game_IsClient then
1163 MC_SEND_Chat(b_Text_Format(Line), NET_CHAT_PLAYER)
1164 else
1165 MH_SEND_Chat('[' + gPlayer1Settings.name + ']: ' + b_Text_Format(Line),
1166 NET_CHAT_PLAYER);
1167 end;
1168 end;
1170 Line := '';
1171 CPos := 1;
1172 gChatShow := False;
1173 gJustChatted := True;
1174 g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
1175 end;
1176 end;
1177 IK_TAB:
1178 if not gChatShow then
1179 Complete();
1180 IK_DOWN, IK_KPDOWN, VK_DOWN:
1181 if not gChatShow then
1182 if (CommandHistory <> nil) and
1183 (CmdIndex < Length(CommandHistory)) then
1184 begin
1185 if CmdIndex < Length(CommandHistory)-1 then
1186 CmdIndex := CmdIndex + 1;
1187 Line := CommandHistory[CmdIndex];
1188 CPos := Length(Line) + 1;
1189 end;
1190 IK_UP, IK_KPUP, VK_UP:
1191 if not gChatShow then
1192 if (CommandHistory <> nil) and
1193 (CmdIndex <= Length(CommandHistory)) then
1194 begin
1195 if CmdIndex > 0 then
1196 CmdIndex := CmdIndex - 1;
1197 Line := CommandHistory[CmdIndex];
1198 Cpos := Length(Line) + 1;
1199 end;
1200 IK_PAGEUP, IK_KPPAGEUP, VK_PREV: // PgUp
1201 if not gChatShow then Inc(conSkipLines);
1202 IK_PAGEDN, IK_KPPAGEDN, VK_NEXT: // PgDown
1203 if not gChatShow and (conSkipLines > 0) then Dec(conSkipLines);
1204 IK_HOME, IK_KPHOME:
1205 CPos := 1;
1206 IK_END, IK_KPEND:
1207 CPos := Length(Line) + 1;
1208 end;
1209 end;
1211 function GetStr(var Str: AnsiString): AnsiString;
1212 var
1213 a, b: Integer;
1214 begin
1215 Result := '';
1216 if Str[1] = '"' then
1217 begin
1218 for b := 1 to Length(Str) do
1219 if (b = Length(Str)) or (Str[b+1] = '"') then
1220 begin
1221 Result := Copy(Str, 2, b-1);
1222 Delete(Str, 1, b+1);
1223 Str := Trim(Str);
1224 Exit;
1225 end;
1226 end;
1228 for a := 1 to Length(Str) do
1229 if (a = Length(Str)) or (Str[a+1] = ' ') then
1230 begin
1231 Result := Copy(Str, 1, a);
1232 Delete(Str, 1, a+1);
1233 Str := Trim(Str);
1234 Exit;
1235 end;
1236 end;
1238 function ParseString(Str: AnsiString): SSArray;
1239 begin
1240 Result := nil;
1242 Str := Trim(Str);
1244 if Str = '' then
1245 Exit;
1247 while Str <> '' do
1248 begin
1249 SetLength(Result, Length(Result)+1);
1250 Result[High(Result)] := GetStr(Str);
1251 end;
1252 end;
1254 procedure g_Console_Add (L: AnsiString; show: Boolean=false);
1256 procedure conmsg (s: AnsiString);
1257 var
1258 a: Integer;
1259 begin
1260 if length(s) = 0 then exit;
1261 for a := 0 to High(MsgArray) do
1262 begin
1263 with MsgArray[a] do
1264 begin
1265 if Time = 0 then
1266 begin
1267 Msg := s;
1268 Time := MsgTime;
1269 exit;
1270 end;
1271 end;
1272 end;
1273 for a := 0 to High(MsgArray)-1 do MsgArray[a] := MsgArray[a+1];
1274 with MsgArray[High(MsgArray)] do
1275 begin
1276 Msg := L;
1277 Time := MsgTime;
1278 end;
1279 end;
1281 var
1282 f: Integer;
1283 begin
1284 // put it to console
1285 cbufPut(L);
1286 if (length(L) = 0) or ((L[length(L)] <> #10) and (L[length(L)] <> #13)) then cbufPut(#10);
1288 // now show 'em out of console too
1289 show := show and gAllowConsoleMessages;
1290 if show and gShowMessages then
1291 begin
1292 // Âûâîä ñòðîê ñ ïåðåíîñàìè ïî î÷åðåäè
1293 while length(L) > 0 do
1294 begin
1295 f := Pos(#10, L);
1296 if f <= 0 then f := length(L)+1;
1297 conmsg(Copy(L, 1, f-1));
1298 Delete(L, 1, f);
1299 end;
1300 end;
1302 //SetLength(ConsoleHistory, Length(ConsoleHistory)+1);
1303 //ConsoleHistory[High(ConsoleHistory)] := L;
1305 (*
1306 {$IFDEF HEADLESS}
1307 e_WriteLog('CON: ' + L, MSG_NOTIFY);
1308 {$ENDIF}
1309 *)
1310 end;
1313 var
1314 consolewriterLastWasEOL: Boolean = false;
1316 procedure consolewriter (constref buf; len: SizeUInt);
1317 var
1318 b: PByte;
1319 begin
1320 if (len < 1) then exit;
1321 b := PByte(@buf);
1322 consolewriterLastWasEOL := (b[len-1] = 13) or (b[len-1] = 10);
1323 while (len > 0) do
1324 begin
1325 if (b[0] <> 13) and (b[0] <> 10) then
1326 begin
1327 cbufPut(AnsiChar(b[0]));
1328 end
1329 else
1330 begin
1331 if (len > 1) and (b[0] = 13) then begin len -= 1; b += 1; end;
1332 cbufPut(#10);
1333 end;
1334 len -= 1;
1335 b += 1;
1336 end;
1337 end;
1340 // returns formatted string if `writerCB` is `nil`, empty string otherwise
1341 //function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1342 //TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
1343 procedure conwriteln (const s: AnsiString; show: Boolean=false);
1344 begin
1345 g_Console_Add(s, show);
1346 end;
1349 procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
1350 begin
1351 if show then
1352 begin
1353 g_Console_Add(formatstrf(s, args), true);
1354 end
1355 else
1356 begin
1357 consolewriterLastWasEOL := false;
1358 formatstrf(s, args, consolewriter);
1359 if not consolewriterLastWasEOL then cbufPut(#10);
1360 end;
1361 end;
1364 procedure g_Console_Clear();
1365 begin
1366 //ConsoleHistory := nil;
1367 cbufClear();
1368 conSkipLines := 0;
1369 end;
1371 procedure AddToHistory(L: AnsiString);
1372 var
1373 len: Integer;
1374 begin
1375 len := Length(CommandHistory);
1377 if (len = 0) or
1378 (LowerCase(CommandHistory[len-1]) <> LowerCase(L)) then
1379 begin
1380 SetLength(CommandHistory, len+1);
1381 CommandHistory[len] := L;
1382 end;
1384 CmdIndex := Length(CommandHistory);
1385 end;
1387 function g_Console_CommandBlacklisted(C: AnsiString): Boolean;
1388 var
1389 Arr: SSArray;
1390 i: Integer;
1391 begin
1392 Result := True;
1394 Arr := nil;
1396 if Trim(C) = '' then
1397 Exit;
1399 Arr := ParseString(C);
1400 if Arr = nil then
1401 Exit;
1403 for i := 0 to High(Whitelist) do
1404 if Whitelist[i] = LowerCase(Arr[0]) then
1405 Result := False;
1406 end;
1408 procedure g_Console_Process(L: AnsiString; quiet: Boolean = False);
1409 var
1410 Arr: SSArray;
1411 i: Integer;
1412 begin
1413 Arr := nil;
1415 if Trim(L) = '' then
1416 Exit;
1418 conSkipLines := 0; // "unscroll"
1420 if L = 'goobers' then
1421 begin
1422 Line := '';
1423 CPos := 1;
1424 gCheats := true;
1425 g_Console_Add('Your memory serves you well.');
1426 exit;
1427 end;
1429 if not quiet then
1430 begin
1431 g_Console_Add('> '+L);
1432 Line := '';
1433 CPos := 1;
1434 end;
1436 Arr := ParseString(L);
1437 if Arr = nil then
1438 Exit;
1440 if commands = nil then
1441 Exit;
1443 if not quiet then
1444 AddToHistory(L);
1446 for i := 0 to High(commands) do
1447 begin
1448 if commands[i].cmd = LowerCase(Arr[0]) then
1449 begin
1450 if assigned(commands[i].procEx) then
1451 begin
1452 commands[i].procEx(@commands[i], Arr);
1453 exit;
1454 end;
1455 if assigned(commands[i].proc) then
1456 begin
1457 commands[i].proc(Arr);
1458 exit;
1459 end;
1460 end;
1461 end;
1463 g_Console_Add(Format(_lc[I_CONSOLE_UNKNOWN], [Arr[0]]));
1464 end;
1467 end.