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

Render ExtTextOut directly to screen DC, eliminating memory DC intermediate

Browse source 
The MemDC + BitBlt approach wrote every pixel twice (ExtTextOut to system
memory, then BitBlt to video memory).  Now ExtTextOut renders directly to
the CS_OWNDC screen DC, letting the display driver write text straight
into the framebuffer via its optimized raster font path.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
Scott Duensing 2026-03-02 19:17:18 -06:00
parent a7780c8030
commit 78753a65d8
1 changed files with 47 additions and 102 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

149
delphi/KPANSI.PAS
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 into a memory DC with color-run batching, then } { Rendering uses ExtTextOut with color-run batching directly to the screen }
{ BitBlt to the screen. The memory bitmap is in native device format, so } { DC (CS_OWNDC retains the selected OEM font across GetDC calls). No }
{ BitBlt is a raw copy with no color conversion. Smart blink tracking } { intermediate bitmap -- the display driver renders text directly into the }
{ dirties only cursor and blink rows instead of the entire screen, } { framebuffer via its optimized raster font path. Smart blink tracking }
{ eliminating wasteful full repaints. } { dirties only cursor and blink rows instead of the entire screen. }
{ } { }
{ Installs to the "KP" palette tab alongside TKPComm. } { Installs to the "KP" palette tab alongside TKPComm. }
@ -103,18 +103,12 @@ type
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 } FTextBlinkOn: Boolean; { Text blink phase: True=visible, False=hidden }
{ Off-screen memory DC for ExtTextOut rendering }
FMemDC: HDC; { Compatible memory DC for off-screen ExtTextOut }
FMemBmp: HBitmap; { Compatible bitmap, one row tall, native format }
FOldBmp: HBitmap; { Previous bitmap in FMemDC for cleanup }
procedure AllocLine(Line: PTermLine); procedure AllocLine(Line: PTermLine);
procedure ClearLine(Line: PTermLine); procedure ClearLine(Line: PTermLine);
procedure CMFontChanged(var Msg: TMessage); message cm_FontChanged; procedure CMFontChanged(var Msg: TMessage); message cm_FontChanged;
procedure CreateMemDC;
procedure CreatePaintFont; procedure CreatePaintFont;
procedure DeleteChars(N: Integer); procedure DeleteChars(N: Integer);
procedure DeleteLines(N: Integer); procedure DeleteLines(N: Integer);
procedure DestroyMemDC;
procedure DirtyAll; procedure DirtyAll;
procedure DirtyBlinkRows; procedure DirtyBlinkRows;
procedure DirtyRow(Row: Integer); procedure DirtyRow(Row: Integer);
@ -134,7 +128,7 @@ type
procedure ParseSGR; procedure ParseSGR;
procedure ProcessChar(Ch: Char); procedure ProcessChar(Ch: Char);
procedure RecalcCellSize; procedure RecalcCellSize;
procedure RenderRow(Row: Integer); procedure RenderRow(DC: HDC; Row: Integer);
procedure ResizeScreen; procedure ResizeScreen;
procedure SetCols(Value: Integer); procedure SetCols(Value: Integer);
procedure SetCursorVisible(Value: Boolean); procedure SetCursorVisible(Value: Boolean);
@ -380,10 +374,6 @@ begin
FAllDirty := True; FAllDirty := True;
FScrollbarDirty := False; FScrollbarDirty := False;
FTextBlinkOn := True; FTextBlinkOn := True;
FMemDC := 0;
FMemBmp := 0;
FOldBmp := 0;
{ 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;
@ -399,28 +389,6 @@ begin
end; end;
procedure TKPAnsi.CreateMemDC;
var
ScrDC: HDC;
begin
DestroyMemDC;
if (FCellWidth < 1) or (FCellHeight < 1) then
Exit;
ScrDC := GetDC(0);
FMemDC := CreateCompatibleDC(ScrDC);
FMemBmp := CreateCompatibleBitmap(ScrDC, FCols * FCellWidth, FCellHeight);
ReleaseDC(0, ScrDC);
if (FMemDC = 0) or (FMemBmp = 0) then
begin
DestroyMemDC;
Exit;
end;
FOldBmp := SelectObject(FMemDC, FMemBmp);
SelectObject(FMemDC, FPaintFont);
SetBkMode(FMemDC, OPAQUE);
end;
procedure TKPAnsi.CreatePaintFont; procedure TKPAnsi.CreatePaintFont;
var var
LF: TLogFont; LF: TLogFont;
@ -529,7 +497,6 @@ end;
destructor TKPAnsi.Destroy; destructor TKPAnsi.Destroy;
begin begin
DestroyMemDC;
if (FPaintFont <> 0) and not FStockFont then if (FPaintFont <> 0) and not FStockFont then
begin begin
DeleteObject(FPaintFont); DeleteObject(FPaintFont);
@ -543,24 +510,6 @@ begin
end; end;
procedure TKPAnsi.DestroyMemDC;
begin
if FMemDC <> 0 then
begin
if FOldBmp <> 0 then
SelectObject(FMemDC, FOldBmp);
DeleteDC(FMemDC);
FMemDC := 0;
FOldBmp := 0;
end;
if FMemBmp <> 0 then
begin
DeleteObject(FMemBmp);
FMemBmp := 0;
end;
end;
procedure TKPAnsi.DirtyAll; procedure TKPAnsi.DirtyAll;
begin begin
FAllDirty := True; FAllDirty := True;
@ -569,7 +518,7 @@ 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 and 25 BitBlt calls), only dirty the } { forces a full 25-row re-render), only dirty the }
{ cursor row (cursor blink) and rows containing blink cells (text blink). } { cursor row (cursor blink) and rows containing blink cells (text blink). }
{ Typical BBS content has 0-3 blink rows, so this reduces blink overhead } { Typical BBS content has 0-3 blink rows, so this reduces blink overhead }
{ from ~63ms to ~3ms on a 486. } { from ~63ms to ~3ms on a 486. }
@ -1096,11 +1045,11 @@ end;
procedure TKPAnsi.FlipToScreen; procedure TKPAnsi.FlipToScreen;
{ Render dirty rows via ExtTextOut into the memory DC, then BitBlt each } { Render dirty rows via ExtTextOut directly to the screen DC. CS_OWNDC }
{ to the screen (device format to device format = raw copy). Coalesced } { retains the selected font across GetDC calls, so no per-frame font }
{ ScrollDC shifts on-screen pixels to match FScreen after scrolling, } { selection overhead. Coalesced ScrollDC shifts on-screen pixels to match }
{ reducing the per-scroll GDI cost from 25 rows to just the newly exposed } { FScreen after scrolling, reducing the per-scroll cost from 25 rows to }
{ rows. } { just the newly exposed rows. }
var var
DC: HDC; DC: HDC;
Row: Integer; Row: Integer;
@ -1112,9 +1061,9 @@ var
begin begin
if not HandleAllocated then if not HandleAllocated then
Exit; Exit;
if FMemDC = 0 then if FPaintFont = 0 then
RecalcCellSize; RecalcCellSize;
if FMemDC = 0 then if FPaintFont = 0 then
Exit; Exit;
{ Scrollback view: force full redraw (line mapping changes) } { Scrollback view: force full redraw (line mapping changes) }
@ -1190,16 +1139,13 @@ begin
Exit; Exit;
end; end;
{ Interleaved render + blast: memory DC is reused per row } { Render dirty rows directly to screen DC }
DC := GetDC(Handle); DC := GetDC(Handle);
for Row := 0 to FRows - 1 do for Row := 0 to FRows - 1 do
begin begin
if FAllDirty or FDirtyRow[Row] then if FAllDirty or FDirtyRow[Row] then
begin begin
RenderRow(Row); RenderRow(DC, Row);
BitBlt(DC, 0, Row * FCellHeight,
FCols * FCellWidth, FCellHeight,
FMemDC, 0, 0, SRCCOPY);
FDirtyRow[Row] := False; FDirtyRow[Row] := False;
end; end;
end; end;
@ -1364,22 +1310,21 @@ end;
procedure TKPAnsi.Paint; procedure TKPAnsi.Paint;
var var
DC: HDC;
Row: Integer; Row: Integer;
begin begin
if FMemDC = 0 then if FPaintFont = 0 then
RecalcCellSize; RecalcCellSize;
if FMemDC = 0 then if FPaintFont = 0 then
Exit; Exit;
{ Full repaint: render each row into the memory DC and blast it } { Full repaint: render each row directly to screen }
FAllDirty := True; FAllDirty := True;
DC := Canvas.Handle;
for Row := 0 to FRows - 1 do for Row := 0 to FRows - 1 do
begin begin
RenderRow(Row); RenderRow(DC, Row);
BitBlt(Canvas.Handle, 0, Row * FCellHeight,
FCols * FCellWidth, FCellHeight,
FMemDC, 0, 0, SRCCOPY);
FDirtyRow[Row] := False; FDirtyRow[Row] := False;
end; end;
FAllDirty := False; FAllDirty := False;
@ -1888,10 +1833,13 @@ begin
{ Recreate the OEM charset paint font from current Font properties } { Recreate the OEM charset paint font from current Font properties }
CreatePaintFont; CreatePaintFont;
{ Measure character cell size } { Measure character cell size and configure the CS_OWNDC. The font and }
{ background mode persist across GetDC/ReleaseDC with CS_OWNDC, so this }
{ is effectively a one-time setup per font change. }
DC := GetDC(Handle); DC := GetDC(Handle);
try try
SelectObject(DC, FPaintFont); SelectObject(DC, FPaintFont);
SetBkMode(DC, OPAQUE);
Extent := GetTextExtent(DC, 'W', 1); Extent := GetTextExtent(DC, 'W', 1);
FCellWidth := LoWord(Extent); FCellWidth := LoWord(Extent);
FCellHeight := HiWord(Extent); FCellHeight := HiWord(Extent);
@ -1908,20 +1856,17 @@ begin
{ Resize control to fit terminal dimensions } { Resize control to fit terminal dimensions }
Width := FCols * FCellWidth + GetSystemMetrics(sm_CxVScroll); Width := FCols * FCellWidth + GetSystemMetrics(sm_CxVScroll);
Height := FRows * FCellHeight; Height := FRows * FCellHeight;
{ Create off-screen memory DC for ExtTextOut rendering }
CreateMemDC;
FAllDirty := True; FAllDirty := True;
Invalidate; Invalidate;
end; end;
procedure TKPAnsi.RenderRow(Row: Integer); procedure TKPAnsi.RenderRow(DC: HDC; Row: Integer);
{ Render one terminal row into FMemDC using ExtTextOut with ETO_OPAQUE. } { Render one terminal row via ExtTextOut directly to the screen DC. }
{ Scans cells for color runs (consecutive cells with same effective FG+BG) } { Scans cells for color runs (consecutive cells with same effective FG+BG) }
{ and emits one ExtTextOut call per run. Typical BBS content = 2-5 runs } { and emits one ExtTextOut call per run. No intermediate bitmap -- the }
{ per row. Uniform color content (e.g. LORD II spaces) = 1 run per row. } { display driver renders text directly into the framebuffer. }
var var
Line: PTermLine; Line: PTermLine;
Col: Integer; Col: Integer;
@ -1937,9 +1882,9 @@ var
RunBuf: array[0..255] of Char; RunBuf: array[0..255] of Char;
RunLen: Integer; RunLen: Integer;
R: TRect; R: TRect;
RowY: Integer;
begin begin
if FMemDC = 0 then RowY := Row * FCellHeight;
Exit;
{ Determine which line to render (handles scrollback view) } { Determine which line to render (handles scrollback view) }
if FScrollPos <> 0 then if FScrollPos <> 0 then
@ -1966,12 +1911,12 @@ begin
if Line = nil then if Line = nil then
begin begin
{ Blank row: fill with black background } { Blank row: fill with black background }
SetBkColor(FMemDC, AnsiColors[0]); SetBkColor(DC, AnsiColors[0]);
R.Left := 0; R.Left := 0;
R.Top := 0; R.Top := RowY;
R.Right := FCols * FCellWidth; R.Right := FCols * FCellWidth;
R.Bottom := FCellHeight; R.Bottom := RowY + FCellHeight;
ExtTextOut(FMemDC, 0, 0, ETO_OPAQUE, @R, nil, 0, nil); ExtTextOut(DC, 0, RowY, ETO_OPAQUE, @R, nil, 0, nil);
Exit; Exit;
end; end;
@ -2009,13 +1954,13 @@ begin
begin begin
if RunLen > 0 then if RunLen > 0 then
begin begin
SetTextColor(FMemDC, AnsiColors[RunFG]); SetTextColor(DC, AnsiColors[RunFG]);
SetBkColor(FMemDC, AnsiColors[RunBG]); SetBkColor(DC, AnsiColors[RunBG]);
R.Left := RunStart * FCellWidth; R.Left := RunStart * FCellWidth;
R.Top := 0; R.Top := RowY;
R.Right := (RunStart + RunLen) * FCellWidth; R.Right := (RunStart + RunLen) * FCellWidth;
R.Bottom := FCellHeight; R.Bottom := RowY + FCellHeight;
ExtTextOut(FMemDC, RunStart * FCellWidth, 0, ETO_OPAQUE, @R, ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R,
@RunBuf[0], RunLen, nil); @RunBuf[0], RunLen, nil);
end; end;
RunStart := Col; RunStart := Col;
@ -2031,13 +1976,13 @@ begin
{ Flush final run } { Flush final run }
if RunLen > 0 then if RunLen > 0 then
begin begin
SetTextColor(FMemDC, AnsiColors[RunFG]); SetTextColor(DC, AnsiColors[RunFG]);
SetBkColor(FMemDC, AnsiColors[RunBG]); SetBkColor(DC, AnsiColors[RunBG]);
R.Left := RunStart * FCellWidth; R.Left := RunStart * FCellWidth;
R.Top := 0; R.Top := RowY;
R.Right := (RunStart + RunLen) * FCellWidth; R.Right := (RunStart + RunLen) * FCellWidth;
R.Bottom := FCellHeight; R.Bottom := RowY + FCellHeight;
ExtTextOut(FMemDC, RunStart * FCellWidth, 0, ETO_OPAQUE, @R, ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R,
@RunBuf[0], RunLen, nil); @RunBuf[0], RunLen, nil);
end; end;
end; end;
@ -2180,7 +2125,7 @@ end;
procedure TKPAnsi.WMEraseBkgnd(var Msg: TWMEraseBkgnd); procedure TKPAnsi.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin begin
{ Suppress background erase -- BitBlt covers everything } { Suppress background erase -- ExtTextOut ETO_OPAQUE covers everything }
Msg.Result := 1; Msg.Result := 1;
end; end;