X-Git-Url: http://deadsoftware.ru/gitweb?p=d2df-sdl.git;a=blobdiff_plain;f=src%2Fengine%2Fe_log.pas;h=472bd5762544126e0b60850d48eaf5ae6b7d7bac;hp=1a2499060453086ace60781d3c3b85e7fabd995d;hb=25fd929e92f5bc8dcedc5a39385cf6286b9b91c6;hpb=c627fa668286c42469d7d6a4a61cdf50dea38da1

diff --git a/src/engine/e_log.pas b/src/engine/e_log.pas
index 1a24990..472bd57 100644
--- 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.