1 (* Copyright (C) DooM 2D:Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 {$R-}
18 { $DEFINE CBLOG}
21 interface
23 uses
24 SysUtils;
26 type
36 procedure e_WriteLog (TextLine: String; RecordCategory: TRecordCategory; WriteTime: Boolean=True);
40 // start Write/WriteLn driver. it will write everything to cbuf.
43 procedure e_LogWritefln (const fmt: AnsiString; args: array of const; category: TRecordCategory=MSG_NOTIFY; writeTime: Boolean=true);
46 var
50 implementation
52 uses
55 var
62 begin
63 Result := Format('%d.%d.%d.%d', [ip and $FF, (ip shr 8) and $FF, (ip shr 16) and $FF, (ip shr 24)]);
67 procedure e_WriteLog (TextLine: String; RecordCategory: TRecordCategory; WriteTime: Boolean=True);
68 begin
71 (*
72 var
73 LogFile: TextFile;
74 Prefix: ShortString = '';
75 OutStr: String;
76 begin
77 if driverInited and (length(TextLine) > 0) then
78 begin
79 case RecordCategory of
80 MSG_FATALERROR: write('FATAL: ');
81 MSG_WARNING: write('WARNING: ');
82 end;
83 writeln(TextLine);
84 end;
86 if FileName = '' then Exit;
88 Assign(LogFile, FileName);
89 try
90 if FileExists(FileName) then
91 Append(LogFile)
92 else
93 Rewrite(LogFile);
94 try
95 if FirstRecord then
96 begin
97 Writeln(LogFile, '--- Log started at '+TimeToStr(Time)+' ---');
98 FirstRecord := False;
99 end;
100 case RecordCategory of
101 MSG_FATALERROR: Prefix := '!!!';
102 MSG_WARNING: Prefix := '! ';
103 MSG_NOTIFY: Prefix := '***';
104 end;
105 if WriteTime then
106 OutStr := '['+TimeToStr(Time)+'] '+Prefix+' '+TextLine
107 else
108 OutStr := Prefix+' '+TextLine;
109 Writeln(LogFile, OutStr);
110 if e_WriteToStdOut then
111 Writeln(OutStr);
112 finally
113 Close(LogFile);
114 end;
115 except // sorry
116 end;
117 end;
118 *)
121 // returns formatted string if `writerCB` is `nil`, empty string otherwise
122 //function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
123 //TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
126 var
130 begin
134 begin
145 var
155 begin
158 begin
166 var
170 begin
174 begin
180 begin
183 // print string
185 begin
192 continue;
194 // process newline
196 begin
198 begin
201 end
202 else
203 begin
215 procedure e_LogWritefln (const fmt: AnsiString; args: array of const; category: TRecordCategory=MSG_NOTIFY; writeTime: Boolean=true);
218 begin
223 begin
225 begin
231 writeln;
237 begin
239 try
243 exit;
248 begin
254 if writeTime then begin xlogPrefix += '['; xlogPrefix += TimeToStr(Time); xlogPrefix += '] '; end;
266 begin
271 //if fopened then CloseFile(xlogFile);
276 begin
281 begin
282 try
292 begin
298 // ////////////////////////////////////////////////////////////////////////// //
299 (* Write/WriteLn driver *)
300 //
301 // control codes:
302 // CR, LF, BS
303 // TAB: tab space = 4
304 //
305 // userData[1]: current x (for tabs)
306 // userData[2]: #13 was eaten, we should skip next #10
307 //
308 type
311 const
317 var
322 begin
326 begin
327 // look for some special char
331 begin
336 {$IFDEF CBLOG}
338 {$ENDIF}
341 begin
347 continue;
349 // process special chars
353 // tab
355 begin
356 {$IFDEF CBLOG}
358 {$ENDIF}
359 repeat
363 continue;
365 // cr, lf
367 begin
368 {$IFDEF CBLOG}
370 {$ENDIF}
372 begin
377 continue;
386 begin
395 var
398 begin
408 begin
413 begin
419 begin
421 begin
424 begin
427 begin
442 begin
443 //e_InitWritelnDriver();