(* 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, version 3 of the License ONLY.
*
* 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
utils; // for SSArray
const
ACTION_JUMP = 0;
ACTION_MOVELEFT = 1;
ACTION_MOVERIGHT = 2;
ACTION_LOOKDOWN = 3;
ACTION_LOOKUP = 4;
ACTION_ATTACK = 5;
ACTION_SCORES = 6;
ACTION_ACTIVATE = 7;
ACTION_STRAFE = 8;
FIRST_ACTION = ACTION_JUMP;
LAST_ACTION = ACTION_STRAFE;
procedure g_Console_Init;
procedure g_Console_SysInit;
procedure g_Console_Update;
procedure g_Console_Draw (MessagesOnly: Boolean = False);
procedure g_Console_Char (C: AnsiChar);
procedure g_Console_Control (K: Word);
procedure g_Console_Process (L: AnsiString; quiet: Boolean=false);
procedure g_Console_Add (L: AnsiString; show: Boolean=false);
procedure g_Console_Clear;
function g_Console_CommandBlacklisted (C: AnsiString): Boolean;
procedure g_Console_ReadConfig (filename: String);
procedure g_Console_WriteConfig (filename: String);
procedure g_Console_WriteGameConfig;
function g_Console_Interactive: Boolean;
function g_Console_Action (action: Integer): Boolean;
function g_Console_MatchBind (key: Integer; down: AnsiString; up: AnsiString = ''): Boolean;
function g_Console_FindBind (n: Integer; down: AnsiString; up: AnsiString = ''): Integer;
procedure g_Console_BindKey (key: Integer; down: AnsiString; up: AnsiString = ''; rep: Boolean = False);
procedure g_Console_ProcessBind (key: Integer; down: Boolean);
procedure g_Console_ProcessBindRepeat (key: Integer);
procedure g_Console_ResetBinds;
procedure conwriteln (const s: AnsiString; show: Boolean=false);
procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
procedure conRegVar (const conname: AnsiString; pvar: PSingle; amin, amax: Single; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
procedure conRegVar (const conname: AnsiString; pvar: PInteger; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
procedure conRegVar (const conname: AnsiString; pvar: PWord; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
procedure conRegVar (const conname: AnsiString; pvar: PCardinal; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
procedure conRegVar (const conname: AnsiString; pvar: PAnsiString; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
// <0: no arg; 0/1: true/false
function conGetBoolArg (p: SSArray; idx: Integer): Integer;
// poor man's floating literal parser; i'm sorry, but `StrToFloat()` sux cocks
function conParseFloat (var res: Single; const s: AnsiString): Boolean;
const
defaultConfigScript = 'dfconfig.cfg';
var
gConsoleShow: Boolean = false; // True - консоль открыта или открывается
gChatShow: Boolean = false;
gChatTeam: Boolean = false;
gAllowConsoleMessages: Boolean = true;
gJustChatted: Boolean = false; // чтобы админ в интере чатясь не проматывал статистику
gParsingBinds: Boolean = true; // не пересохранять конфиг во время парсинга
gPlayerAction: Array [0..1, 0..LAST_ACTION] of Boolean; // [player, action]
gConfigScript: string = defaultConfigScript;
implementation
uses
g_textures, g_main, e_graphics, e_input, g_game, g_gfx, g_player, g_items,
SysUtils, g_basic, g_options, Math, g_touch, e_res,
g_menu, g_gui, g_language, g_net, g_netmsg, e_log, conbuf;
const
autoexecScript = 'autoexec.cfg';
configComment = 'generated by doom2d, do not modify';
type
PCommand = ^TCommand;
TCmdProc = procedure (p: SSArray);
TCmdProcEx = procedure (me: PCommand; p: SSArray);
TCommand = record
cmd: AnsiString;
proc: TCmdProc;
procEx: TCmdProcEx;
help: AnsiString;
hidden: Boolean;
ptr: Pointer; // various data
msg: AnsiString; // message for var changes
cheat: Boolean;
action: Integer; // >= 0 for action commands
player: Integer; // used for action commands
end;
TAlias = record
name: AnsiString;
commands: SSArray;
end;
const
MsgTime = 144;
MaxScriptRecursion = 16;
DEBUG_STRING = 'DEBUG MODE';
var
ID: DWORD;
RecursionDepth: Word = 0;
RecursionLimitHit: Boolean = False;
Cons_Y: SmallInt;
ConsoleHeight: Single;
Cons_Shown: Boolean; // draw console
InputReady: Boolean; // allow text input in console/chat
Line: AnsiString;
CPos: Word;
//ConsoleHistory: SSArray;
CommandHistory: SSArray;
Whitelist: SSArray;
commands: Array of TCommand = nil;
Aliases: Array of TAlias = nil;
CmdIndex: Word;
conSkipLines: Integer = 0;
MsgArray: Array [0..4] of record
Msg: AnsiString;
Time: Word;
end;
gInputBinds: Array [0..e_MaxInputKeys - 1] of record
rep: Boolean;
down, up: SSArray;
end;
menu_toggled: BOOLEAN; (* hack for menu controls *)
ChatTop: BOOLEAN;
ConsoleStep: Single;
ConsoleTrans: Single;
procedure g_Console_Switch;
begin
Cons_Y := Min(0, Max(Cons_Y, -Floor(gScreenHeight * ConsoleHeight)));
if Cons_Shown = False then
Cons_Y := -Floor(gScreenHeight * ConsoleHeight);
gChatShow := False;
gConsoleShow := not gConsoleShow;
Cons_Shown := True;
InputReady := False;
g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
end;
procedure g_Console_Chat_Switch (Team: Boolean = False);
begin
if not g_Game_IsNet then Exit;
Cons_Y := Min(0, Max(Cons_Y, -Floor(gScreenHeight * ConsoleHeight)));
if Cons_Shown = False then
Cons_Y := -Floor(gScreenHeight * ConsoleHeight);
gConsoleShow := False;
gChatShow := not gChatShow;
gChatTeam := Team;
Cons_Shown := True;
InputReady := False;
Line := '';
CPos := 1;
g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
end;
// poor man's floating literal parser; i'm sorry, but `StrToFloat()` sux cocks
function conParseFloat (var res: Single; const s: AnsiString): Boolean;
var
pos: Integer = 1;
frac: Single = 1;
slen: Integer;
begin
result := false;
res := 0;
slen := Length(s);
while (slen > 0) and (s[slen] <= ' ') do Dec(slen);
while (pos <= slen) and (s[pos] <= ' ') do Inc(pos);
if (pos > slen) then exit;
if (slen-pos = 1) and (s[pos] = '.') then exit; // single dot
// integral part
while (pos <= slen) do
begin
if (s[pos] < '0') or (s[pos] > '9') then break;
res := res*10+Byte(s[pos])-48;
Inc(pos);
end;
if (pos <= slen) then
begin
// must be a dot
if (s[pos] <> '.') then exit;
Inc(pos);
while (pos <= slen) do
begin
if (s[pos] < '0') or (s[pos] > '9') then break;
frac := frac/10;
res += frac*(Byte(s[pos])-48);
Inc(pos);
end;
end;
if (pos <= slen) then exit; // oops
result := true;
end;
// ////////////////////////////////////////////////////////////////////////// //
// <0: no arg; 0/1: true/false; 666: toggle
function conGetBoolArg (p: SSArray; 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
else if (CompareText(p[idx], 'toggle') = 0) or (CompareText(p[idx], 'switch') = 0) or
(CompareText(p[idx], 't') = 0) then result := 666;
end;
procedure boolVarHandler (me: PCommand; p: SSArray);
procedure binaryFlag (var flag: Boolean; msg: AnsiString);
var
old: Boolean;
begin
if (Length(p) > 2) then
begin
conwritefln('too many arguments to ''%s''', [p[0]]);
end
else
begin
old := flag;
case conGetBoolArg(p, 1) of
-1: begin end;
0: if not me.cheat or conIsCheatsEnabled then flag := false else begin conwriteln('not available'); exit; end;
1: if not me.cheat or conIsCheatsEnabled then flag := true else begin conwriteln('not available'); exit; end;
666: if not me.cheat or conIsCheatsEnabled then flag := not flag else begin conwriteln('not available'); exit; end;
end;
if flag <> old then
g_Console_WriteGameConfig();
if (Length(msg) = 0) then msg := p[0] else msg += ':';
if flag then conwritefln('%s tan', [msg]) else conwritefln('%s ona', [msg]);
end;
end;
begin
binaryFlag(PBoolean(me.ptr)^, me.msg);
end;
procedure intVarHandler (me: PCommand; p: SSArray);
var
old: Integer;
begin
if (Length(p) <> 2) then
begin
conwritefln('%s %d', [me.cmd, PInteger(me.ptr)^]);
end
else
begin
try
old := PInteger(me.ptr)^;
PInteger(me.ptr)^ := StrToInt(p[1]);
if PInteger(me.ptr)^ <> old then
g_Console_WriteGameConfig();
except
conwritefln('invalid integer value: "%s"', [p[1]]);
end;
end;
end;
procedure wordVarHandler (me: PCommand; p: SSArray);
var
old: Integer;
begin
if (Length(p) <> 2) then
begin
conwritefln('%s %d', [me.cmd, PInteger(me.ptr)^]);
end
else
begin
try
old := PWord(me.ptr)^;
PWord(me.ptr)^ := min($FFFF, StrToDWord(p[1]));
if PWord(me.ptr)^ <> old then
g_Console_WriteGameConfig();
except
conwritefln('invalid word value: "%s"', [p[1]]);
end;
end;
end;
procedure dwordVarHandler (me: PCommand; p: SSArray);
var
old: Integer;
begin
if (Length(p) <> 2) then
begin
conwritefln('%s %d', [me.cmd, PInteger(me.ptr)^]);
end
else
begin
try
old := PCardinal(me.ptr)^;
PCardinal(me.ptr)^ := StrToDWord(p[1]);
if PCardinal(me.ptr)^ <> old then
g_Console_WriteGameConfig();
except
conwritefln('invalid dword value: "%s"', [p[1]]);
end;
end;
end;
procedure strVarHandler (me: PCommand; p: SSArray);
var
old: AnsiString;
begin
if (Length(p) <> 2) then
begin
conwritefln('%s %s', [me.cmd, QuoteStr(PAnsiString(me.ptr)^)]);
end
else
begin
old := PAnsiString(me.ptr)^;
PAnsiString(me.ptr)^ := p[1];
if PAnsiString(me.ptr)^ <> old then
g_Console_WriteGameConfig();
end;
end;
procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
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 := ahidden;
cp.ptr := pvar;
cp.msg := amsg;
cp.cheat := acheat;
cp.action := -1;
cp.player := -1;
end;
procedure conRegVar (const conname: AnsiString; pvar: PInteger; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
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 := intVarHandler;
cp.help := ahelp;
cp.hidden := ahidden;
cp.ptr := pvar;
cp.msg := amsg;
cp.cheat := acheat;
cp.action := -1;
cp.player := -1;
end;
procedure conRegVar (const conname: AnsiString; pvar: PWord; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
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 := wordVarHandler;
cp.help := ahelp;
cp.hidden := ahidden;
cp.ptr := pvar;
cp.msg := amsg;
cp.cheat := acheat;
cp.action := -1;
cp.player := -1;
end;
procedure conRegVar (const conname: AnsiString; pvar: PCardinal; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
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 := dwordVarHandler;
cp.help := ahelp;
cp.hidden := ahidden;
cp.ptr := pvar;
cp.msg := amsg;
cp.cheat := acheat;
cp.action := -1;
cp.player := -1;
end;
procedure conRegVar (const conname: AnsiString; pvar: PAnsiString; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
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 := strVarHandler;
cp.help := ahelp;
cp.hidden := ahidden;
cp.ptr := pvar;
cp.msg := amsg;
cp.cheat := acheat;
cp.action := -1;
cp.player := -1;
end;
// ////////////////////////////////////////////////////////////////////////// //
type
PVarSingle = ^TVarSingle;
TVarSingle = record
val: PSingle;
min, max, def: Single; // default will be starting value
end;
procedure singleVarHandler (me: PCommand; p: SSArray);
var
pv: PVarSingle;
nv, old: Single;
msg: AnsiString;
begin
if (Length(p) > 2) then
begin
conwritefln('too many arguments to ''%s''', [me.cmd]);
exit;
end;
pv := PVarSingle(me.ptr);
old := pv.val^;
if (Length(p) = 2) then
begin
if me.cheat and (not conIsCheatsEnabled) then begin conwriteln('not available'); exit; end;
if (CompareText(p[1], 'default') = 0) or (CompareText(p[1], 'def') = 0) or
(CompareText(p[1], 'd') = 0) or (CompareText(p[1], 'off') = 0) or
(CompareText(p[1], 'ona') = 0) then
begin
pv.val^ := pv.def;
end
else
begin
if not conParseFloat(nv, p[1]) then
begin
conwritefln('%s: ''%s'' doesn''t look like a floating number', [me.cmd, p[1]]);
exit;
end;
if (nv < pv.min) then nv := pv.min;
if (nv > pv.max) then nv := pv.max;
pv.val^ := nv;
end;
end;
if pv.val^ <> old then
g_Console_WriteGameConfig();
msg := me.msg;
if (Length(msg) = 0) then msg := me.cmd else msg += ':';
conwritefln('%s %s', [msg, pv.val^]);
end;
procedure conRegVar (const conname: AnsiString; pvar: PSingle; amin, amax: Single; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
var
f: Integer;
cp: PCommand;
pv: PVarSingle;
begin
GetMem(pv, sizeof(TVarSingle));
pv.val := pvar;
pv.min := amin;
pv.max := amax;
pv.def := pvar^;
f := Length(commands);
SetLength(commands, f+1);
cp := @commands[f];
cp.cmd := LowerCase(conname);
cp.proc := nil;
cp.procEx := singleVarHandler;
cp.help := ahelp;
cp.hidden := ahidden;
cp.ptr := pv;
cp.msg := amsg;
cp.cheat := acheat;
cp.action := -1;
cp.player := -1;
end;
// ////////////////////////////////////////////////////////////////////////// //
function GetStrACmd(var Str: AnsiString): AnsiString;
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: AnsiString): SSArray;
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: SSArray);
var
cmd, s: AnsiString;
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) = 2 then
g_Console_ReadConfig(p[1])
else
g_Console_Add('exec