From 25fd929e92f5bc8dcedc5a39385cf6286b9b91c6 Mon Sep 17 00:00:00 2001 From: Ketmar Dark Date: Sat, 23 Apr 2016 18:52:56 +0300 Subject: [PATCH] log messages now written to console too --- src/engine/e_graphics.pas | 21 +++++ src/engine/e_log.pas | 191 +++++++++++++++++++++++++++++++++++--- src/game/Doom2DF.dpr | 1 + src/game/g_console.pas | 99 +++++++++++++++++--- src/shared/conbuf.pas | 150 ++++++++++++++++++++++++++++++ 5 files changed, 436 insertions(+), 26 deletions(-) create mode 100644 src/shared/conbuf.pas diff --git a/src/engine/e_graphics.pas b/src/engine/e_graphics.pas index d7bced4..c5a97b9 100644 --- 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 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. diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 1c06249..772b2c1 100644 --- 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 72503f2..aa57130 100644 --- 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 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. -- 2.29.2