log messages now written to console too

diff --git a/src/engine/e_graphics.pas b/src/engine/e_graphics.pas
index d7bced43a353957e88aac4426d93027eb75a7ae0..c5a97b90c56961b8088fd4464fd0b763114aff88 100644 (file)
--- a/src/engine/e_graphics.pas
+++ b/src/engine/e_graphics.pas
@@ -97,6 +97,9 @@ procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD; Shadow
 procedure e_TextureFontGetSize(ID: DWORD; var CharWidth, CharHeight: Byte);
 procedure e_RemoveAllTextureFont();
 
+function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
+procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
+
 procedure e_ReleaseEngine();
 procedure e_BeginRender();
 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
@@ -1468,6 +1471,24 @@ begin
   glPopMatrix;
 end;
 
+procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
+begin
+  glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
+  glEnable(GL_TEXTURE_2D);
+  //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
+
+  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+  glEnable(GL_BLEND);
+  e_TextureFontPrintChar(X, Y, Ch, FontID, Shadow);
+  glDisable(GL_TEXTURE_2D);
+  glDisable(GL_BLEND);
+end;
+
+function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
+begin
+  result := e_TextureFonts[FontID].CharWidth;
+end;
+
 procedure e_TextureFontPrintFmt(X, Y: Integer; Text: string; FontID: DWORD; Shadow: Boolean = False);
 var
   a, TX, TY, len: Integer;

diff --git a/src/engine/e_log.pas b/src/engine/e_log.pas
index 1a2499060453086ace60781d3c3b85e7fabd995d..472bd5762544126e0b60850d48eaf5ae6b7d7bac 100644 (file)
--- a/src/engine/e_log.pas
+++ b/src/engine/e_log.pas
@@ -1,5 +1,6 @@
 {$MODE DELPHI}
 {$R-}
+{ $DEFINE CBLOG}
 unit e_log;
 
 interface
@@ -8,37 +9,56 @@ uses
   SysUtils;
 
 type
-  TWriteMode=(WM_NEWFILE,  WM_OLDFILE);
-  TRecordCategory=(MSG_FATALERROR, MSG_WARNING, MSG_NOTIFY);
+  TWriteMode = (WM_NEWFILE,  WM_OLDFILE);
+  TRecordCategory = (MSG_FATALERROR, MSG_WARNING, MSG_NOTIFY);
+
+
+procedure e_InitLog (fFileName: String; fWriteMode: TWriteMode);
+procedure e_WriteLog (TextLine: String; RecordCategory: TRecordCategory; WriteTime: Boolean=True);
+function DecodeIPV4 (ip: LongWord): string;
+
+
+// start Write/WriteLn driver. it will write everything to cbuf.
+procedure e_InitWritelnDriver ();
 
-procedure e_InitLog(fFileName: String; fWriteMode: TWriteMode);
-procedure e_WriteLog(TextLine: String; RecordCategory: TRecordCategory;
-                     WriteTime: Boolean = True);
-function DecodeIPV4(ip: LongWord): string;
 
 var
   e_WriteToStdOut: Boolean = False;
 
+
 implementation
 
+uses
+  conbuf;
+
+
 var
   FirstRecord: Boolean;
   FileName: String;
+  driverInited: Boolean = false;
 
-{ TLog }
 
-function DecodeIPV4(ip: LongWord): string;
+function DecodeIPV4 (ip: LongWord): string;
 begin
   Result := Format('%d.%d.%d.%d', [ip and $FF, (ip shr 8) and $FF, (ip shr 16) and $FF, (ip shr 24)]);
 end;
 
-procedure e_WriteLog(TextLine: String; RecordCategory: TRecordCategory;
-                     WriteTime: Boolean = True);
+
+procedure e_WriteLog (TextLine: String; RecordCategory: TRecordCategory; WriteTime: Boolean=True);
 var
   LogFile: TextFile;
   Prefix: ShortString = '';
   OutStr: String;
 begin
