diff --git a/delphi/KPANSI.PAS b/delphi/KPANSI.PAS index 1d7f482..3c3970c 100644 --- a/delphi/KPANSI.PAS +++ b/delphi/KPANSI.PAS @@ -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;