DEADSOFTWARE

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