(* Copyright (C) DooM 2D:Forever Developers
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see .
*)
{$INCLUDE ../shared/a_modes.inc}
unit g_console;
interface
uses
wadreader; // for SArray
procedure g_Console_Init();
procedure g_Console_Update();
procedure g_Console_Draw();
procedure g_Console_Switch();
procedure g_Console_Char(C: Char);
procedure g_Console_Control(K: Word);
procedure g_Console_Process(L: String; Quiet: Boolean = False);
procedure g_Console_Add(L: String; Show: Boolean = False);
procedure g_Console_Clear();
function g_Console_CommandBlacklisted(C: String): Boolean;
procedure conwriteln (const s: AnsiString; show: Boolean=false);
procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
// <0: no arg; 0/1: true/false
function conGetBoolArg (P: SArray; idx: Integer): Integer;
procedure g_Console_Chat_Switch(Team: Boolean = False);
procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false);
var
gConsoleShow: Boolean; // True - консоль открыта или открывается
gChatShow: Boolean;
gChatTeam: Boolean = False;
gAllowConsoleMessages: Boolean = True;
gChatEnter: Boolean = True;
gJustChatted: Boolean = False; // чтобы админ в интере чатясь не проматывал статистику
implementation
uses
g_textures, g_main, e_graphics, e_input, g_game,
SysUtils, g_basic, g_options, Math,
g_menu, g_language, g_net, g_netmsg, e_log, conbuf, utils;
type
PCommand = ^TCommand;
TCmdProc = procedure (P: SArray);
TCmdProcEx = procedure (me: PCommand; P: SArray);
TCommand = record
Cmd: String;
Proc: TCmdProc;
ProcEx: TCmdProcEx;
help: String;
hidden: Boolean;
ptr: Pointer; // various data
msg: AnsiString; // message for var changes
cheat: Boolean;
end;
TAlias = record
Name: String;
Commands: SArray;
end;
const
Step = 32;
Alpha = 25;
MsgTime = 144;
MaxScriptRecursion = 16;
DEBUG_STRING = 'DEBUG MODE';
var
ID: DWORD;
RecursionDepth: Word = 0;
RecursionLimitHit: Boolean = False;
Cons_Y: SmallInt;
Cons_Shown: Boolean; // Рисовать ли консоль?
Line: String;
CPos: Word;
//ConsoleHistory: SArray;
CommandHistory: SArray;
Whitelist: SArray;
Commands: Array of TCommand = nil;
Aliases: Array of TAlias = nil;
CmdIndex: Word;
conSkipLines: Integer = 0;
MsgArray: Array [0..4] of record
Msg: String;
Time: Word;
end;
// <0: no arg; 0/1: true/false
function conGetBoolArg (P: SArray; idx: Integer): Integer;
begin
if (idx < 0) or (idx > High(P)) then begin result := -1; exit; end;
result := 0;
if (P[idx] = '1') or (CompareText(P[idx], 'on') = 0) or (CompareText(P[idx], 'true') = 0) or
(CompareText(P[idx], 'tan') = 0) or (CompareText(P[idx], 'yes') = 0) then result := 1;
end;
procedure boolVarHandler (me: PCommand; P: SArray);
procedure binaryFlag (var flag: Boolean; msg: string);
begin
if (Length(p) > 2) then
begin
conwritefln('too many arguments to ''%s''', [P[0]]);
end
else
begin
case conGetBoolArg(P, 1) of
-1: begin end;
0: if conIsCheatsEnabled then flag := false else begin conwriteln('not available'); exit; end;
1: if conIsCheatsEnabled then flag := true else begin conwriteln('not available'); exit; end;
end;
if flag then conwritefln('%s: tan', [msg]) else conwritefln('%s: ona', [msg]);
end;
end;
begin
binaryFlag(PBoolean(me.ptr)^, me.msg);
end;
procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false);
var
f: Integer;
cp: PCommand;
begin
f := Length(Commands);
SetLength(Commands, f+1);
cp := @Commands[f];
cp.Cmd := LowerCase(conname);
cp.Proc := nil;
cp.ProcEx := boolVarHandler;
cp.help := ahelp;
cp.hidden := false;
cp.ptr := pvar;
cp.msg := amsg;
cp.cheat := acheat;
end;
function GetStrACmd(var Str: String): String;
var
a: Integer;
begin
Result := '';
for a := 1 to Length(Str) do
if (a = Length(Str)) or (Str[a+1] = ';') then
begin
Result := Copy(Str, 1, a);
Delete(Str, 1, a+1);
Str := Trim(Str);
Exit;
end;
end;
function ParseAlias(Str: String): SArray;
begin
Result := nil;
Str := Trim(Str);
if Str = '' then
Exit;
while Str <> '' do
begin
SetLength(Result, Length(Result)+1);
Result[High(Result)] := GetStrACmd(Str);
end;
end;
procedure ConsoleCommands(P: SArray);
var
Cmd, s: String;
a, b: Integer;
F: TextFile;
begin
Cmd := LowerCase(P[0]);
s := '';
if Cmd = 'clear' then
begin
//ConsoleHistory := nil;
cbufClear();
conSkipLines := 0;
for a := 0 to High(MsgArray) do
with MsgArray[a] do
begin
Msg := '';
Time := 0;
end;
end;
if Cmd = 'clearhistory' then
CommandHistory := nil;
if Cmd = 'showhistory' then
if CommandHistory <> nil then
begin
g_Console_Add('');
for a := 0 to High(CommandHistory) do
g_Console_Add(' '+CommandHistory[a]);
end;
if Cmd = 'commands' then
begin
g_Console_Add('');
g_Console_Add('Commands list:');
for a := High(Commands) downto 0 do
begin
if (Length(Commands[a].help) > 0) then
begin
g_Console_Add(' '+Commands[a].Cmd+' -- '+Commands[a].help);
end
else
begin
g_Console_Add(' '+Commands[a].Cmd);
end;
end;
end;
if Cmd = 'time' then
g_Console_Add(TimeToStr(Now), True);
if Cmd = 'date' then
g_Console_Add(DateToStr(Now), True);
if Cmd = 'echo' then
if Length(P) > 1 then
begin
if P[1] = 'ololo' then
gCheats := True
else
begin
s := '';
for a := 1 to High(P) do
s := s + P[a] + ' ';
g_Console_Add(b_Text_Format(s), True);
end;
end
else
g_Console_Add('');
if Cmd = 'dump' then
begin
(*
if ConsoleHistory <> nil then
begin
if Length(P) > 1 then
s := P[1]
else
s := GameDir+'/console.txt';
{$I-}
AssignFile(F, s);
Rewrite(F);
if IOResult <> 0 then
begin
g_Console_Add(Format(_lc[I_CONSOLE_ERROR_WRITE], [s]));
CloseFile(F);
Exit;
end;
for a := 0 to High(ConsoleHistory) do
WriteLn(F, ConsoleHistory[a]);
CloseFile(F);
g_Console_Add(Format(_lc[I_CONSOLE_DUMPED], [s]));
{$I+}
end;
*)
end;
if Cmd = 'exec' then
begin
// exec
if Length(P) > 1 then
begin
s := GameDir+'/'+P[1];
{$I-}
AssignFile(F, s);
Reset(F);
if IOResult <> 0 then
begin
g_Console_Add(Format(_lc[I_CONSOLE_ERROR_READ], [s]));
CloseFile(F);
Exit;
end;
g_Console_Add(Format(_lc[I_CONSOLE_EXEC], [s]));
while not EOF(F) do
begin
ReadLn(F, s);
if IOResult <> 0 then
begin
g_Console_Add(Format(_lc[I_CONSOLE_ERROR_READ], [s]));
CloseFile(F);
Exit;
end;
if Pos('#', s) <> 1 then // script comment
begin
// prevents endless loops
Inc(RecursionDepth);
RecursionLimitHit := (RecursionDepth > MaxScriptRecursion) or RecursionLimitHit;
if not RecursionLimitHit then
g_Console_Process(s, True);
Dec(RecursionDepth);
end;
end;
if (RecursionDepth = 0) and RecursionLimitHit then
begin
g_Console_Add(Format(_lc[I_CONSOLE_ERROR_CALL], [s]));
RecursionLimitHit := False;
end;
CloseFile(F);
{$I+}
end
else
g_Console_Add('exec