+  if driverInited and (length(TextLine) > 0) then
+  begin
+    case RecordCategory of
+      MSG_FATALERROR: write('FATAL: ');
+      MSG_WARNING: write('WARNINIG: ');
+    end;
+    writeln(TextLine);
+  end;
+
   if FileName = '' then Exit;
 
   Assign(LogFile, FileName);
@@ -72,7 +92,8 @@ begin
   end;
 end;
 
-procedure e_InitLog(fFileName: String; fWriteMode: TWriteMode);
+
+procedure e_InitLog (fFileName: String; fWriteMode: TWriteMode);
 begin
  FileName := fFileName;
  if fWriteMode = WM_NEWFILE then
@@ -85,4 +106,152 @@ begin
  FirstRecord := True;
 end;
 
+
+// ////////////////////////////////////////////////////////////////////////// //
+(* Write/WriteLn driver *)
+//
+// control codes:
+//   CR, LF, BS
+//   TAB: tab space = 4
+//
+//   userData[1]: current x (for tabs)
+//   userData[2]: #13 was eaten, we should skip next #10
+//
+type
+  TDevFunc = function (var f: TTextRec): Integer;
+
+const
+  udX = 1;
+  udWasCR = 2;
+
+
+procedure ProcessOutput (var tf: TTextRec; buf: PChar; count: Integer);
+var
+  wcr: Boolean;
+  ep: PChar;
+  f, x: Integer;
+  ch: Char;
+begin
+  x := tf.userData[udX];
+  wcr := (tf.userData[udWasCR] <> 0);
+  while count > 0 do
+  begin
+    if wcr then
+    begin
+      wcr := false;
+      if buf^ = #10 then continue;
+    end;
+    // look for some special char
+    ep := buf;
+    f := 0;
+    while f < count do
+    begin
+      ch := ep^;
+      if (ch = #13) or (ch = #10) or (ch = #9) or (ch = #8) then break;
+      Inc(ep);
+      Inc(f);
+{$IFDEF CBLOG}
+      write(stderr, ch);
+{$ENDIF}
+    end;
+    if f > 0 then
+    begin
+      cbufPutChars(buf, f);
+      Inc(buf, f);
+      Dec(count, f);
+      Inc(x, f);
+      continue;
+    end;
+    // process special chars
+    ch := buf^;
+    Inc(buf);
+    Dec(count);
+    // tab
+    if ch = #9 then
+    begin
+{$IFDEF CBLOG}
+      write(stderr, ch);
+{$ENDIF}
+      repeat
+        cbufPut(' ');
+        Inc(x);
+      until (x mod 4) = 0;
+      continue;
+    end;
+    // cr, lf
+    if (ch = #13) or (ch = #10) then
+    begin
+{$IFDEF CBLOG}
+      writeln(stderr);
+{$ENDIF}
+      wcr := (ch = #13);
+      x := 0;
+      cbufPut(#10);
+      continue;
+    end;
+  end;
+  tf.userData[udX] := x;
+  tf.userData[udWasCR] := ord(wcr);
+end;
+
+
+function DevOpen (var f: TTextRec): Integer;
+begin
+  f.userData[udX] := 0;
+  f.userData[udWasCR] := 0;
+  f.bufPos := 0;
+  f.bufEnd := 0;
+  result := 0;
+end;
+
+function DevInOut (var f: TTextRec): Integer;
+var
+  buf: PChar;
+  sz: Integer;
+begin
+  result := 0;
+  buf := Pointer(f.BufPtr);
+  sz := f.BufPos;
+  if sz > 0 then ProcessOutput(f, buf, sz);
+  f.bufPos := 0;
+  f.bufEnd := 0;
+end;
+
+function DevFlush (var f: TTextRec): Integer;
+begin
+  result := DevInOut(f);
+end;
+
+function DevClose (var f: TTextRec): Integer;
+begin
+  result := 0;
+end;
+
+
+procedure e_InitWritelnDriver ();
+begin
+  if not driverInited then
+  begin
+    driverInited := true;
+    with TTextRec(output) do
+    begin
+      Mode := fmClosed;
+      if BufPtr = nil then
+      begin
+        BufSize := SizeOf(Buffer);
+        BufPtr := @Buffer;
+      end;
+      OpenFunc := @DevOpen;
+      InOutFunc := @DevInOut;
+      FlushFunc := @DevFlush;
+      CloseFunc := @DevClose;
+      Name[0] := #0;
+    end;
+    Rewrite(output);
+  end;
+end;
+
+
+begin
+  e_InitWritelnDriver();
 end.

diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr
index 1c062498bddd7673711a5412121e4bed26b758d2..772b2c17d9bc2ee5560c8d012c97ecddea6234a5 100644 (file)
--- a/src/game/Doom2DF.dpr
+++ b/src/game/Doom2DF.dpr
@@ -24,6 +24,7 @@ program Doom2DF;
 {$ENDIF}
 
 uses
+  conbuf in '../shared/conbuf.pas',
   GL,
   GLExt,
   SDL2 in '../lib/sdl2/sdl2.pas',

diff --git a/src/game/g_console.pas b/src/game/g_console.pas
index 72503f28f5695686087b8d6f5f74bb6f654e172a..aa5713030ed50452c92a87ddeb73d5d468c0a72a 100644 (file)
--- a/src/game/g_console.pas
+++ b/src/game/g_console.pas
@@ -29,7 +29,7 @@ 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;
+  g_menu, g_language, g_net, g_netmsg, e_log, conbuf;
 
 type
   TCmdProc = procedure (P: SArray);
@@ -60,13 +60,13 @@ var
   Cons_Shown: Boolean; // Ðèñîâàòü ëè êîíñîëü?
   Line: String;
   CPos: Word;
-  ConsoleHistory: SArray;
+  //ConsoleHistory: SArray;
   CommandHistory: SArray;
   Whitelist: SArray;
   Commands: Array of TCommand;
   Aliases: Array of TAlias;
   CmdIndex: Word;
-  Offset: Word;
+  conSkipLines: Integer = 0;
   MsgArray: Array [0..4] of record
                               Msg: String;
                               Time: Word;
@@ -114,7 +114,9 @@ begin
 
   if Cmd = 'clear' then
   begin
-    ConsoleHistory := nil;
+    //ConsoleHistory := nil;
+    cbufClear();
+    conSkipLines := 0;
 
     for a := 0 to High(MsgArray) do
       with MsgArray[a] do
@@ -167,6 +169,7 @@ begin
 
   if Cmd = 'dump' then
   begin
+    (*
     if ConsoleHistory <> nil then
     begin
       if Length(P) > 1 then
@@ -191,6 +194,7 @@ begin
       g_Console_Add(Format(_lc[I_CONSOLE_DUMPED], [s]));
       {$I+}
     end;
+    *)
   end;
 
   if Cmd = 'exec' then
@@ -538,11 +542,67 @@ begin
   end;
 end;
 
+
+procedure drawConsoleText ();
+var
+  CWidth, CHeight: Byte;
+  ty: Integer;
+  sp, ep: LongWord;
+  skip: Integer;
+
+  procedure putLine (sp, ep: LongWord);
+  var
+    p: LongWord;
+    wdt, cw: Integer;
+  begin
+    p := sp;
+    wdt := 0;
+    while p <> ep do
+    begin
+      cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
+      if wdt+cw > gScreenWidth-8 then break;
+      //e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
+      Inc(wdt, cw);
+      cbufNext(p);
+    end;
+    if p <> ep then putLine(p, ep); // do rest of the line first
+    // now print our part
+    if skip = 0 then
+    begin
+      ep := p;
+      p := sp;
+      wdt := 2;
+      while p <> ep do
+      begin
+        cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
+        e_TextureFontPrintCharEx(wdt, ty, cbufAt(p), gStdFont);
+        Inc(wdt, cw);
+        cbufNext(p);
+      end;
+      Dec(ty, CHeight);
+    end
+    else
+    begin
+      Dec(skip);
+    end;
+  end;
+
+begin
+  e_TextureFontGetSize(gStdFont, CWidth, CHeight);
+  ty := (gScreenHeight div 2)-4-2*CHeight-Abs(Cons_Y);
+  skip := conSkipLines;
+  cbufLastLine(sp, ep);
+  repeat
+    putLine(sp, ep);
+    if ty+CHeight <= 0 then break;
+  until not cbufLineUp(sp, ep);
+end;
+
 procedure g_Console_Draw();
 var
   CWidth, CHeight: Byte;
   mfW, mfH: Word;
-  a, b, c, d: Integer;
+  a, b: Integer;
 begin
   e_TextureFontGetSize(gStdFont, CWidth, CHeight);
 
@@ -585,6 +645,8 @@ begin
   e_DrawSize(ID, 0, Cons_Y, Alpha, False, False, gScreenWidth, gScreenHeight div 2);
   e_TextureFontPrint(0, Cons_Y+(gScreenHeight div 2)-CHeight-4, '> '+Line, gStdFont);
 
+  drawConsoleText();
+  (*
   if ConsoleHistory <> nil then
   begin
     b := 0;
@@ -603,6 +665,7 @@ begin
       c := c + 1;
     end;
   end;
+  *)
 
   e_TextureFontPrint((CPos+1)*CWidth, Cons_Y+(gScreenHeight div 2)-21, '_', gStdFont);
 end;
@@ -742,11 +805,9 @@ begin
           Cpos := Length(Line) + 1;
         end;
     IK_PAGEUP, IK_KPPAGEUP: // PgUp
-      if not gChatShow then
-        IncMax(OffSet, Length(ConsoleHistory)-1);
+      if not gChatShow then Inc(conSkipLines);
     IK_PAGEDN, IK_KPPAGEDN: // PgDown
-      if not gChatShow then
-        DecMin(OffSet, 0);
+      if not gChatShow and (conSkipLines > 0) then Dec(conSkipLines);
     IK_HOME, IK_KPHOME:
       CPos := 1;
     IK_END, IK_KPEND:
@@ -798,19 +859,25 @@ begin
 end;
 
 procedure g_Console_Add(L: String; Show: Boolean = False);
-var
-  a: Integer;
+{var
+  a: Integer;}
 begin
   // Âûâîä ñòðîê ñ ïåðåíîñàìè ïî î÷åðåäè
+  {
   while Pos(#10, L) > 0 do
   begin
     g_Console_Add(Copy(L, 1, Pos(#10, L) - 1), Show);
     Delete(L, 1, Pos(#10, L));
   end;
+  }
+
+  //SetLength(ConsoleHistory, Length(ConsoleHistory)+1);
+  //ConsoleHistory[High(ConsoleHistory)] := L;
 
-  SetLength(ConsoleHistory, Length(ConsoleHistory)+1);
-  ConsoleHistory[High(ConsoleHistory)] := L;
+  cbufPut(L);
+  if (length(L) = 0) or ((L[length(L)] <> #10) and (L[length(L)] <> #13)) then cbufPut(#10);
 
+  (*
   Show := Show and gAllowConsoleMessages;
 
   if Show and gShowMessages then
@@ -837,12 +904,14 @@ begin
 {$IFDEF HEADLESS}
   e_WriteLog('CON: ' + L, MSG_NOTIFY);
 {$ENDIF}
+  *)
 end;
 
 procedure g_Console_Clear();
 begin
-  ConsoleHistory := nil;
-  Offset := 0;
+  //ConsoleHistory := nil;
+  cbufClear();
+  conSkipLines := 0;
 end;
 
 procedure AddToHistory(L: String);

diff --git a/src/shared/conbuf.pas b/src/shared/conbuf.pas
new file mode 100644 (file)
index 0000000..751f39a
--- /dev/null
+++ b/src/shared/conbuf.pas
@@ -0,0 +1,150 @@
+{$MODE OBJFPC}
+unit conbuf;
+
+interface
+
+
+procedure cbufPut (const s: AnsiString);
+procedure cbufPutChars (buf: PChar; count: Integer);
+
+function cbufLastChange (): LongWord;
+
+function cbufWalkStart (): LongWord;
+function cbufWalkEnd (pos: LongWord): LongWord;
+procedure cbufPrev (var pos: LongWord);
+procedure cbufNext (var pos: LongWord);
+
+function cbufAt (const pos: LongWord): Char;
+
+// get last line
+procedure cbufLastLine (var sp: LongWord; var ep: LongWord);
+// move one line up; `sp` and `ep` MUST be valid values from previous call to `cbufLastLine()`
+function cbufLineUp (var sp: LongWord; var ep: LongWord): Boolean;
+
+procedure cbufClear ();
+
+
+implementation
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+//const ConBufSize = 64;
+const ConBufSize = 256*1024;
+
+// each line in buffer ends with '\n'; we don't keep offsets or lengthes, as
+// it's fairly easy to search in buffer, and drawing console is not a common
+// thing, so it doesn't have to be superfast.
+var
+  cbuf: packed array [0..ConBufSize-1] of Char;
+  cbufhead: LongWord = 0;
+  cbuftail: LongWord = 0; // `cbuftail` points *at* last char
+  changeCount: LongWord = 1;
+
+
+function cbufLastChange (): LongWord; begin result := changeCount; end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure cbufPutChars (buf: PChar; count: Integer);
+var
+  np: LongWord;
+  ch, och: Char;
+begin
+  if count > 0 then
+  begin
+    Inc(changeCount);
+    if changeCount = 0 then changeCount := 1;
+    while count > 0 do
+    begin
+      Dec(count);
+      ch := buf^;
+      Inc(buf);
+      np := (cbuftail+1) mod ConBufSize;
+      if np = cbufhead then
+      begin
+        // we have to make some room; delete top line for this
+        while true do
+        begin
+          och := cbuf[cbufhead];
+          cbufhead := (cbufhead+1) mod ConBufSize;
+          if (cbufhead = np) or (och = #10) then break;
+        end;
+      end;
+      cbuf[np] := ch;
+      cbuftail := np;
+    end;
+  end;
+end;
+
+
+procedure cbufPut (const s: AnsiString);
+begin
+  if length(s) > 0 then cbufPutChars(@s[1], length(s));
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+// warning! don't modify conbuf while the range is active!
+function cbufWalkStart (): LongWord; begin result := cbuftail; end;
+function cbufWalkEnd (pos: LongWord): LongWord; begin result := cbufhead; end;
+procedure cbufPrev (var pos: LongWord); begin pos := (pos+ConBufSize-1) mod ConBufSize; end;
+procedure cbufNext (var pos: LongWord); begin pos := (pos+1) mod ConBufSize; end;
+
+function cbufAt (const pos: LongWord): Char; begin result := cbuf[pos mod ConBufSize]; end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure cbufLastLine (var sp: LongWord; var ep: LongWord);
+var
+  pos, pp: LongWord;
+begin
+  if cbufhead = cbuftail then
+  begin
+    sp := cbufhead;
+    ep := cbufhead+1;
+    exit;
+  end;
+  pos := cbuftail;
+  ep := pos;
+  while pos <> cbufhead do
+  begin
+    pp := (pos+ConBufSize-1) mod ConBufSize;
+    if cbuf[pp] = #10 then break;
+    pos := pp;
+  end;
+  sp := pos;
+end;
+
+
+function cbufLineUp (var sp: LongWord; var ep: LongWord): Boolean;
+var
+  pos, pp: LongWord;
+begin
+  if sp = cbufhead then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
+  pos := (sp+ConBufSize-1) mod ConBufSize;
+  if (pos = cbufhead) or (cbuf[pos] <> #10) then begin sp := cbufhead; ep := cbufhead+1; result := false; exit; end;
+  ep := pos;
+  while pos <> cbufhead do
+  begin
+    pp := (pos+ConBufSize-1) mod ConBufSize;
+    if cbuf[pp] = #10 then break;
+    pos := pp;
+  end;
+  sp := pos;
+  result := true;
+end;
+
+
+procedure cbufClear ();
+begin
+  cbuf[0] := #10;
+  cbufhead := 0;
+  cbuftail := 0;
+  Inc(changeCount);
+  if changeCount = 0 then changeCount := 1;
+end;
+
+
+begin
+  cbuf[0] := #10;
+end.