Render characters immediately during parsing, not in deferred pass

WriteDeferredBuf now acquires a screen DC and renders each character
run via ExtTextOut as it arrives, eliminating the per-row deferred
dirty scan.  FlushPendingScrolls coalesces scroll-ups into a single
ScrollDC call.  FlipToScreen becomes a lightweight blink/fallback pass.

Removed 50ms render throttle from TESTMAIN -- no longer needed since
characters appear on screen as they are parsed.

Simplified: removed ClearLine (duplicate of AllocLine), DirtyAll,
DirtyRow, GetCursorCol/Row (dead code), FTextBlinkOn (always equal
to FBlinkOn), ParseData (inlined), ETO_CLIPPED (unused), redundant
zero-initializations in constructor.  Write and WriteDeferred now
delegate to WriteDeferredBuf.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
Scott Duensing 2026-03-03 16:18:33 -06:00
parent a9e25ec67f
commit 3fc2b410ba
2 changed files with 224 additions and 146 deletions

View file

@ -7,11 +7,11 @@ unit KPAnsi;
{ Renders incoming data using standard ANSI/VT100 escape sequences for } { Renders incoming data using standard ANSI/VT100 escape sequences for }
{ cursor positioning, color attributes, and screen manipulation. } { cursor positioning, color attributes, and screen manipulation. }
{ } { }
{ Rendering uses ExtTextOut with color-run batching directly to the screen } { Immediate-mode rendering: each character run is rendered via ExtTextOut }
{ DC (CS_OWNDC retains the selected OEM font across GetDC calls). No } { directly to the screen DC as it arrives during parsing. WriteDeferredBuf }
{ intermediate bitmap -- the display driver renders text directly into the } { acquires a DC, parses data (rendering inline), and releases. No }
{ framebuffer via its optimized raster font path. Smart blink tracking } { deferred dirty-row pass needed for normal data flow. FlipToScreen only }
{ dirties only cursor and blink rows instead of the entire screen. } { handles blink toggle and fallback paths (scrollback view, WM_PAINT). }
{ } { }
{ Installs to the "KP" palette tab alongside TKPComm. } { Installs to the "KP" palette tab alongside TKPComm. }
@ -101,29 +101,24 @@ type
FDirtyRow: array[0..255] of Boolean; { True = row needs re-render } FDirtyRow: array[0..255] of Boolean; { True = row needs re-render }
FAllDirty: Boolean; { True = all rows need re-render } FAllDirty: Boolean; { True = all rows need re-render }
FScrollbarDirty: Boolean; { True = scrollbar range/position needs update } FScrollbarDirty: Boolean; { True = scrollbar range/position needs update }
FTextBlinkOn: Boolean; { Text blink phase: True=visible, False=hidden } FLiveDC: HDC; { Non-zero during immediate rendering }
procedure AllocLine(Line: PTermLine); procedure AllocLine(Line: PTermLine);
procedure ClearLine(Line: PTermLine);
procedure CMFontChanged(var Msg: TMessage); message cm_FontChanged; procedure CMFontChanged(var Msg: TMessage); message cm_FontChanged;
procedure CreatePaintFont; procedure CreatePaintFont;
procedure DeleteChars(N: Integer); procedure DeleteChars(N: Integer);
procedure DeleteLines(N: Integer); procedure DeleteLines(N: Integer);
procedure DirtyAll;
procedure DirtyBlinkRows; procedure DirtyBlinkRows;
procedure DirtyRow(Row: Integer);
procedure DoScrollDown; procedure DoScrollDown;
procedure DoScrollUp; procedure DoScrollUp;
procedure EraseDisplay(Mode: Integer); procedure EraseDisplay(Mode: Integer);
procedure EraseLine(Mode: Integer); procedure EraseLine(Mode: Integer);
procedure ExecuteCSI(FinalCh: Char); procedure ExecuteCSI(FinalCh: Char);
procedure ExecuteMusic; procedure ExecuteMusic;
procedure FlushPendingScrolls;
procedure FreeLineList(List: TList); procedure FreeLineList(List: TList);
function GetCursorCol: Integer;
function GetCursorRow: Integer;
procedure InsertChars(N: Integer); procedure InsertChars(N: Integer);
procedure InsertLines(N: Integer); procedure InsertLines(N: Integer);
procedure ParseData(const S: string);
procedure ParseDataBuf(Buf: PChar; Len: Integer); procedure ParseDataBuf(Buf: PChar; Len: Integer);
procedure ParseSGR; procedure ParseSGR;
procedure ProcessChar(Ch: Char); procedure ProcessChar(Ch: Char);
@ -154,8 +149,8 @@ type
procedure Write(const S: string); procedure Write(const S: string);
procedure WriteDeferred(const S: string); procedure WriteDeferred(const S: string);
procedure WriteDeferredBuf(Buf: PChar; Len: Integer); procedure WriteDeferredBuf(Buf: PChar; Len: Integer);
property CursorCol: Integer read GetCursorCol; property CursorCol: Integer read FCursorCol;
property CursorRow: Integer read GetCursorRow; property CursorRow: Integer read FCursorRow;
published published
property Cols: Integer read FCols write SetCols default 80; property Cols: Integer read FCols write SetCols default 80;
property Rows: Integer read FRows write SetRows default 25; property Rows: Integer read FRows write SetRows default 25;
@ -199,9 +194,8 @@ const
{ OUT_RASTER_PRECIS may not be defined in Delphi 1.0 WinTypes } { OUT_RASTER_PRECIS may not be defined in Delphi 1.0 WinTypes }
OutRasterPrecis = 6; OutRasterPrecis = 6;
{ ExtTextOut option flags (may not be in Delphi 1.0 WinTypes) } { ExtTextOut option flag (may not be in Delphi 1.0 WinTypes) }
ETO_OPAQUE = $0002; ETO_OPAQUE = $0002;
ETO_CLIPPED = $0004;
{ ANSI music note frequencies (octave 0, multiply by 2^octave) } { ANSI music note frequencies (octave 0, multiply by 2^octave) }
{ C, C#, D, D#, E, F, F#, G, G#, A, A#, B } { C, C#, D, D#, E, F, F#, G, G#, A, A#, B }
@ -308,21 +302,6 @@ begin
end; end;
procedure TKPAnsi.ClearLine(Line: PTermLine);
var
I: Integer;
begin
for I := 0 to FCols - 1 do
begin
Line^.Cells[I].Ch := ' ';
Line^.Cells[I].FG := 7;
Line^.Cells[I].BG := 0;
Line^.Cells[I].Bold := False;
Line^.Cells[I].Blink := False;
end;
end;
procedure TKPAnsi.CMFontChanged(var Msg: TMessage); procedure TKPAnsi.CMFontChanged(var Msg: TMessage);
begin begin
inherited; inherited;
@ -346,34 +325,13 @@ begin
FCursorVisible := True; FCursorVisible := True;
FScreen := TList.Create; FScreen := TList.Create;
FScrollback := TList.Create; FScrollback := TList.Create;
FCursorRow := 0;
FCursorCol := 0;
FLastCursorRow := 0;
FSaveCurRow := 0;
FSaveCurCol := 0;
FAttrFG := 7; FAttrFG := 7;
FAttrBG := 0;
FAttrBold := False;
FAttrBlink := False;
FAttrReverse := False;
FParseState := psNormal;
FParamLen := 0;
FCSIParam1 := 0;
FCSIParam2 := 0;
FCSIParamIdx := 0;
FMusicStr := '';
FCellWidth := 8; FCellWidth := 8;
FCellHeight := 16; FCellHeight := 16;
FBlinkOn := True; FBlinkOn := True;
FLastBlinkTick := GetTickCount; FLastBlinkTick := GetTickCount;
FScrollPos := 0;
FPendingScrolls := 0;
FWrapMode := True; FWrapMode := True;
FPaintFont := 0;
FStockFont := False;
FAllDirty := True; FAllDirty := True;
FScrollbarDirty := False;
FTextBlinkOn := True;
{ Set a monospace font -- OEM charset selected in CreatePaintFont } { Set a monospace font -- OEM charset selected in CreatePaintFont }
Font.Name := 'Terminal'; Font.Name := 'Terminal';
Font.Size := 9; Font.Size := 9;
@ -466,6 +424,12 @@ begin
Line^.Cells[I].Blink := False; Line^.Cells[I].Blink := False;
end; end;
end; end;
if FLiveDC <> 0 then
begin
FlushPendingScrolls;
RenderRow(FLiveDC, FCursorRow);
end
else
FDirtyRow[FCursorRow] := True; FDirtyRow[FCursorRow] := True;
end; end;
@ -490,9 +454,18 @@ begin
FScreen.Add(Line); FScreen.Add(Line);
end; end;
end; end;
if FLiveDC <> 0 then
begin
FlushPendingScrolls;
for J := FCursorRow to FRows - 1 do
RenderRow(FLiveDC, J);
end
else
begin
for J := FCursorRow to FRows - 1 do for J := FCursorRow to FRows - 1 do
FDirtyRow[J] := True; FDirtyRow[J] := True;
end; end;
end;
destructor TKPAnsi.Destroy; destructor TKPAnsi.Destroy;
@ -510,12 +483,6 @@ begin
end; end;
procedure TKPAnsi.DirtyAll;
begin
FAllDirty := True;
end;
procedure TKPAnsi.DirtyBlinkRows; procedure TKPAnsi.DirtyBlinkRows;
{ Targeted dirty marking for blink toggle. Instead of DirtyAll (which } { Targeted dirty marking for blink toggle. Instead of DirtyAll (which }
{ forces a full 25-row re-render), only dirty the } { forces a full 25-row re-render), only dirty the }
@ -554,16 +521,12 @@ begin
end; end;
procedure TKPAnsi.DirtyRow(Row: Integer);
begin
if (Row >= 0) and (Row <= 255) then
FDirtyRow[Row] := True;
end;
procedure TKPAnsi.DoScrollDown; procedure TKPAnsi.DoScrollDown;
var var
Line: PTermLine; Line: PTermLine;
ScrollR: TRect;
ClipR: TRect;
UpdateR: TRect;
begin begin
if FScreen.Count < FRows then if FScreen.Count < FRows then
Exit; Exit;
@ -575,7 +538,18 @@ begin
GetMem(Line, SizeOf(TTermLineRec)); GetMem(Line, SizeOf(TTermLineRec));
AllocLine(Line); AllocLine(Line);
FScreen.Insert(0, Line); FScreen.Insert(0, Line);
{ Scroll down is rare; just repaint everything } if FLiveDC <> 0 then
begin
FlushPendingScrolls;
ScrollR.Left := 0;
ScrollR.Top := 0;
ScrollR.Right := FCols * FCellWidth;
ScrollR.Bottom := FRows * FCellHeight;
ClipR := ScrollR;
ScrollDC(FLiveDC, 0, FCellHeight, ScrollR, ClipR, 0, @UpdateR);
RenderRow(FLiveDC, 0);
end
else
FAllDirty := True; FAllDirty := True;
end; end;
@ -604,8 +578,6 @@ begin
end; end;
procedure TKPAnsi.EraseDisplay(Mode: Integer); procedure TKPAnsi.EraseDisplay(Mode: Integer);
var var
I: Integer; I: Integer;
@ -628,7 +600,7 @@ begin
{ Erase all lines below } { Erase all lines below }
for I := FCursorRow + 1 to FScreen.Count - 1 do for I := FCursorRow + 1 to FScreen.Count - 1 do
begin begin
ClearLine(FScreen[I]); AllocLine(FScreen[I]);
end; end;
end; end;
1: { Erase above: start of screen to current position } 1: { Erase above: start of screen to current position }
@ -636,7 +608,7 @@ begin
{ Erase all lines above } { Erase all lines above }
for I := 0 to FCursorRow - 1 do for I := 0 to FCursorRow - 1 do
begin begin
ClearLine(FScreen[I]); AllocLine(FScreen[I]);
end; end;
{ Erase current line up to and including cursor } { Erase current line up to and including cursor }
Line := FScreen[FCursorRow]; Line := FScreen[FCursorRow];
@ -666,7 +638,24 @@ begin
UpdateScrollbar; UpdateScrollbar;
end; end;
end; end;
{ Mark affected rows dirty for deferred batch rendering } { Immediate render or deferred dirty }
if FLiveDC <> 0 then
begin
FlushPendingScrolls;
case Mode of
0:
for I := FCursorRow to FRows - 1 do
RenderRow(FLiveDC, I);
1:
for I := 0 to FCursorRow do
RenderRow(FLiveDC, I);
2:
for I := 0 to FRows - 1 do
RenderRow(FLiveDC, I);
end;
end
else
begin
case Mode of case Mode of
0: 0:
for I := FCursorRow to FRows - 1 do for I := FCursorRow to FRows - 1 do
@ -678,11 +667,13 @@ begin
FAllDirty := True; FAllDirty := True;
end; end;
end; end;
end;
procedure TKPAnsi.EraseLine(Mode: Integer); procedure TKPAnsi.EraseLine(Mode: Integer);
var var
J: Integer; J: Integer;
R: TRect;
Line: PTermLine; Line: PTermLine;
begin begin
Line := FScreen[FCursorRow]; Line := FScreen[FCursorRow];
@ -710,8 +701,38 @@ begin
end; end;
end; end;
2: { Erase entire line } 2: { Erase entire line }
ClearLine(Line); AllocLine(Line);
end; end;
if FLiveDC <> 0 then
begin
FlushPendingScrolls;
SetBkColor(FLiveDC, AnsiColors[0]);
case Mode of
0:
begin
R.Left := FCursorCol * FCellWidth;
R.Top := FCursorRow * FCellHeight;
R.Right := FCols * FCellWidth;
R.Bottom := R.Top + FCellHeight;
end;
1:
begin
R.Left := 0;
R.Top := FCursorRow * FCellHeight;
R.Right := (FCursorCol + 1) * FCellWidth;
R.Bottom := R.Top + FCellHeight;
end;
2:
begin
R.Left := 0;
R.Top := FCursorRow * FCellHeight;
R.Right := FCols * FCellWidth;
R.Bottom := R.Top + FCellHeight;
end;
end;
ExtTextOut(FLiveDC, R.Left, R.Top, ETO_OPAQUE, @R, nil, 0, nil);
end
else
FDirtyRow[FCursorRow] := True; FDirtyRow[FCursorRow] := True;
end; end;
@ -1044,6 +1065,35 @@ begin
end; end;
procedure TKPAnsi.FlushPendingScrolls;
var
ScrollR: TRect;
ClipR: TRect;
UpdateR: TRect;
Row: Integer;
begin
if (FPendingScrolls = 0) or (FLiveDC = 0) then
Exit;
if FPendingScrolls >= FRows then
begin
for Row := 0 to FRows - 1 do
RenderRow(FLiveDC, Row);
FPendingScrolls := 0;
Exit;
end;
ScrollR.Left := 0;
ScrollR.Top := 0;
ScrollR.Right := FCols * FCellWidth;
ScrollR.Bottom := FRows * FCellHeight;
ClipR := ScrollR;
ScrollDC(FLiveDC, 0, -(FPendingScrolls * FCellHeight),
ScrollR, ClipR, 0, @UpdateR);
for Row := FRows - FPendingScrolls to FRows - 1 do
RenderRow(FLiveDC, Row);
FPendingScrolls := 0;
end;
procedure TKPAnsi.FlipToScreen; procedure TKPAnsi.FlipToScreen;
{ Render dirty rows via ExtTextOut directly to the screen DC. CS_OWNDC } { Render dirty rows via ExtTextOut directly to the screen DC. CS_OWNDC }
{ retains the selected font across GetDC calls, so no per-frame font } { retains the selected font across GetDC calls, so no per-frame font }
@ -1170,18 +1220,6 @@ begin
end; end;
function TKPAnsi.GetCursorCol: Integer;
begin
Result := FCursorCol;
end;
function TKPAnsi.GetCursorRow: Integer;
begin
Result := FCursorRow;
end;
procedure TKPAnsi.InsertChars(N: Integer); procedure TKPAnsi.InsertChars(N: Integer);
var var
Line: PTermLine; Line: PTermLine;
@ -1203,6 +1241,12 @@ begin
Line^.Cells[I].Blink := False; Line^.Cells[I].Blink := False;
end; end;
end; end;
if FLiveDC <> 0 then
begin
FlushPendingScrolls;
RenderRow(FLiveDC, FCursorRow);
end
else
FDirtyRow[FCursorRow] := True; FDirtyRow[FCursorRow] := True;
end; end;
@ -1227,9 +1271,18 @@ begin
AllocLine(Line); AllocLine(Line);
FScreen.Insert(FCursorRow, Line); FScreen.Insert(FCursorRow, Line);
end; end;
if FLiveDC <> 0 then
begin
FlushPendingScrolls;
for J := FCursorRow to FRows - 1 do
RenderRow(FLiveDC, J);
end
else
begin
for J := FCursorRow to FRows - 1 do for J := FCursorRow to FRows - 1 do
FDirtyRow[J] := True; FDirtyRow[J] := True;
end; end;
end;
procedure TKPAnsi.KeyDown(var Key: Word; Shift: TShiftState); procedure TKPAnsi.KeyDown(var Key: Word; Shift: TShiftState);
@ -1314,7 +1367,6 @@ end;
procedure TKPAnsi.Paint; procedure TKPAnsi.Paint;
var var
DC: HDC;
Row: Integer; Row: Integer;
begin begin
if FPaintFont = 0 then if FPaintFont = 0 then
@ -1337,14 +1389,6 @@ begin
end; end;
procedure TKPAnsi.ParseData(const S: string);
{ String wrapper -- delegates to ParseDataBuf for actual processing. }
begin
if Length(S) > 0 then
ParseDataBuf(@S[1], Length(S));
end;
procedure TKPAnsi.ParseDataBuf(Buf: PChar; Len: Integer); procedure TKPAnsi.ParseDataBuf(Buf: PChar; Len: Integer);
{ Process incoming data from a PChar buffer (no string allocation needed). } { Process incoming data from a PChar buffer (no string allocation needed). }
{ } { }
@ -1365,6 +1409,9 @@ var
BGIdx: Byte; BGIdx: Byte;
RunEnd: Integer; RunEnd: Integer;
Remaining: Integer; Remaining: Integer;
RunStartI: Integer;
RunStartCol: Integer;
R: TRect;
begin begin
Line := nil; Line := nil;
I := 0; I := 0;
@ -1411,6 +1458,10 @@ begin
(RunEnd - I < Remaining) do (RunEnd - I < Remaining) do
Inc(RunEnd); Inc(RunEnd);
{ Save run start for immediate rendering }
RunStartI := I;
RunStartCol := FCursorCol;
{ Fill cells in tight loop } { Fill cells in tight loop }
if FAttrReverse then if FAttrReverse then
begin begin
@ -1438,6 +1489,29 @@ begin
Inc(I); Inc(I);
end; end;
end; end;
{ Immediate render or deferred dirty }
if FLiveDC <> 0 then
begin
FlushPendingScrolls;
if FAttrReverse then
begin
SetTextColor(FLiveDC, AnsiColors[BGIdx]);
SetBkColor(FLiveDC, AnsiColors[FGIdx]);
end
else
begin
SetTextColor(FLiveDC, AnsiColors[FGIdx]);
SetBkColor(FLiveDC, AnsiColors[BGIdx]);
end;
R.Left := RunStartCol * FCellWidth;
R.Top := FCursorRow * FCellHeight;
R.Right := FCursorCol * FCellWidth;
R.Bottom := R.Top + FCellHeight;
ExtTextOut(FLiveDC, R.Left, R.Top, ETO_OPAQUE, @R,
@Buf[RunStartI], I - RunStartI, nil);
end
else
FDirtyRow[FCursorRow] := True; FDirtyRow[FCursorRow] := True;
end end
else if Buf[I] = #27 then else if Buf[I] = #27 then
@ -1941,7 +2015,7 @@ begin
for Col := 0 to FCols - 1 do for Col := 0 to FCols - 1 do
begin begin
{ Determine effective colors } { Determine effective colors }
if Line^.Cells[Col].Blink and not FTextBlinkOn then if Line^.Cells[Col].Blink and not FBlinkOn then
FGIdx := Line^.Cells[Col].BG FGIdx := Line^.Cells[Col].BG
else else
FGIdx := Line^.Cells[Col].FG; FGIdx := Line^.Cells[Col].FG;
@ -2151,7 +2225,6 @@ begin
begin begin
FLastBlinkTick := Now; FLastBlinkTick := Now;
FBlinkOn := not FBlinkOn; FBlinkOn := not FBlinkOn;
FTextBlinkOn := not FTextBlinkOn;
DirtyBlinkRows; DirtyBlinkRows;
end; end;
end; end;
@ -2202,7 +2275,7 @@ procedure TKPAnsi.Write(const S: string);
begin begin
if Length(S) > 0 then if Length(S) > 0 then
begin begin
ParseData(S); WriteDeferredBuf(@S[1], Length(S));
FlipToScreen; FlipToScreen;
end; end;
end; end;
@ -2211,14 +2284,28 @@ end;
procedure TKPAnsi.WriteDeferred(const S: string); procedure TKPAnsi.WriteDeferred(const S: string);
begin begin
if Length(S) > 0 then if Length(S) > 0 then
ParseData(S); WriteDeferredBuf(@S[1], Length(S));
end; end;
procedure TKPAnsi.WriteDeferredBuf(Buf: PChar; Len: Integer); procedure TKPAnsi.WriteDeferredBuf(Buf: PChar; Len: Integer);
begin begin
if Len > 0 then if Len > 0 then
begin
if HandleAllocated and (FPaintFont <> 0) and (FScrollPos = 0) then
begin
FLiveDC := GetDC(Handle);
SelectObject(FLiveDC, FPaintFont);
SetBkMode(FLiveDC, OPAQUE);
end;
ParseDataBuf(Buf, Len); ParseDataBuf(Buf, Len);
if FLiveDC <> 0 then
begin
FlushPendingScrolls;
ReleaseDC(Handle, FLiveDC);
FLiveDC := 0;
end;
end;
end; end;

View file

@ -166,19 +166,15 @@ end;
procedure TMainForm.Run; procedure TMainForm.Run;
const const
RenderMs = 50; { Minimum ms between renders during bulk flow (20 fps) }
BufSize = 2048; { Read buffer -- 8x larger than 255-byte string limit } BufSize = 2048; { Read buffer -- 8x larger than 255-byte string limit }
var var
Msg: TMsg; Msg: TMsg;
Buf: array[0..BufSize - 1] of Char; Buf: array[0..BufSize - 1] of Char;
Len: Integer; Len: Integer;
HasData: Boolean; HasData: Boolean;
Now: Longint;
LastRenderTick: Longint;
begin begin
Show; Show;
FDone := False; FDone := False;
LastRenderTick := GetTickCount;
while not FDone do while not FDone do
begin begin
{ Process all pending Windows messages (keyboard, paint, scrollbar) } { Process all pending Windows messages (keyboard, paint, scrollbar) }
@ -196,8 +192,8 @@ begin
if FDone then if FDone then
Break; Break;
{ Drain all available serial data before rendering. Reads up to } { Drain all available serial data. WriteDeferredBuf renders each }
{ 2048 bytes per call, bypassing the 255-byte short string limit. } { character run immediately via ExtTextOut -- no deferred pass. }
{ Messages are checked between chunks so keyboard stays responsive. } { Messages are checked between chunks so keyboard stays responsive. }
HasData := False; HasData := False;
if FComm.PortOpen then if FComm.PortOpen then
@ -225,16 +221,11 @@ begin
if FDone then if FDone then
Break; Break;
{ Render throttle: during bulk data flow, only render every RenderMs } { Blink + dirty-row pass. During normal data flow, WriteDeferredBuf }
{ to decouple parse throughput from GDI overhead. When idle, render } { already rendered inline so FlipToScreen is a no-op. Only blink }
{ immediately for interactive responsiveness. } { toggle (every 500ms) or scrollbar updates produce dirty rows here. }
Now := GetTickCount;
if (not HasData) or (Now - LastRenderTick >= RenderMs) then
begin
FAnsi.TickBlink; FAnsi.TickBlink;
FAnsi.FlipToScreen; FAnsi.FlipToScreen;
LastRenderTick := Now;
end;
{ Yield CPU to other apps when no serial data is flowing. } { Yield CPU to other apps when no serial data is flowing. }
{ PM_NOYIELD keeps message draining fast; Yield here gives other } { PM_NOYIELD keeps message draining fast; Yield here gives other }