DEADSOFTWARE

started `conRegVar()` API (only for booleans for now)
[d2df-sdl.git] / src / game / g_console.pas
index c9568f02005d8f09b7f75481eb2d1cb02f38be1b..d16d9d606b8fd637044548619cd9a04ae9972938 100644 (file)
@@ -18,6 +18,9 @@ unit g_console;
 
 interface
 
+uses
+  wadreader; // for SArray
+
 procedure g_Console_Init();
 procedure g_Console_Update();
 procedure g_Console_Draw();
@@ -29,8 +32,17 @@ 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;
@@ -43,17 +55,24 @@ implementation
 
 uses
   g_textures, g_main, e_graphics, e_input, g_game,
-  SysUtils, g_basic, g_options, wadreader, Math,
-  g_menu, g_language, g_net, g_netmsg, e_log, conbuf;
+  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
@@ -61,6 +80,7 @@ type
     Commands: SArray;
   end;
 
+
 const
   Step = 32;
   Alpha = 25;
@@ -80,8 +100,8 @@ var
   //ConsoleHistory: SArray;
   CommandHistory: SArray;
   Whitelist: SArray;
-  Commands: Array of TCommand;
-  Aliases: Array of TAlias;
+  Commands: Array of TCommand = nil;
+  Aliases: Array of TAlias = nil;
   CmdIndex: Word;
   conSkipLines: Integer = 0;
   MsgArray: Array [0..4] of record
@@ -89,6 +109,60 @@ var
                               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;
@@ -348,16 +422,22 @@ begin
   Whitelist[a] := LowerCase(Cmd);
 end;
 
-procedure AddCommand(Cmd: String; Proc: TCmdProc; ahelp: String=''; ahidden: Boolean=false);
+procedure AddCommand(Cmd: String; Proc: TCmdProc; ahelp: String=''; ahidden: Boolean=false; acheat: Boolean=false);
 var
   a: Integer;
+  cp: PCommand;
 begin
   SetLength(Commands, Length(Commands)+1);
   a := High(Commands);
-  Commands[a].Cmd := LowerCase(Cmd);
-  Commands[a].Proc := Proc;
-  Commands[a].hidden := ahidden;
-  Commands[a].help := ahelp;
+  cp := @Commands[a];
+  cp.Cmd := LowerCase(Cmd);
+  cp.Proc := Proc;
+  cp.ProcEx := nil;
+  cp.help := ahelp;
+  cp.hidden := ahidden;
+  cp.ptr := nil;
+  cp.msg := '';
+  cp.cheat := acheat;
 end;
 
 procedure g_Console_Init();
@@ -401,21 +481,6 @@ begin
   AddCommand('d_player', DebugCommands);
   AddCommand('d_joy', DebugCommands);
 
-  AddCommand('pf_draw_frame', ProfilerCommands, 'draw frame rendering profiles');
-  //AddCommand('pf_update_frame', ProfilerCommands);
-  AddCommand('pf_coldet', ProfilerCommands, 'draw collision detection profiles');
-  AddCommand('pf_los', ProfilerCommands, 'draw monster LOS profiles');
-  AddCommand('r_sq_draw', ProfilerCommands, 'accelerated spatial queries in rendering');
-  AddCommand('cd_sq_enabled', ProfilerCommands, 'accelerated spatial queries in map coldet');
-  AddCommand('mon_sq_enabled', ProfilerCommands, 'use accelerated spatial queries for monsters');
-  AddCommand('wtrace_sq_enabled', ProfilerCommands, 'use accelerated weapon hitscan trace');
-
-  AddCommand('pr_enabled', ProfilerCommands, 'enable/disable particles');
-  AddCommand('pr_phys_enabled', ProfilerCommands, 'enable/disable particle physics');
-  AddCommand('los_enabled', ProfilerCommands, 'enable/disable LOS calculations');
-
-  AddCommand('mon_think', ProfilerCommands, 'enable/disable monster thinking');
-
   AddCommand('p1_name', GameCVars);
   AddCommand('p2_name', GameCVars);
   AddCommand('p1_color', GameCVars);
@@ -1042,6 +1107,58 @@ begin
   *)
 end;
 
+
+var
+  consolewriterLastWasEOL: Boolean = false;
+
+procedure consolewriter (constref buf; len: SizeUInt);
+var
+  b: PByte;
+begin
+  if (len < 1) then exit;
+  b := PByte(@buf);
+  consolewriterLastWasEOL := (b[len-1] = 13) or (b[len-1] = 10);
+  while (len > 0) do
+  begin
+    if (b[0] <> 13) and (b[0] <> 10) then
+    begin
+      cbufPut(Char(b[0]));
+    end
+    else
+    begin
+      if (len > 1) and (b[0] = 13) then begin len -= 1; b += 1; end;
+      cbufPut(#10);
+    end;
+    len -= 1;
+    b += 1;
+  end;
+end;
+
+
+// returns formatted string if `writerCB` is `nil`, empty string otherwise
+//function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
+//TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
+procedure conwriteln (const s: AnsiString; show: Boolean=false);
+begin
+  g_Console_Add(s, show);
+end;
+
+
+procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
+begin
+  if show then
+  begin
+    g_Console_Add(formatstrf(s, args), true);
+  end
+  else
+  begin
+    consolewriterLastWasEOL := false;
+    formatstrf(s, args, consolewriter);
+    if not consolewriterLastWasEOL then cbufPut(#10);
+  end;
+end;
+
+
 procedure g_Console_Clear();
 begin
   //ConsoleHistory := nil;
@@ -1125,12 +1242,21 @@ begin
     AddToHistory(L);
 
   for i := 0 to High(Commands) do
+  begin
     if Commands[i].Cmd = LowerCase(Arr[0]) then
-      if @Commands[i].Proc <> nil then
+    begin
+      if assigned(Commands[i].ProcEx) then
+      begin
+        Commands[i].ProcEx(@Commands[i], Arr);
+        exit;
+      end;
+      if assigned(Commands[i].Proc) then
       begin
         Commands[i].Proc(Arr);
-        Exit;
+        exit;
       end;
+    end;
+  end;
 
   g_Console_Add(Format(_lc[I_CONSOLE_UNKNOWN], [Arr[0]]));
 end;