diff --git a/delphi/KPANSI.PAS b/delphi/KPANSI.PAS index c2f13f3..c68336f 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 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) } - ETO_OPAQUE = $0002; - ETO_CLIPPED = $0004; + { ExtTextOut option flag (may not be in Delphi 1.0 WinTypes) } + ETO_OPAQUE = $0002; { 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,7 +424,13 @@ begin Line^.Cells[I].Blink := False; end; end; - FDirtyRow[FCursorRow] := True; + 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; - for J := FCursorRow to FRows - 1 do - FDirtyRow[J] := True; + 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; + Line: PTermLine; + ScrollR: TRect; + ClipR: TRect; + UpdateR: TRect; begin if FScreen.Count < FRows then Exit; @@ -575,8 +538,19 @@ begin GetMem(Line, SizeOf(TTermLineRec)); AllocLine(Line); FScreen.Insert(0, Line); - { Scroll down is rare; just repaint everything } - FAllDirty := True; + 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,16 +638,34 @@ begin UpdateScrollbar; end; end; - { Mark affected rows dirty for deferred batch rendering } - case Mode of - 0: - for I := FCursorRow to FRows - 1 do - FDirtyRow[I] := True; - 1: - for I := 0 to FCursorRow do - FDirtyRow[I] := True; - 2: - FAllDirty := True; + { 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 + FDirtyRow[I] := True; + 1: + for I := 0 to FCursorRow do + FDirtyRow[I] := True; + 2: + FAllDirty := True; + end; end; end; @@ -683,6 +673,7 @@ end; procedure TKPAnsi.EraseLine(Mode: Integer); var J: Integer; + R: TRect; Line: PTermLine; begin Line := FScreen[FCursorRow]; @@ -710,9 +701,39 @@ begin end; end; 2: { Erase entire line } - ClearLine(Line); + AllocLine(Line); end; - FDirtyRow[FCursorRow] := True; + 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,7 +1241,13 @@ begin Line^.Cells[I].Blink := False; end; end; - FDirtyRow[FCursorRow] := True; + 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; - for J := FCursorRow to FRows - 1 do - FDirtyRow[J] := True; + 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). } { } @@ -1358,13 +1402,16 @@ procedure TKPAnsi.ParseDataBuf(Buf: PChar; Len: Integer); { } { Does NOT call FlipToScreen -- the caller handles rendering. } var - I: Integer; - Ch: Char; - Line: PTermLine; - FGIdx: Byte; - BGIdx: Byte; - RunEnd: Integer; - Remaining: Integer; + I: Integer; + Ch: Char; + Line: PTermLine; + FGIdx: Byte; + 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,7 +1489,30 @@ begin Inc(I); end; end; - FDirtyRow[FCursorRow] := True; + + { 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 begin @@ -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; diff --git a/delphi/TESTMAIN.PAS b/delphi/TESTMAIN.PAS index fa472cc..05f162c 100644 --- a/delphi/TESTMAIN.PAS +++ b/delphi/TESTMAIN.PAS @@ -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 } + 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; + Msg: TMsg; + Buf: array[0..BufSize - 1] of Char; + Len: Integer; + HasData: Boolean; begin Show; - FDone := False; - LastRenderTick := GetTickCount; + FDone := False; 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 - FAnsi.TickBlink; - FAnsi.FlipToScreen; - LastRenderTick := Now; - end; + { 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; { Yield CPU to other apps when no serial data is flowing. } { PM_NOYIELD keeps message draining fast; Yield here gives other }