AI_Slop/WinComm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Render characters immediately during parsing, not in deferred pass

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

281
delphi/KPANSI.PAS
View file

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

19
delphi/TESTMAIN.PAS
View file

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