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

Fix cursor artifacts and WM_TIMER starvation during high-speed data

Browse source 
Three fixes:

1. Cursor font mismatch: cursor overlay TextOut used the default DC
   font instead of FPaintFont (OEM_CHARSET). The wrong font size left
   residual pixels that buffer BitBlt didn't fully cover. Fix: select
   FPaintFont + OPAQUE BkMode into the CS_OWNDC screen DC once in
   RecalcCellSize, and re-assert before cursor TextOut in case VCL
   Paint altered the DC state.

2. WM_TIMER starvation: on Win16, WM_TIMER is lowest-priority and
   never dispatched while WM_COMMNOTIFY floods the queue. Fix: render
   from EndUpdate using GetTickCount throttle (no timer dependency).
   The timer remains as fallback for idle blink and trailing data.

3. Scroll performance: restore deferred ScrollDC at render time (not
   during parsing) so only newly-revealed rows need PaintLine instead
   of all 25. Dirty flags shift with each DoScrollUp to track the
   correct logical line positions after scroll.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
Scott Duensing 2026-02-26 21:40:58 -06:00
parent c565be8489
commit cd55adae4f
1 changed files with 87 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

114
delphi/KPANSI.PAS
View file

@ -63,8 +63,9 @@ type
FStockFont: Boolean;
FBlinkPhase: Integer;
FBlinkCount: Integer;
FRenderPending: Boolean;
FUpdateCount: Integer;
FPendingScroll: Integer;
FLastRenderTick: Longint;
FDirtyRow: array[0..255] of Boolean;
FAllDirty: Boolean;
FBufDC: array[0..1] of HDC;
@ -340,8 +341,9 @@ begin
FStockFont := False;
FBlinkPhase := 0;
FBlinkCount := 0;
FRenderPending := False;
FUpdateCount := 0;
FPendingScroll := 0;
FLastRenderTick := 0;
FAllDirty := True;
FBufDC[0] := 0;
FBufDC[1] := 0;
@ -654,6 +656,7 @@ procedure TKPAnsi.FlipToScreen;
var
DC: HDC;
Row: Integer;
I: Integer;
MinDirty: Integer;
MaxDirty: Integer;
FullBlt: Boolean;
@ -662,6 +665,8 @@ var
Y: Integer;
SrcY: Integer;
H: Integer;
R: TRect;
ScrollY: Integer;
begin
if not HandleAllocated then
Exit;
@ -676,10 +681,29 @@ begin
begin
{ Scrollback view: full redraw from scrollback + screen data }
RedrawBuffers;
FPendingScroll := 0;
FullBlt := True;
end
else
begin
{ Apply deferred scroll to both buffer DCs. ScrollDC here is }
{ safe because all parsing is complete and dirty flags have been }
{ shifted to match the new line positions by DoScrollUp. }
if (FPendingScroll > 0) and not FAllDirty then
begin
R.Left := 0;
R.Top := 0;
R.Right := FBufW;
R.Bottom := FBufH;
ScrollY := FPendingScroll * FCellHeight;
for I := 0 to 1 do
begin
if FBufDC[I] <> 0 then
ScrollDC(FBufDC[I], 0, -ScrollY, R, R, 0, nil);
end;
end;
FPendingScroll := 0;
{ Render only dirty rows into both buffers (batched TextOut) }
MinDirty := FRows;
MaxDirty := -1;
@ -703,7 +727,6 @@ begin
if FullBlt then
begin
{ Full screen BitBlt (scrollback, resize, blink all-dirty) }
BitBlt(DC, 0, 0, FBufW, FBufH,
FBufDC[FBlinkPhase], 0, 0, SRCCOPY);
end
@ -716,12 +739,16 @@ begin
FBufDC[FBlinkPhase], 0, SrcY, SRCCOPY);
end;
{ Cursor overlay -- drawn directly to screen, not in buffers }
{ Cursor overlay -- drawn directly to screen DC. CS_OWNDC keeps }
{ FPaintFont and OPAQUE BkMode set from RecalcCellSize; re-assert }
{ them here in case VCL Paint altered the DC state. }
if FCursorVisible and FBlinkOn and (FScrollPos = 0) and
(FCursorRow >= 0) and (FCursorRow < FRows) and
(FCursorRow < FScreen.Count) and
(FCursorCol >= 0) and (FCursorCol < FCols) then
begin
SelectObject(DC, FPaintFont);
SetBkMode(DC, OPAQUE);
Line := FScreen[FCursorRow];
X := FCursorCol * FCellWidth;
Y := FCursorRow * FCellHeight;
@ -852,13 +879,16 @@ begin
GetMem(Line, SizeOf(TTermLineRec));
AllocLine(Line);
FScreen.Insert(0, Line);
FAllDirty := True;
{ Scroll down is rare; just repaint everything }
FAllDirty := True;
FPendingScroll := 0;
end;
procedure TKPAnsi.DoScrollUp;
var
Line: PTermLine;
I: Integer;
begin
if FScreen.Count < FRows then
Exit;
@ -872,17 +902,41 @@ begin
AllocLine(Line);
FScreen.Add(Line);
UpdateScrollbar;
FAllDirty := True;
Inc(FPendingScroll);
if FPendingScroll >= FRows then
begin
{ Scrolled more than one screen; just repaint everything }
FAllDirty := True;
FPendingScroll := 0;
end
else
begin
{ Shift dirty flags up to match the scrolled line positions }
for I := 1 to FRows - 1 do
FDirtyRow[I - 1] := FDirtyRow[I];
FDirtyRow[FRows - 1] := True;
end;
end;
procedure TKPAnsi.EndUpdate;
var
Now: Longint;
begin
Dec(FUpdateCount);
if FUpdateCount <= 0 then
begin
FUpdateCount := 0;
FRenderPending := True;
{ Render immediately if enough time has elapsed. This avoids }
{ depending on WM_TIMER, which is starved by continuous }
{ WM_COMMNOTIFY messages during high-speed data reception. }
Now := GetTickCount;
if Now - FLastRenderTick >= RenderTickMs then
begin
FLastRenderTick := Now;
FlipToScreen;
end;
end;
end;
@ -1498,7 +1552,8 @@ begin
if FBufDC[0] = 0 then
Exit;
{ Ensure all rows are rendered into buffers }
{ Full repaint: render all rows into buffers }
FPendingScroll := 0;
for Row := 0 to FRows - 1 do
begin
if Row < FScreen.Count then
@ -1511,12 +1566,15 @@ begin
BitBlt(Canvas.Handle, 0, 0, FBufW, FBufH,
FBufDC[FBlinkPhase], 0, 0, SRCCOPY);
{ Cursor overlay }
{ Cursor overlay -- VCL may have selected its own font into the }
{ canvas DC, so re-assert FPaintFont for correct cell dimensions. }
if FCursorVisible and FBlinkOn and (FScrollPos = 0) and
(FCursorRow >= 0) and (FCursorRow < FRows) and
(FCursorRow < FScreen.Count) and
(FCursorCol >= 0) and (FCursorCol < FCols) then
begin
SelectObject(Canvas.Handle, FPaintFont);
SetBkMode(Canvas.Handle, OPAQUE);
Line := FScreen[FCursorRow];
X := FCursorCol * FCellWidth;
Y := FCursorRow * FCellHeight;
@ -1546,7 +1604,13 @@ begin
FBlinkOn := True;
if FUpdateCount = 0 then
FRenderPending := True;
begin
if GetTickCount - FLastRenderTick >= RenderTickMs then
begin
FLastRenderTick := GetTickCount;
FlipToScreen;
end;
end;
end;
@ -1798,9 +1862,8 @@ end;
procedure TKPAnsi.RecalcCellSize;
var
DC: HDC;
OldFont: HFont;
Extent: Longint;
DC: HDC;
Extent: Longint;
begin
if not HandleAllocated then
Exit;
@ -1808,14 +1871,14 @@ begin
{ Recreate the OEM charset paint font from current Font properties }
CreatePaintFont;
{ Measure actual rendered character size with GetTextExtent. }
{ TEXTMETRIC fields can disagree with actual rendering for OEM }
{ raster fonts; GetTextExtent returns the real pixel dimensions. }
{ Measure character size and configure screen DC. CS_OWNDC keeps }
{ these settings across GetDC/ReleaseDC calls, so the font and }
{ BkMode persist for cursor overlay rendering in FlipToScreen. }
DC := GetDC(Handle);
try
OldFont := SelectObject(DC, FPaintFont);
Extent := GetTextExtent(DC, 'W', 1);
SelectObject(DC, OldFont);
SelectObject(DC, FPaintFont);
SetBkMode(DC, OPAQUE);
Extent := GetTextExtent(DC, 'W', 1);
FCellWidth := LoWord(Extent);
FCellHeight := HiWord(Extent);
finally
@ -1982,12 +2045,7 @@ end;
procedure TKPAnsi.WMTimer(var Msg: TWMTimer);
var
NeedFlip: Boolean;
begin
NeedFlip := FRenderPending;
FRenderPending := False;
{ Blink counter: toggle cursor and text blink every BlinkInterval ticks }
Inc(FBlinkCount);
if FBlinkCount >= BlinkInterval then
@ -1997,11 +2055,13 @@ begin
Inc(FBlinkPhase);
if FBlinkPhase > 1 then
FBlinkPhase := 0;
NeedFlip := True;
end;
if NeedFlip then
FlipToScreen;
{ Render pending dirty rows and/or update blink state. This also }
{ catches any data that arrived just before a throttle boundary }
{ in EndUpdate (worst-case latency: one timer tick, ~55 ms). }
FlipToScreen;
FLastRenderTick := GetTickCount;
end;