(* 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 {$IFDEF HEADLESS} defaultConfigScript = 'dfserver.cfg'; {$ELSE} defaultConfigScript = 'dfconfig.cfg'; {$ENDIF} 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, g_weapons; 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