DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


6cd897c6d6992237ceedbab3105922cd0f5b2e65
[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 procedure g_Console_Init();
565 var
566 a: Integer;
567 begin
568 g_Texture_CreateWAD(ID, GameWAD+':TEXTURES\CONSOLE');
569 Cons_Y := -(gScreenHeight div 2);
570 gConsoleShow := False;
571 gChatShow := False;
572 Cons_Shown := False;
573 CPos := 1;
574
575 for a := 0 to High(MsgArray) do
576 with MsgArray[a] do
577 begin
578 Msg := '';
579 Time := 0;
580 end;
581
582 AddCommand('clear', ConsoleCommands, 'clear console');
583 AddCommand('clearhistory', ConsoleCommands);
584 AddCommand('showhistory', ConsoleCommands);
585 AddCommand('commands', ConsoleCommands);
586 AddCommand('time', ConsoleCommands);
587 AddCommand('date', ConsoleCommands);
588 AddCommand('echo', ConsoleCommands);
589 AddCommand('dump', ConsoleCommands);
590 AddCommand('exec', ConsoleCommands);
591 AddCommand('alias', ConsoleCommands);
592 AddCommand('call', ConsoleCommands);
593
594 AddCommand('d_window', DebugCommands);
595 AddCommand('d_sounds', DebugCommands);
596 AddCommand('d_frames', DebugCommands);
597 AddCommand('d_winmsg', DebugCommands);
598 AddCommand('d_monoff', DebugCommands);
599 AddCommand('d_botoff', DebugCommands);
600 AddCommand('d_monster', DebugCommands);
601 AddCommand('d_health', DebugCommands);
602 AddCommand('d_player', DebugCommands);
603 AddCommand('d_joy', DebugCommands);
604
605 AddCommand('p1_name', GameCVars);
606 AddCommand('p2_name', GameCVars);
607 AddCommand('p1_color', GameCVars);
608 AddCommand('p2_color', GameCVars);
609 AddCommand('r_showfps', GameCVars);
610 AddCommand('r_showtime', GameCVars);
611 AddCommand('r_showscore', GameCVars);
612 AddCommand('r_showlives', GameCVars);
613 AddCommand('r_showstat', GameCVars);
614 AddCommand('r_showkillmsg', GameCVars);
615 AddCommand('r_showspect', GameCVars);
616 AddCommand('r_showping', GameCVars);
617 AddCommand('g_gamemode', GameCVars);
618 AddCommand('g_friendlyfire', GameCVars);
619 AddCommand('g_weaponstay', GameCVars);
620 AddCommand('g_allow_exit', GameCVars);
621 AddCommand('g_allow_monsters', GameCVars);
622 AddCommand('g_bot_vsmonsters', GameCVars);
623 AddCommand('g_bot_vsplayers', GameCVars);
624 AddCommand('g_scorelimit', GameCVars);
625 AddCommand('g_timelimit', GameCVars);
626 AddCommand('g_maxlives', GameCVars);
627 AddCommand('g_warmuptime', GameCVars);
628 AddCommand('net_interp', GameCVars);
629 AddCommand('net_forceplayerupdate', GameCVars);
630 AddCommand('net_predictself', GameCVars);
631 AddCommand('sv_name', GameCVars);
632 AddCommand('sv_passwd', GameCVars);
633 AddCommand('sv_maxplrs', GameCVars);
634 AddCommand('sv_public', GameCVars);
635 AddCommand('sv_intertime', GameCVars);
636
637 AddCommand('quit', GameCommands);
638 AddCommand('exit', GameCommands);
639 AddCommand('pause', GameCommands);
640 AddCommand('endgame', GameCommands);
641 AddCommand('restart', GameCommands);
642 AddCommand('addbot', GameCommands);
643 AddCommand('bot_add', GameCommands);
644 AddCommand('bot_addlist', GameCommands);
645 AddCommand('bot_addred', GameCommands);
646 AddCommand('bot_addblue', GameCommands);
647 AddCommand('bot_removeall', GameCommands);
648 AddCommand('chat', GameCommands);
649 AddCommand('teamchat', GameCommands);
650 AddCommand('game', GameCommands);
651 AddCommand('host', GameCommands);
652 AddCommand('map', GameCommands);
653 AddCommand('nextmap', GameCommands);
654 AddCommand('endmap', GameCommands);
655 AddCommand('goodbye', GameCommands);
656 AddCommand('suicide', GameCommands);
657 AddCommand('spectate', GameCommands);
658 AddCommand('ready', GameCommands);
659 AddCommand('kick', GameCommands);
660 AddCommand('kick_id', GameCommands);
661 AddCommand('ban', GameCommands);
662 AddCommand('permban', GameCommands);
663 AddCommand('ban_id', GameCommands);
664 AddCommand('permban_id', GameCommands);
665 AddCommand('unban', GameCommands);
666 AddCommand('connect', GameCommands);
667 AddCommand('disconnect', GameCommands);
668 AddCommand('reconnect', GameCommands);
669 AddCommand('say', GameCommands);
670 AddCommand('tell', GameCommands);
671 AddCommand('overtime', GameCommands);
672 AddCommand('rcon_password', GameCommands);
673 AddCommand('rcon', GameCommands);
674 AddCommand('callvote', GameCommands);
675 AddCommand('vote', GameCommands);
676 AddCommand('clientlist', GameCommands);
677 AddCommand('event', GameCommands);
678
679 AddCommand('god', GameCheats);
680 AddCommand('notarget', GameCheats);
681 AddCommand('give', GameCheats); // "exit" too ;-)
682 AddCommand('open', GameCheats);
683 AddCommand('fly', GameCheats);
684 AddCommand('noclip', GameCheats);
685 AddCommand('speedy', GameCheats);
686 AddCommand('jumpy', GameCheats);
687 AddCommand('noreload', GameCheats);
688 AddCommand('aimline', GameCheats);
689 AddCommand('automap', GameCheats);
690
691 WhitelistCommand('say');
692 WhitelistCommand('tell');
693 WhitelistCommand('overtime');
694 WhitelistCommand('ready');
695 WhitelistCommand('map');
696 WhitelistCommand('nextmap');
697 WhitelistCommand('endmap');
698 WhitelistCommand('restart');
699 WhitelistCommand('kick');
700 WhitelistCommand('ban');
701
702 WhitelistCommand('addbot');
703 WhitelistCommand('bot_add');
704 WhitelistCommand('bot_addred');
705 WhitelistCommand('bot_addblue');
706 WhitelistCommand('bot_removeall');
707
708 WhitelistCommand('g_gamemode');
709 WhitelistCommand('g_friendlyfire');
710 WhitelistCommand('g_weaponstay');
711 WhitelistCommand('g_allow_exit');
712 WhitelistCommand('g_allow_monsters');
713 WhitelistCommand('g_scorelimit');
714 WhitelistCommand('g_timelimit');
715
716 g_Console_Add(Format(_lc[I_CONSOLE_WELCOME], [GAME_VERSION]));
717 g_Console_Add('');
718 end;
719
720 procedure g_Console_Update();
721 var
722 a, b: Integer;
723 begin
724 if Cons_Shown then
725 begin
726 // Â ïðîöåññå îòêðûòèÿ:
727 if gConsoleShow and (Cons_Y < 0) then
728 begin
729 Cons_Y := Cons_Y+Step;
730 end;
731
732 // Â ïðîöåññå çàêðûòèÿ:
733 if (not gConsoleShow) and
734 (Cons_Y > -(gScreenHeight div 2)) then
735 Cons_Y := Cons_Y-Step;
736
737 // Îêîí÷àòåëüíî îòêðûëàñü:
738 if Cons_Y > 0 then
739 Cons_Y := 0;
740
741 // Îêîí÷àòåëüíî çàêðûëàñü:
742 if Cons_Y <= (-(gScreenHeight div 2)) then
743 begin
744 Cons_Y := -(gScreenHeight div 2);
745 Cons_Shown := False;
746 end;
747 end;
748
749 a := 0;
750 while a <= High(MsgArray) do
751 begin
752 if MsgArray[a].Time > 0 then
753 begin
754 if MsgArray[a].Time = 1 then
755 begin
756 if a < High(MsgArray) then
757 begin
758 for b := a to High(MsgArray)-1 do
759 MsgArray[b] := MsgArray[b+1];
760
761 MsgArray[High(MsgArray)].Time := 0;
762
763 a := a - 1;
764 end;
765 end
766 else
767 Dec(MsgArray[a].Time);
768 end;
769
770 a := a + 1;
771 end;
772 end;
773
774
775 procedure drawConsoleText ();
776 var
777 CWidth, CHeight: Byte;
778 ty: Integer;
779 sp, ep: LongWord;
780 skip: Integer;
781
782 procedure putLine (sp, ep: LongWord);
783 var
784 p: LongWord;
785 wdt, cw: Integer;
786 begin
787 p := sp;
788 wdt := 0;
789 while p <> ep do
790 begin
791 cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
792 if wdt+cw > gScreenWidth-8 then break;
793 //e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
794 Inc(wdt, cw);
795 cbufNext(p);
796 end;
797 if p <> ep then putLine(p, ep); // do rest of the line first
798 // now print our part
799 if skip = 0 then
800 begin
801 ep := p;
802 p := sp;
803 wdt := 2;
804 while p <> ep do
805 begin
806 cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
807 e_TextureFontPrintCharEx(wdt, ty, cbufAt(p), gStdFont);
808 Inc(wdt, cw);
809 cbufNext(p);
810 end;
811 Dec(ty, CHeight);
812 end
813 else
814 begin
815 Dec(skip);
816 end;
817 end;
818
819 begin
820 e_TextureFontGetSize(gStdFont, CWidth, CHeight);
821 ty := (gScreenHeight div 2)-4-2*CHeight-Abs(Cons_Y);
822 skip := conSkipLines;
823 cbufLastLine(sp, ep);
824 repeat
825 putLine(sp, ep);
826 if ty+CHeight <= 0 then break;
827 until not cbufLineUp(sp, ep);
828 end;
829
830 procedure g_Console_Draw();
831 var
832 CWidth, CHeight: Byte;
833 mfW, mfH: Word;
834 a, b: Integer;
835 begin
836 e_TextureFontGetSize(gStdFont, CWidth, CHeight);
837
838 for a := 0 to High(MsgArray) do
839 if MsgArray[a].Time > 0 then
840 e_TextureFontPrintFmt(0, CHeight*a, MsgArray[a].Msg,
841 gStdFont, True);
842
843 if not Cons_Shown then
844 begin
845 if gChatShow then
846 begin
847 if gChatTeam then
848 begin
849 e_TextureFontPrintEx(0, gScreenHeight - CHeight - 1, 'say team> ' + Line,
850 gStdFont, 255, 255, 255, 1, True);
851 e_TextureFontPrintEx((CPos + 9)*CWidth, gScreenHeight - CHeight - 1, '_',
852 gStdFont, 255, 255, 255, 1, True);
853 end
854 else
855 begin
856 e_TextureFontPrintEx(0, gScreenHeight - CHeight - 1, 'say> ' + Line,
857 gStdFont, 255, 255, 255, 1, True);
858 e_TextureFontPrintEx((CPos + 4)*CWidth, gScreenHeight - CHeight - 1, '_',
859 gStdFont, 255, 255, 255, 1, True);
860 end;
861 end;
862 Exit;
863 end;
864
865 if gDebugMode then
866 begin
867 e_CharFont_GetSize(gMenuFont, DEBUG_STRING, mfW, mfH);
868 a := (gScreenWidth - 2*mfW) div 2;
869 b := Cons_Y + ((gScreenHeight div 2) - 2*mfH) div 2;
870 e_CharFont_PrintEx(gMenuFont, a div 2, b div 2, DEBUG_STRING,
871 _RGB(128, 0, 0), 2.0);
872 end;
873
874 e_DrawSize(ID, 0, Cons_Y, Alpha, False, False, gScreenWidth, gScreenHeight div 2);
875 e_TextureFontPrint(0, Cons_Y+(gScreenHeight div 2)-CHeight-4, '> '+Line, gStdFont);
876
877 drawConsoleText();
878 (*
879 if ConsoleHistory <> nil then
880 begin
881 b := 0;
882 if CHeight > 0 then
883 if Length(ConsoleHistory) > ((gScreenHeight div 2) div CHeight)-1 then
884 b := Length(ConsoleHistory)-((gScreenHeight div 2) div CHeight)+1;
885
886 b := Max(b-Offset, 0);
887 d := Max(High(ConsoleHistory)-Offset, 0);
888
889 c := 2;
890 for a := d downto b do
891 begin
892 e_TextureFontPrintFmt(0, (gScreenHeight div 2)-4-c*CHeight-Abs(Cons_Y), ConsoleHistory[a],
893 gStdFont, True);
894 c := c + 1;
895 end;
896 end;
897 *)
898
899 e_TextureFontPrint((CPos+1)*CWidth, Cons_Y+(gScreenHeight div 2)-21, '_', gStdFont);
900 end;
901
902 procedure g_Console_Switch();
903 begin
904 if gChatShow then Exit;
905 gConsoleShow := not gConsoleShow;
906 Cons_Shown := True;
907 end;
908
909 procedure g_Console_Chat_Switch(Team: Boolean = False);
910 begin
911 if gConsoleShow then Exit;
912 if not g_Game_IsNet then Exit;
913 gChatShow := not gChatShow;
914 gChatTeam := Team;
915 if gChatShow then
916 gChatEnter := False;
917 Line := '';
918 CPos := 1;
919 end;
920
921 procedure g_Console_Char(C: AnsiChar);
922 begin
923 if gChatShow and (not gChatEnter) then
924 Exit;
925 Insert(C, Line, CPos);
926 CPos := CPos + 1;
927 end;
928
929
930 var
931 tcomplist: array of AnsiString = nil;
932 tcompidx: array of Integer = nil;
933
934 procedure Complete ();
935 var
936 i, c: Integer;
937 tused: Integer;
938 ll, lpfx, cmd: AnsiString;
939 begin
940 if (Length(Line) = 0) then
941 begin
942 g_Console_Add('');
943 for i := 0 to High(commands) do
944 begin
945 if not commands[i].hidden then
946 begin
947 if (Length(commands[i].help) > 0) then
948 begin
949 g_Console_Add(' '+commands[i].cmd+' -- '+commands[i].help);
950 end
951 else
952 begin
953 g_Console_Add(' '+commands[i].cmd);
954 end;
955 end;
956 end;
957 exit;
958 end;
959
960 ll := LowerCase(Line);
961 lpfx := '';
962
963 if (Length(ll) > 1) and (ll[Length(ll)] = ' ') then
964 begin
965 ll := Copy(ll, 0, Length(ll)-1);
966 for i := 0 to High(commands) do
967 begin
968 if commands[i].hidden then continue;
969 if (commands[i].cmd = ll) then
970 begin
971 if (Length(commands[i].help) > 0) then
972 begin
973 g_Console_Add(' '+commands[i].cmd+' -- '+commands[i].help);
974 end;
975 end;
976 end;
977 exit;
978 end;
979
980 // build completion list
981 tused := 0;
982 for i := 0 to High(commands) do
983 begin
984 if commands[i].hidden then continue;
985 cmd := commands[i].cmd;
986 if (Length(cmd) >= Length(ll)) and (ll = Copy(cmd, 0, Length(ll))) then
987 begin
988 if (tused = Length(tcomplist)) then
989 begin
990 SetLength(tcomplist, Length(tcomplist)+128);
991 SetLength(tcompidx, Length(tcompidx)+128);
992 end;
993 tcomplist[tused] := cmd;
994 tcompidx[tused] := i;
995 Inc(tused);
996 if (Length(cmd) > Length(lpfx)) then lpfx := cmd;
997 end;
998 end;
999
1000 // get longest prefix
1001 for i := 0 to tused-1 do
1002 begin
1003 cmd := tcomplist[i];
1004 for c := 1 to Length(lpfx) do
1005 begin
1006 if (c > Length(cmd)) then break;
1007 if (cmd[c] <> lpfx[c]) then begin lpfx := Copy(lpfx, 0, c-1); break; end;
1008 end;
1009 end;
1010
1011 if (tused = 0) then exit;
1012
1013 if (tused = 1) then
1014 begin
1015 Line := tcomplist[0]+' ';
1016 CPos := Length(Line)+1;
1017 end
1018 else
1019 begin
1020 // has longest prefix?
1021 if (Length(lpfx) > Length(ll)) then
1022 begin
1023 Line := lpfx;
1024 CPos:= Length(Line)+1;
1025 end
1026 else
1027 begin
1028 g_Console_Add('');
1029 for i := 0 to tused-1 do
1030 begin
1031 if (Length(commands[tcompidx[i]].help) > 0) then
1032 begin
1033 g_Console_Add(' '+tcomplist[i]+' -- '+commands[tcompidx[i]].help);
1034 end
1035 else
1036 begin
1037 g_Console_Add(' '+tcomplist[i]);
1038 end;
1039 end;
1040 end;
1041 end;
1042 end;
1043
1044
1045 procedure g_Console_Control(K: Word);
1046 begin
1047 case K of
1048 IK_BACKSPACE:
1049 if (Length(Line) > 0) and (CPos > 1) then
1050 begin
1051 Delete(Line, CPos-1, 1);
1052 CPos := CPos-1;
1053 end;
1054 IK_DELETE:
1055 if (Length(Line) > 0) and (CPos <= Length(Line)) then
1056 Delete(Line, CPos, 1);
1057 IK_LEFT, IK_KPLEFT:
1058 if CPos > 1 then
1059 CPos := CPos - 1;
1060 IK_RIGHT, IK_KPRIGHT:
1061 if CPos <= Length(Line) then
1062 CPos := CPos + 1;
1063 IK_RETURN, IK_KPRETURN:
1064 begin
1065 if Cons_Shown then
1066 g_Console_Process(Line)
1067 else
1068 if gChatShow then
1069 begin
1070 if (Length(Line) > 0) and g_Game_IsNet then
1071 begin
1072 if gChatTeam then
1073 begin
1074 if g_Game_IsClient then
1075 MC_SEND_Chat(b_Text_Format(Line), NET_CHAT_TEAM)
1076 else
1077 MH_SEND_Chat('[' + gPlayer1Settings.name + ']: ' + b_Text_Format(Line),
1078 NET_CHAT_TEAM, gPlayer1Settings.Team);
1079 end
1080 else
1081 begin
1082 if g_Game_IsClient then
1083 MC_SEND_Chat(b_Text_Format(Line), NET_CHAT_PLAYER)
1084 else
1085 MH_SEND_Chat('[' + gPlayer1Settings.name + ']: ' + b_Text_Format(Line),
1086 NET_CHAT_PLAYER);
1087 end;
1088 end;
1089
1090 Line := '';
1091 CPos := 1;
1092 gChatShow := False;
1093 gJustChatted := True;
1094 end;
1095 end;
1096 IK_TAB:
1097 if not gChatShow then
1098 Complete();
1099 IK_DOWN, IK_KPDOWN:
1100 if not gChatShow then
1101 if (CommandHistory <> nil) and
1102 (CmdIndex < Length(CommandHistory)) then
1103 begin
1104 if CmdIndex < Length(CommandHistory)-1 then
1105 CmdIndex := CmdIndex + 1;
1106 Line := CommandHistory[CmdIndex];
1107 CPos := Length(Line) + 1;
1108 end;
1109 IK_UP, IK_KPUP:
1110 if not gChatShow then
1111 if (CommandHistory <> nil) and
1112 (CmdIndex <= Length(CommandHistory)) then
1113 begin
1114 if CmdIndex > 0 then
1115 CmdIndex := CmdIndex - 1;
1116 Line := CommandHistory[CmdIndex];
1117 Cpos := Length(Line) + 1;
1118 end;
1119 IK_PAGEUP, IK_KPPAGEUP: // PgUp
1120 if not gChatShow then Inc(conSkipLines);
1121 IK_PAGEDN, IK_KPPAGEDN: // PgDown
1122 if not gChatShow and (conSkipLines > 0) then Dec(conSkipLines);
1123 IK_HOME, IK_KPHOME:
1124 CPos := 1;
1125 IK_END, IK_KPEND:
1126 CPos := Length(Line) + 1;
1127 end;
1128 end;
1129
1130 function GetStr(var Str: AnsiString): AnsiString;
1131 var
1132 a, b: Integer;
1133 begin
1134 Result := '';
1135 if Str[1] = '"' then
1136 begin
1137 for b := 1 to Length(Str) do
1138 if (b = Length(Str)) or (Str[b+1] = '"') then
1139 begin
1140 Result := Copy(Str, 2, b-1);
1141 Delete(Str, 1, b+1);
1142 Str := Trim(Str);
1143 Exit;
1144 end;
1145 end;
1146
1147 for a := 1 to Length(Str) do
1148 if (a = Length(Str)) or (Str[a+1] = ' ') then
1149 begin
1150 Result := Copy(Str, 1, a);
1151 Delete(Str, 1, a+1);
1152 Str := Trim(Str);
1153 Exit;
1154 end;
1155 end;
1156
1157 function ParseString(Str: AnsiString): SArray;
1158 begin
1159 Result := nil;
1160
1161 Str := Trim(Str);
1162
1163 if Str = '' then
1164 Exit;
1165
1166 while Str <> '' do
1167 begin
1168 SetLength(Result, Length(Result)+1);
1169 Result[High(Result)] := GetStr(Str);
1170 end;
1171 end;
1172
1173 procedure g_Console_Add (L: AnsiString; show: Boolean=false);
1174
1175 procedure conmsg (s: AnsiString);
1176 var
1177 a: Integer;
1178 begin
1179 if length(s) = 0 then exit;
1180 for a := 0 to High(MsgArray) do
1181 begin
1182 with MsgArray[a] do
1183 begin
1184 if Time = 0 then
1185 begin
1186 Msg := s;
1187 Time := MsgTime;
1188 exit;
1189 end;
1190 end;
1191 end;
1192 for a := 0 to High(MsgArray)-1 do MsgArray[a] := MsgArray[a+1];
1193 with MsgArray[High(MsgArray)] do
1194 begin
1195 Msg := L;
1196 Time := MsgTime;
1197 end;
1198 end;
1199
1200 var
1201 f: Integer;
1202 begin
1203 // put it to console
1204 cbufPut(L);
1205 if (length(L) = 0) or ((L[length(L)] <> #10) and (L[length(L)] <> #13)) then cbufPut(#10);
1206
1207 // now show 'em out of console too
1208 show := show and gAllowConsoleMessages;
1209 if show and gShowMessages then
1210 begin
1211 // Âûâîä ñòðîê ñ ïåðåíîñàìè ïî î÷åðåäè
1212 while length(L) > 0 do
1213 begin
1214 f := Pos(#10, L);
1215 if f <= 0 then f := length(L)+1;
1216 conmsg(Copy(L, 1, f-1));
1217 Delete(L, 1, f);
1218 end;
1219 end;
1220
1221 //SetLength(ConsoleHistory, Length(ConsoleHistory)+1);
1222 //ConsoleHistory[High(ConsoleHistory)] := L;
1223
1224 (*
1225 {$IFDEF HEADLESS}
1226 e_WriteLog('CON: ' + L, MSG_NOTIFY);
1227 {$ENDIF}
1228 *)
1229 end;
1230
1231
1232 var
1233 consolewriterLastWasEOL: Boolean = false;
1234
1235 procedure consolewriter (constref buf; len: SizeUInt);
1236 var
1237 b: PByte;
1238 begin
1239 if (len < 1) then exit;
1240 b := PByte(@buf);
1241 consolewriterLastWasEOL := (b[len-1] = 13) or (b[len-1] = 10);
1242 while (len > 0) do
1243 begin
1244 if (b[0] <> 13) and (b[0] <> 10) then
1245 begin
1246 cbufPut(AnsiChar(b[0]));
1247 end
1248 else
1249 begin
1250 if (len > 1) and (b[0] = 13) then begin len -= 1; b += 1; end;
1251 cbufPut(#10);
1252 end;
1253 len -= 1;
1254 b += 1;
1255 end;
1256 end;
1257
1258
1259 // returns formatted string if `writerCB` is `nil`, empty string otherwise
1260 //function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1261 //TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
1262 procedure conwriteln (const s: AnsiString; show: Boolean=false);
1263 begin
1264 g_Console_Add(s, show);
1265 end;
1266
1267
1268 procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
1269 begin
1270 if show then
1271 begin
1272 g_Console_Add(formatstrf(s, args), true);
1273 end
1274 else
1275 begin
1276 consolewriterLastWasEOL := false;
1277 formatstrf(s, args, consolewriter);
1278 if not consolewriterLastWasEOL then cbufPut(#10);
1279 end;
1280 end;
1281
1282
1283 procedure g_Console_Clear();
1284 begin
1285 //ConsoleHistory := nil;
1286 cbufClear();
1287 conSkipLines := 0;
1288 end;
1289
1290 procedure AddToHistory(L: AnsiString);
1291 var
1292 len: Integer;
1293 begin
1294 len := Length(CommandHistory);
1295
1296 if (len = 0) or
1297 (LowerCase(CommandHistory[len-1]) <> LowerCase(L)) then
1298 begin
1299 SetLength(CommandHistory, len+1);
1300 CommandHistory[len] := L;
1301 end;
1302
1303 CmdIndex := Length(CommandHistory);
1304 end;
1305
1306 function g_Console_CommandBlacklisted(C: AnsiString): Boolean;
1307 var
1308 Arr: SArray;
1309 i: Integer;
1310 begin
1311 Result := True;
1312
1313 Arr := nil;
1314
1315 if Trim(C) = '' then
1316 Exit;
1317
1318 Arr := ParseString(C);
1319 if Arr = nil then
1320 Exit;
1321
1322 for i := 0 to High(Whitelist) do
1323 if Whitelist[i] = LowerCase(Arr[0]) then
1324 Result := False;
1325 end;
1326
1327 procedure g_Console_Process(L: AnsiString; quiet: Boolean = False);
1328 var
1329 Arr: SArray;
1330 i: Integer;
1331 begin
1332 Arr := nil;
1333
1334 if Trim(L) = '' then
1335 Exit;
1336
1337 conSkipLines := 0; // "unscroll"
1338
1339 if L = 'goobers' then
1340 begin
1341 Line := '';
1342 CPos := 1;
1343 gCheats := true;
1344 g_Console_Add('Your memory serves you well.');
1345 exit;
1346 end;
1347
1348 if not quiet then
1349 begin
1350 g_Console_Add('> '+L);
1351 Line := '';
1352 CPos := 1;
1353 end;
1354
1355 Arr := ParseString(L);
1356 if Arr = nil then
1357 Exit;
1358
1359 if commands = nil then
1360 Exit;
1361
1362 if not quiet then
1363 AddToHistory(L);
1364
1365 for i := 0 to High(commands) do
1366 begin
1367 if commands[i].cmd = LowerCase(Arr[0]) then
1368 begin
1369 if assigned(commands[i].procEx) then
1370 begin
1371 commands[i].procEx(@commands[i], Arr);
1372 exit;
1373 end;
1374 if assigned(commands[i].proc) then
1375 begin
1376 commands[i].proc(Arr);
1377 exit;
1378 end;
1379 end;
1380 end;
1381
1382 g_Console_Add(Format(_lc[I_CONSOLE_UNKNOWN], [Arr[0]]));
1383 end;
1384
1385 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[15/08/2024 14:52:34]
DEADSOFTWARE 2012-2024