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
34 procedure e_WriteLog (TextLine: String; RecordCategory: TRecordCategory; WriteTime: Boolean=True);
38 // start Write/WriteLn driver. it will write everything to cbuf.
41 procedure e_LogWritefln (const fmt: AnsiString; args: array of const; category: TRecordCategory=MSG_NOTIFY; writeTime: Boolean=true);
44 var
48 implementation
50 uses
53 var
60 begin
61 Result := Format('%d.%d.%d.%d', [ip and $FF, (ip shr 8) and $FF, (ip shr 16) and $FF, (ip shr 24)]);
65 procedure e_WriteLog (TextLine: String; RecordCategory: TRecordCategory; WriteTime: Boolean=True);
66 begin
69 (*
70 var
71 LogFile: TextFile;
72 Prefix: ShortString = '';
73 OutStr: String;
74 begin
75 if driverInited and (length(TextLine) > 0) then
76 begin
77 case RecordCategory of
78 MSG_FATALERROR: write('FATAL: ');
79 MSG_WARNING: write('WARNING: ');
80 end;
81 writeln(TextLine);
82 end;
84 if FileName = '' then Exit;
86 Assign(LogFile, FileName);
87 try
88 if FileExists(FileName) then
89 Append(LogFile)
90 else
91 Rewrite(LogFile);
92 try
93 if FirstRecord then
94 begin
95 Writeln(LogFile, '--- Log started at '+TimeToStr(Time)+' ---');
96 FirstRecord := False;
97 end;
98 case RecordCategory of
99 MSG_FATALERROR: Prefix := '!!!';
100 MSG_WARNING: Prefix := '! ';
101 MSG_NOTIFY: Prefix := '***';
102 end;
103 if WriteTime then
104 OutStr := '['+TimeToStr(Time)+'] '+Prefix+' '+TextLine
105 else
106 OutStr := Prefix+' '+TextLine;
107 Writeln(LogFile, OutStr);
108 if e_WriteToStdOut then
109 Writeln(OutStr);
110 finally
111 Close(LogFile);
112 end;
113 except // sorry
114 end;
115 end;
116 *)
119 // returns formatted string if `writerCB` is `nil`, empty string otherwise
120 //function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
121 //TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
124 var
128 begin
132 begin
143 var
151 var
155 begin
159 begin
165 begin
168 // print string
170 begin
177 continue;
179 // process newline
181 begin
183 begin
186 end
187 else
188 begin
200 procedure e_LogWritefln (const fmt: AnsiString; args: array of const; category: TRecordCategory=MSG_NOTIFY; writeTime: Boolean=true);
203 begin
208 begin
210 begin
216 writeln;
222 begin
224 try
228 exit;
233 begin
239 if writeTime then begin xlogPrefix += '['; xlogPrefix += TimeToStr(Time); xlogPrefix += '] '; end;
250 //if fopened then CloseFile(xlogFile);
255 begin
260 begin
261 try
271 begin
277 // ////////////////////////////////////////////////////////////////////////// //
278 (* Write/WriteLn driver *)
279 //
280 // control codes:
281 // CR, LF, BS
282 // TAB: tab space = 4
283 //
284 // userData[1]: current x (for tabs)
285 // userData[2]: #13 was eaten, we should skip next #10
286 //
287 type
290 const
296 var
301 begin
305 begin
306 // look for some special char
310 begin
315 {$IFDEF CBLOG}
317 {$ENDIF}
320 begin
326 continue;
328 // process special chars
332 // tab
334 begin
335 {$IFDEF CBLOG}
337 {$ENDIF}
338 repeat
342 continue;
344 // cr, lf
346 begin
347 {$IFDEF CBLOG}
349 {$ENDIF}
351 begin
356 continue;
365 begin
374 var
377 begin
387 begin
392 begin
398 begin
400 begin
403 begin
406 begin
421 begin
422 //e_InitWritelnDriver();