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