unit KPAnsi;

{ KPAnsi - ANSI BBS terminal emulation component for Delphi 1.0.           }
{                                                                           }
{ TKPAnsi is a TCustomControl descendant providing a visual ANSI terminal   }
{ display with scrollback buffer, cursor blinking, and ANSI music support.  }
{ Renders incoming data using standard ANSI/VT100 escape sequences for      }
{ cursor positioning, color attributes, and screen manipulation.            }
{                                                                           }
{ Split-phase rendering: WriteDeferredBuf first parses the entire input    }
{ buffer into the cell buffer (pure CPU, no GDI calls), then renders all   }
{ dirty rows in one batch via RenderRow.  Scroll-ups are coalesced into    }
{ a single ScrollDC call.  Separating parsing from rendering keeps the     }
{ parsing loop cache-hot and avoids interleaving GDI kernel transitions    }
{ with CPU work.  FlipToScreen handles blink and fallback paths.           }
{                                                                           }
{ Installs to the "KP" palette tab alongside TKPComm.                      }

interface

uses
  SysUtils, Classes, WinTypes, WinProcs, Messages, Graphics, Controls, Forms;

type
  TKeyDataEvent = procedure(Sender: TObject; const Data: string) of object;

  TParseState = (psNormal, psEscape, psCSI, psCSIQuestion, psMusic);

  TTermCell = record
    Ch:    Char;
    FG:    Byte;    { palette index 0-15 }
    BG:    Byte;    { palette index 0-15 }
    Bold:  Boolean;
    Blink: Boolean;
  end;

  PTermLine = ^TTermLineRec;
  TTermLineRec = record
    Cells: array[0..255] of TTermCell;
  end;

  TKPAnsi = class(TCustomControl)
  private
    { Terminal buffer state }
    FScreen:         TList;      { Active screen lines (FRows PTermLine ptrs) }
    FScrollback:     TList;      { Scrollback history (up to FScrollbackSize) }

    { Cursor position (0-based row/col within the active screen) }
    FCursorRow:      Integer;    { Current row (0 = top) }
    FCursorCol:      Integer;    { Current column (0 = left) }
    FSaveCurRow:     Integer;    { Saved row for SCP/RCP (ESC[s / ESC[u) }
    FSaveCurCol:     Integer;    { Saved column for SCP/RCP }

    { Current text attributes (set by SGR escape sequences) }
    FAttrFG:         Integer;    { Foreground color index 0-7 }
    FAttrBG:         Integer;    { Background color index 0-7 }
    FAttrBold:       Boolean;    { Bold: maps FG to bright (index + 8) }
    FAttrBlink:      Boolean;    { Blink: cell toggles visibility on timer }
    FAttrReverse:    Boolean;    { Reverse video: swap FG/BG at render time }

    { ANSI escape sequence parser state }
    FParseState:     TParseState; { Current parser state machine position }
    FParamBuf:       array[0..31] of Char; { CSI parameter digits/semicolons }
    FParamLen:       Integer;     { Current length of FParamBuf }
    FCSIParam1:      Integer;     { First CSI param, parsed inline during scan }
    FCSIParam2:      Integer;     { Second CSI param, parsed inline during scan }
    FCSIParamIdx:    Integer;     { Which param we're accumulating (0=P1, 1=P2) }
    FMusicStr:       string;      { Accumulated ANSI music string (ESC[M..^N) }

    { Font metrics (measured from OEM charset paint font) }
    FCellWidth:      Integer;    { Character cell width in pixels (typically 8) }
    FCellHeight:     Integer;    { Character cell height in pixels (typ 12-16) }

    { Blink state }
    FBlinkOn:        Boolean;    { Cursor blink phase: True=visible }
    FLastBlinkTick:  Longint;    { GetTickCount value at last blink toggle }

    { Scrollback view }
    FScrollPos:      Integer;    { Lines scrolled back (0=live, >0=viewing history) }
    FPendingScrolls: Integer;    { Scroll-up count pending for ScrollDC coalescing }

    { Terminal modes }
    FWrapMode:       Boolean;    { Auto-wrap at right margin (DEC ?7h/l) }

    { Terminal dimensions }
    FCols:           Integer;    { Number of columns (default 80) }
    FRows:           Integer;    { Number of rows (default 25) }
    FFontSize:       Integer;    { Font point size for OEM terminal font }
    FScrollbackSize: Integer;    { Max scrollback lines to retain (default 500) }

    { Cursor visibility (DEC ?25h/l) }
    FCursorVisible:  Boolean;    { True if cursor is shown }
    FLastCursorRow:  Integer;    { Previous cursor row for ghost cleanup }

    { Events }
    FOnKeyData:      TKeyDataEvent; { Keyboard data callback (keys -> serial) }

    { Paint font }
    FPaintFont:      HFont;     { GDI font handle for OEM_CHARSET rendering }
    FStockFont:      Boolean;   { True if FPaintFont is a stock object (no delete) }

    { Dirty tracking: per-row flags for incremental rendering }
    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 }
    FLiveDC:         HDC;       { Non-zero during render pass in WriteDeferredBuf }

    procedure AllocLine(Line: PTermLine);
    procedure CreatePaintFont;
    procedure DeleteChars(N: Integer);
    procedure DeleteLines(N: Integer);
    procedure DirtyBlinkRows;
    procedure DoScrollDown;
    procedure DoScrollUp;
    procedure EraseDisplay(Mode: Integer);
    procedure EraseLine(Mode: Integer);
    procedure ExecuteCSI(FinalCh: Char);
    procedure ExecuteMusic;
    procedure FlushPendingScrolls;
    procedure FreeLineList(List: TList);
    procedure InsertChars(N: Integer);
    procedure InsertLines(N: Integer);
    procedure ParseDataBuf(Buf: PChar; Len: Integer);
    procedure ParseSGR;
    procedure ProcessChar(Ch: Char);
    procedure RecalcCellSize;
    procedure RenderRow(DC: HDC; Row: Integer);
    procedure ResizeScreen;
    procedure SetCols(Value: Integer);
    procedure SetCursorVisible(Value: Boolean);
    procedure SetFontSize(Value: Integer);
    procedure SetRows(Value: Integer);
    procedure SetScrollbackSize(Value: Integer);
    procedure TrimScrollback;
    procedure UpdateScrollbar;
    procedure WriteDeferred(const S: string);
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message wm_EraseBkgnd;
    procedure WMGetDlgCode(var Msg: TMessage); message wm_GetDlgCode;
    procedure WMVScroll(var Msg: TWMScroll); message wm_VScroll;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    procedure Reset;
    procedure FlipToScreen;
    procedure TickBlink;
    procedure Write(const S: string);
    procedure WriteDeferredBuf(Buf: PChar; Len: Integer);
    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;
    property ScrollbackSize: Integer read FScrollbackSize
      write SetScrollbackSize default 500;
    property CursorVisible: Boolean read FCursorVisible
      write SetCursorVisible default True;
    property FontSize: Integer read FFontSize write SetFontSize default 12;
    property Color default clBlack;
    property OnKeyData: TKeyDataEvent read FOnKeyData write FOnKeyData;
    property TabStop default True;
  end;

procedure Register;

implementation

const
  AnsiColors: array[0..15] of TColor = (
    $00000000,  { 0  Black }
    $00000080,  { 1  Red (low) -- BGR order }
    $00008000,  { 2  Green }
    $00008080,  { 3  Yellow/Brown }
    $00800000,  { 4  Blue }
    $00800080,  { 5  Magenta }
    $00808000,  { 6  Cyan }
    $00C0C0C0,  { 7  White (low) }
    $00808080,  { 8  Dark Gray }
    $000000FF,  { 9  Red (bright) }
    $0000FF00,  { 10 Green (bright) }
    $0000FFFF,  { 11 Yellow (bright) }
    $00FF0000,  { 12 Blue (bright) }
    $00FF00FF,  { 13 Magenta (bright) }
    $00FFFF00,  { 14 Cyan (bright) }
    $00FFFFFF   { 15 White (bright) }
  );

  { Blink toggle interval in milliseconds (cursor + text blink). }
  BlinkMs = 500;


  { 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 }
  BaseNoteFreq: array[0..11] of Word = (
    262, 277, 294, 311, 330, 349, 370, 392, 415, 440, 466, 494
  );


{ ----------------------------------------------------------------------- }
{ Helper: parse semicolon-delimited parameters from char buffer            }
{ Zero-allocation: parses integers directly without Copy or StrToIntDef.   }
{ ----------------------------------------------------------------------- }

procedure ParseParamBuf(Buf: PChar; Len: Integer;
  var Params: array of Integer; var Count: Integer);
var
  I:     Integer;
  Value: Integer;
  InNum: Boolean;
begin
  Count := 0;
  Value := 0;
  InNum := False;
  for I := 0 to Len - 1 do
  begin
    if Buf[I] = ';' then
    begin
      if Count <= High(Params) then
      begin
        if InNum then
          Params[Count] := Value
        else
          Params[Count] := 0;
        Inc(Count);
      end;
      Value := 0;
      InNum := False;
    end
    else if (Buf[I] >= '0') and (Buf[I] <= '9') then
    begin
      Value := Value * 10 + (Ord(Buf[I]) - Ord('0'));
      InNum := True;
    end;
  end;
  { Last value after final semicolon (or entire buffer if no semicolons) }
  if Count <= High(Params) then
  begin
    if InNum then
      Params[Count] := Value
    else
      Params[Count] := 0;
    Inc(Count);
  end;
end;


{ ----------------------------------------------------------------------- }
{ TKPAnsi                                                                   }
{ ----------------------------------------------------------------------- }

procedure TKPAnsi.AllocLine(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.Clear;
var
  I:    Integer;
  Line: PTermLine;
begin
  { Move current screen lines to scrollback }
  for I := 0 to FScreen.Count - 1 do
  begin
    FScrollback.Add(FScreen[I]);
  end;
  FScreen.Clear;

  TrimScrollback;

  { Allocate fresh screen lines }
  for I := 0 to FRows - 1 do
  begin
    GetMem(Line, SizeOf(TTermLineRec));
    AllocLine(Line);
    FScreen.Add(Line);
  end;

  FCursorRow := 0;
  FCursorCol := 0;
  FScrollPos := 0;
  UpdateScrollbar;
  FAllDirty := True;
  Invalidate;
end;



constructor TKPAnsi.Create(AOwner: TComponent);
var
  I:    Integer;
  Line: PTermLine;
begin
  inherited Create(AOwner);
  Width            := 660;
  Height           := 450;
  Color            := clBlack;
  TabStop          := True;
  FCols            := 80;
  FRows            := 25;
  FScrollbackSize  := 500;
  FCursorVisible   := True;
  FScreen          := TList.Create;
  FScrollback      := TList.Create;
  FAttrFG          := 7;
  FCellWidth       := 8;
  FCellHeight      := 18;
  FFontSize        := 12;
  FBlinkOn         := True;
  FLastBlinkTick   := GetTickCount;
  FWrapMode        := True;
  FAllDirty        := True;

  { Allocate initial screen lines }
  for I := 0 to FRows - 1 do
  begin
    GetMem(Line, SizeOf(TTermLineRec));
    AllocLine(Line);
    FScreen.Add(Line);
  end;
end;


procedure TKPAnsi.CreatePaintFont;
var
  LF:       TLogFont;
  ActualLF: TLogFont;
  NewFont:  HFont;
  BaseH:    Integer;
  Delta:    Integer;
begin
  { Free previous font (stock fonts must not be deleted) }
  if (FPaintFont <> 0) and not FStockFont then
    DeleteObject(FPaintFont);
  FPaintFont := 0;
  FStockFont := False;

  FillChar(LF, SizeOf(LF), 0);
  LF.lfWeight         := FW_NORMAL;
  LF.lfPitchAndFamily := FIXED_PITCH or FF_MODERN;
  BaseH := MulDiv(FFontSize, Screen.PixelsPerInch, 72);

  { Try Terminal raster at the exact requested size first.  Terminal is   }
  { pixel-perfect but only available at specific cell heights.            }
  LF.lfCharSet := OEM_CHARSET;
  LF.lfHeight  := BaseH;
  StrPCopy(LF.lfFaceName, 'Terminal');
  NewFont := CreateFontIndirect(LF);
  if NewFont <> 0 then
  begin
    GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
    if (ActualLF.lfCharSet = OEM_CHARSET) and
       (ActualLF.lfHeight = BaseH) then
      FPaintFont := NewFont
    else
      DeleteObject(NewFont);
  end;

  { If Terminal doesn't have the exact size, try Perfect DOS VGA 437.    }
  { This TrueType CP437 font renders pixel-perfectly at cell height      }
  { multiples of 8 (8, 16, 24, 32...).  Install via Control Panel >     }
  { Fonts before use.  Request with DEFAULT_CHARSET so Win 3.1 doesn't  }
  { reject the TrueType font in favor of a raster OEM substitute.       }
  if (FPaintFont = 0) and (BaseH >= 8) and (BaseH mod 8 = 0) then
  begin
    LF.lfCharSet := DEFAULT_CHARSET;
    LF.lfHeight  := BaseH;
    StrPCopy(LF.lfFaceName, 'Perfect DOS VGA 437');
    NewFont := CreateFontIndirect(LF);
    if NewFont <> 0 then
    begin
      GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
      if StrIComp(ActualLF.lfFaceName, LF.lfFaceName) = 0 then
        FPaintFont := NewFont
      else
        DeleteObject(NewFont);
    end;
  end;

  { Fall back to Terminal raster at the nearest available size.  Search  }
  { outward from the requested size (up then down).                      }
  if FPaintFont = 0 then
  begin
    LF.lfCharSet := OEM_CHARSET;
    StrPCopy(LF.lfFaceName, 'Terminal');
    for Delta := 1 to 12 do
    begin
      LF.lfHeight := BaseH + Delta;
      NewFont := CreateFontIndirect(LF);
      if NewFont <> 0 then
      begin
        GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
        if (ActualLF.lfCharSet = OEM_CHARSET) and
           (ActualLF.lfHeight = BaseH + Delta) then
        begin
          FPaintFont := NewFont;
          Break;
        end;
        DeleteObject(NewFont);
      end;
      if (FPaintFont = 0) and (BaseH - Delta >= 4) then
      begin
        LF.lfHeight := BaseH - Delta;
        NewFont := CreateFontIndirect(LF);
        if NewFont <> 0 then
        begin
          GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
          if (ActualLF.lfCharSet = OEM_CHARSET) and
             (ActualLF.lfHeight = BaseH - Delta) then
          begin
            FPaintFont := NewFont;
            Break;
          end;
          DeleteObject(NewFont);
        end;
      end;
    end;
  end;

  { Last resort: stock OEM font }
  if FPaintFont = 0 then
  begin
    FPaintFont := GetStockObject(OEM_FIXED_FONT);
    FStockFont := True;
  end;
end;


procedure TKPAnsi.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ws_VScroll;
  { CS_OWNDC gives us a private DC cached across GetDC/ReleaseDC calls,  }
  { avoiding DC allocation overhead on each FlipToScreen render pass.     }
  Params.WindowClass.Style := Params.WindowClass.Style or cs_OwnDC;
end;


procedure TKPAnsi.CreateWnd;
begin
  inherited CreateWnd;
  RecalcCellSize;
end;


procedure TKPAnsi.DeleteChars(N: Integer);
var
  Line: PTermLine;
  I:    Integer;
begin
  if N < 1 then
    N := 1;
  Line := FScreen[FCursorRow];
  for I := FCursorCol to FCols - 1 - N do
    Line^.Cells[I] := Line^.Cells[I + N];
  for I := FCols - N to FCols - 1 do
  begin
    if I >= 0 then
    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;
  FDirtyRow[FCursorRow] := True;
end;


procedure TKPAnsi.DeleteLines(N: Integer);
var
  I:    Integer;
  J:    Integer;
  Line: PTermLine;
begin
  if N < 1 then
    N := 1;
  for I := 1 to N do
  begin
    if FCursorRow < FScreen.Count then
    begin
      Line := FScreen[FCursorRow];
      FreeMem(Line, SizeOf(TTermLineRec));
      FScreen.Delete(FCursorRow);
      GetMem(Line, SizeOf(TTermLineRec));
      AllocLine(Line);
      FScreen.Add(Line);
    end;
  end;
  for J := FCursorRow to FRows - 1 do
    FDirtyRow[J] := True;
end;


destructor TKPAnsi.Destroy;
begin
  if (FPaintFont <> 0) and not FStockFont then
  begin
    DeleteObject(FPaintFont);
    FPaintFont := 0;
  end;
  FreeLineList(FScreen);
  FScreen.Free;
  FreeLineList(FScrollback);
  FScrollback.Free;
  inherited Destroy;
end;


procedure TKPAnsi.DirtyBlinkRows;
{ Targeted dirty marking for blink toggle.  Instead of DirtyAll (which    }
{ 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.                                           }
var
  I:    Integer;
  J:    Integer;
  Line: PTermLine;
begin
  { In scrollback view, FlipToScreen sets FAllDirty anyway }
  if FAllDirty or (FScrollPos <> 0) then
    Exit;

  { Dirty cursor row for cursor blink }
  if FCursorVisible and (FCursorRow >= 0) and (FCursorRow < FRows) then
    FDirtyRow[FCursorRow] := True;

  { Dirty rows containing blink cells for text blink }
  for I := 0 to FRows - 1 do
  begin
    if not FDirtyRow[I] and (I < FScreen.Count) then
    begin
      Line := FScreen[I];
      for J := 0 to FCols - 1 do
      begin
        if Line^.Cells[J].Blink then
        begin
          FDirtyRow[I] := True;
          Break;
        end;
      end;
    end;
  end;
end;


procedure TKPAnsi.DoScrollDown;
var
  Line: PTermLine;
begin
  if FScreen.Count < FRows then
    Exit;
  { Remove bottom line }
  Line := FScreen[FScreen.Count - 1];
  FreeMem(Line, SizeOf(TTermLineRec));
  FScreen.Delete(FScreen.Count - 1);
  { Insert blank line at top }
  GetMem(Line, SizeOf(TTermLineRec));
  AllocLine(Line);
  FScreen.Insert(0, Line);
  FAllDirty := True;
end;


procedure TKPAnsi.DoScrollUp;
var
  Line: PTermLine;
begin
  if FScreen.Count < FRows then
    Exit;
  { Move top line to scrollback }
  Line := FScreen[0];
  FScrollback.Add(Line);
  FScreen.Delete(0);
  { TrimScrollback deferred to ParseData for batching }
  { Add blank line at bottom }
  GetMem(Line, SizeOf(TTermLineRec));
  AllocLine(Line);
  FScreen.Add(Line);
  FScrollbarDirty := True;

  { Track pending scrolls for coalesced ScrollDC in FlipToScreen.       }
  { Multiple scrolls during one ParseData call collapse into a single   }
  { ScrollDC call, then only the newly exposed bottom rows are rendered.}
  Inc(FPendingScrolls);
end;


procedure TKPAnsi.EraseDisplay(Mode: Integer);
var
  I:    Integer;
  J:    Integer;
  Line: PTermLine;
begin
  case Mode of
    0: { Erase below: current position to end of screen }
      begin
        { Erase rest of current line }
        Line := FScreen[FCursorRow];
        for J := FCursorCol to FCols - 1 do
        begin
          Line^.Cells[J].Ch    := ' ';
          Line^.Cells[J].FG    := 7;
          Line^.Cells[J].BG    := 0;
          Line^.Cells[J].Bold  := False;
          Line^.Cells[J].Blink := False;
        end;
        { Erase all lines below }
        for I := FCursorRow + 1 to FScreen.Count - 1 do
        begin
          AllocLine(FScreen[I]);
        end;
      end;
    1: { Erase above: start of screen to current position }
      begin
        { Erase all lines above }
        for I := 0 to FCursorRow - 1 do
        begin
          AllocLine(FScreen[I]);
        end;
        { Erase current line up to and including cursor }
        Line := FScreen[FCursorRow];
        for J := 0 to FCursorCol do
        begin
          Line^.Cells[J].Ch    := ' ';
          Line^.Cells[J].FG    := 7;
          Line^.Cells[J].BG    := 0;
          Line^.Cells[J].Bold  := False;
          Line^.Cells[J].Blink := False;
        end;
      end;
    2: { Erase all: move screen to scrollback, allocate fresh }
      begin
        for I := 0 to FScreen.Count - 1 do
        begin
          FScrollback.Add(FScreen[I]);
        end;
        FScreen.Clear;
        TrimScrollback;
        for I := 0 to FRows - 1 do
        begin
          GetMem(Line, SizeOf(TTermLineRec));
          AllocLine(Line);
          FScreen.Add(Line);
        end;
        UpdateScrollbar;
      end;
  end;
  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;


procedure TKPAnsi.EraseLine(Mode: Integer);
var
  J:    Integer;
  Line: PTermLine;
begin
  Line := FScreen[FCursorRow];
  case Mode of
    0: { Erase from cursor to end of line }
      begin
        for J := FCursorCol to FCols - 1 do
        begin
          Line^.Cells[J].Ch    := ' ';
          Line^.Cells[J].FG    := 7;
          Line^.Cells[J].BG    := 0;
          Line^.Cells[J].Bold  := False;
          Line^.Cells[J].Blink := False;
        end;
      end;
    1: { Erase from start of line to cursor }
      begin
        for J := 0 to FCursorCol do
        begin
          Line^.Cells[J].Ch    := ' ';
          Line^.Cells[J].FG    := 7;
          Line^.Cells[J].BG    := 0;
          Line^.Cells[J].Bold  := False;
          Line^.Cells[J].Blink := False;
        end;
      end;
    2: { Erase entire line }
      AllocLine(Line);
  end;
  FDirtyRow[FCursorRow] := True;
end;


procedure TKPAnsi.ExecuteCSI(FinalCh: Char);
{ Uses FCSIParam1/FCSIParam2 parsed inline during CSI scan-ahead.            }
{ No ParseParamBuf call needed -- saves ~200 cycles per CSI sequence.        }
{ ParseSGR still uses FParamBuf for variable-count parameters.               }
var
  P1: Integer;
  P2: Integer;
begin
  P1 := FCSIParam1;
  P2 := FCSIParam2;

  case FinalCh of
    'A': { CUU - Cursor Up }
      begin
        if P1 < 1 then
          P1 := 1;
        FCursorRow := FCursorRow - P1;
        if FCursorRow < 0 then
          FCursorRow := 0;
      end;
    'B': { CUD - Cursor Down }
      begin
        if P1 < 1 then
          P1 := 1;
        FCursorRow := FCursorRow + P1;
        if FCursorRow >= FRows then
          FCursorRow := FRows - 1;
      end;
    'C': { CUF - Cursor Forward }
      begin
        if P1 < 1 then
          P1 := 1;
        FCursorCol := FCursorCol + P1;
        if FCursorCol >= FCols then
          FCursorCol := FCols - 1;
      end;
    'D': { CUB - Cursor Back }
      begin
        if P1 < 1 then
          P1 := 1;
        FCursorCol := FCursorCol - P1;
        if FCursorCol < 0 then
          FCursorCol := 0;
      end;
    'H', 'f': { CUP/HVP - Cursor Position (1-based params) }
      begin
        if P1 < 1 then
          P1 := 1;
        if P2 < 1 then
          P2 := 1;
        FCursorRow := P1 - 1;
        FCursorCol := P2 - 1;
        if FCursorRow >= FRows then
          FCursorRow := FRows - 1;
        if FCursorCol >= FCols then
          FCursorCol := FCols - 1;
      end;
    'J': { ED - Erase Display }
      begin
        EraseDisplay(P1);
      end;
    'K': { EL - Erase Line }
      begin
        EraseLine(P1);
      end;
    'L': { IL - Insert Lines }
      begin
        InsertLines(P1);
      end;
    'M': { DL - Delete Lines }
      begin
        DeleteLines(P1);
      end;
    'P': { DCH - Delete Characters }
      begin
        DeleteChars(P1);
      end;
    'S': { SU - Scroll Up }
      begin
        if P1 < 1 then
          P1 := 1;
        while P1 > 0 do
        begin
          DoScrollUp;
          Dec(P1);
        end;
      end;
    'T': { SD - Scroll Down }
      begin
        if P1 < 1 then
          P1 := 1;
        while P1 > 0 do
        begin
          DoScrollDown;
          Dec(P1);
        end;
      end;
    '@': { ICH - Insert Characters }
      begin
        InsertChars(P1);
      end;
    'm': { SGR - Set Graphic Rendition }
      begin
        ParseSGR;
      end;
    's': { SCP - Save Cursor Position }
      begin
        FSaveCurRow := FCursorRow;
        FSaveCurCol := FCursorCol;
      end;
    'c': { DA - Device Attributes }
      begin
        { Respond as VT100 with no options }
        if Assigned(FOnKeyData) then
          FOnKeyData(Self, #27'[?1;0c');
      end;
    'n': { DSR - Device Status Report }
      begin
        if P1 = 5 then
        begin
          { Terminal status: report OK }
          if Assigned(FOnKeyData) then
            FOnKeyData(Self, #27'[0n');
        end
        else if P1 = 6 then
        begin
          { Cursor Position Report: respond with ESC[row;colR (1-based) }
          if Assigned(FOnKeyData) then
            FOnKeyData(Self, #27'[' + IntToStr(FCursorRow + 1) + ';' +
              IntToStr(FCursorCol + 1) + 'R');
        end;
      end;
    'u': { RCP - Restore Cursor Position }
      begin
        FCursorRow := FSaveCurRow;
        FCursorCol := FSaveCurCol;
        if FCursorRow >= FRows then
          FCursorRow := FRows - 1;
        if FCursorCol >= FCols then
          FCursorCol := FCols - 1;
      end;
  end;
end;


procedure TKPAnsi.ExecuteMusic;
var
  Tempo:      Integer;
  DefLen:     Integer;
  Octave:     Integer;
  I:          Integer;
  Ch:         Char;
  NoteIdx:    Integer;
  Duration:   Integer;
  Dotted:     Boolean;
  NoteDurMs:  Integer;
  Freq:       Integer;
  OctMul:     Integer;
  J:          Integer;
  NumStr:     string;
begin
  if Length(FMusicStr) = 0 then
    Exit;

  Tempo  := 120;
  DefLen := 4;
  Octave := 4;

  { Open sound device }
  OpenSound;

  I := 1;
  while I <= Length(FMusicStr) do
  begin
    Ch := UpCase(FMusicStr[I]);
    Inc(I);

    case Ch of
      'T': { Tempo }
        begin
          NumStr := '';
          while (I <= Length(FMusicStr)) and
                (FMusicStr[I] >= '0') and (FMusicStr[I] <= '9') do
          begin
            NumStr := NumStr + FMusicStr[I];
            Inc(I);
          end;
          if Length(NumStr) > 0 then
            Tempo := StrToIntDef(NumStr, 120);
          if Tempo < 32 then
            Tempo := 32;
          if Tempo > 255 then
            Tempo := 255;
        end;
      'L': { Default length }
        begin
          NumStr := '';
          while (I <= Length(FMusicStr)) and
                (FMusicStr[I] >= '0') and (FMusicStr[I] <= '9') do
          begin
            NumStr := NumStr + FMusicStr[I];
            Inc(I);
          end;
          if Length(NumStr) > 0 then
            DefLen := StrToIntDef(NumStr, 4);
          if DefLen < 1 then
            DefLen := 1;
        end;
      'O': { Octave }
        begin
          NumStr := '';
          while (I <= Length(FMusicStr)) and
                (FMusicStr[I] >= '0') and (FMusicStr[I] <= '9') do
          begin
            NumStr := NumStr + FMusicStr[I];
            Inc(I);
          end;
          if Length(NumStr) > 0 then
            Octave := StrToIntDef(NumStr, 4);
          if Octave < 0 then
            Octave := 0;
          if Octave > 7 then
            Octave := 7;
        end;
      '>': { Octave up }
        begin
          if Octave < 7 then
            Inc(Octave);
        end;
      '<': { Octave down }
        begin
          if Octave > 0 then
            Dec(Octave);
        end;
      'A'..'G': { Note }
        begin
          { Map note letter to semitone index: C=0 D=2 E=4 F=5 G=7 A=9 B=11 }
          case Ch of
            'C': NoteIdx := 0;
            'D': NoteIdx := 2;
            'E': NoteIdx := 4;
            'F': NoteIdx := 5;
            'G': NoteIdx := 7;
            'A': NoteIdx := 9;
            'B': NoteIdx := 11;
            else NoteIdx := 0;
          end;
          { Check for sharp/flat }
          if I <= Length(FMusicStr) then
          begin
            if (FMusicStr[I] = '#') or (FMusicStr[I] = '+') then
            begin
              Inc(NoteIdx);
              if NoteIdx > 11 then
                NoteIdx := 11;
              Inc(I);
            end
            else if FMusicStr[I] = '-' then
            begin
              Dec(NoteIdx);
              if NoteIdx < 0 then
                NoteIdx := 0;
              Inc(I);
            end;
          end;
          { Parse optional duration }
          Duration := 0;
          NumStr := '';
          while (I <= Length(FMusicStr)) and
                (FMusicStr[I] >= '0') and (FMusicStr[I] <= '9') do
          begin
            NumStr := NumStr + FMusicStr[I];
            Inc(I);
          end;
          if Length(NumStr) > 0 then
            Duration := StrToIntDef(NumStr, 0);
          if Duration < 1 then
            Duration := DefLen;
          { Check for dot }
          Dotted := False;
          if (I <= Length(FMusicStr)) and (FMusicStr[I] = '.') then
          begin
            Dotted := True;
            Inc(I);
          end;
          { Calculate duration in ms: whole note = 4 beats, beat = 60000/tempo ms }
          NoteDurMs := (4 * 60000) div (Tempo * Duration);
          if Dotted then
            NoteDurMs := (NoteDurMs * 3) div 2;
          { Calculate frequency }
          Freq := BaseNoteFreq[NoteIdx];
          OctMul := 1;
          for J := 1 to Octave do
          begin
            OctMul := OctMul * 2;
          end;
          Freq := (Freq * OctMul) div 16;  { BaseNoteFreq is at octave 4 }
          { Queue the note }
          SetVoiceAccent(1, Tempo, 128, 0, 0);
          SetVoiceNote(1, Freq, Duration, 0);
        end;
      'P': { Pause/Rest }
        begin
          Duration := 0;
          NumStr := '';
          while (I <= Length(FMusicStr)) and
                (FMusicStr[I] >= '0') and (FMusicStr[I] <= '9') do
          begin
            NumStr := NumStr + FMusicStr[I];
            Inc(I);
          end;
          if Length(NumStr) > 0 then
            Duration := StrToIntDef(NumStr, 0);
          if Duration < 1 then
            Duration := DefLen;
          { Dotted rest }
          if (I <= Length(FMusicStr)) and (FMusicStr[I] = '.') then
            Inc(I);
          SetVoiceNote(1, 0, Duration, 0);
        end;
    end;
  end;

  StartSound;
  CloseSound;
end;


procedure TKPAnsi.FlushPendingScrolls;
var
  ScrollR:  TRect;
  ClipR:    TRect;
  UpdateR:  TRect;
  Row:      Integer;
  GhostRow: Integer;
begin
  if (FPendingScrolls = 0) or (FLiveDC = 0) then
    Exit;
  if FPendingScrolls >= FRows then
  begin
    FAllDirty := True;
    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);
  { Mark exposed rows and cursor ghost row for deferred rendering }
  for Row := FRows - FPendingScrolls to FRows - 1 do
    FDirtyRow[Row] := True;
  GhostRow := FLastCursorRow - FPendingScrolls;
  if (GhostRow >= 0) and (GhostRow < FRows) then
    FDirtyRow[GhostRow] := True;
  FLastCursorRow := FCursorRow;
  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       }
{ 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;
  GhostRow:  Integer;
  HasDirty:  Boolean;
  ScrollR:   TRect;
  ClipR:     TRect;
  UpdateR:   TRect;
begin
  if not HandleAllocated then
    Exit;
  if FPaintFont = 0 then
    RecalcCellSize;
  if FPaintFont = 0 then
    Exit;

  { Scrollback view: force full redraw (line mapping changes) }
  if FScrollPos <> 0 then
  begin
    FAllDirty := True;
    FPendingScrolls := 0;
  end;

  { Deferred scrollbar update (batched from DoScrollUp) }
  if FScrollbarDirty then
  begin
    UpdateScrollbar;
    FScrollbarDirty := False;
  end;

  { Coalesced ScrollDC: shift on-screen pixels to match FScreen after      }
  { one or more DoScrollUp calls, then only render the newly exposed rows. }
  if (FPendingScrolls > 0) and not FAllDirty then
  begin
    if FPendingScrolls < FRows then
    begin
      ScrollR.Left   := 0;
      ScrollR.Top    := 0;
      ScrollR.Right  := FCols * FCellWidth;
      ScrollR.Bottom := FRows * FCellHeight;
      ClipR := ScrollR;
      DC := GetDC(Handle);
      ScrollDC(DC, 0, -(FPendingScrolls * FCellHeight),
        ScrollR, ClipR, 0, @UpdateR);
      ReleaseDC(Handle, DC);
      { Dirty the newly exposed bottom rows }
      for Row := FRows - FPendingScrolls to FRows - 1 do
      begin
        if Row >= 0 then
          FDirtyRow[Row] := True;
      end;
      { Dirty row that now shows cursor ghost from pre-scroll pixels }
      GhostRow := FCursorRow - FPendingScrolls;
      if (GhostRow >= 0) and (GhostRow < FRows) then
        FDirtyRow[GhostRow] := True;
      { Sync FLastCursorRow since pixel positions shifted }
      FLastCursorRow := FCursorRow;
    end
    else
      FAllDirty := True;
    FPendingScrolls := 0;
  end;

  { Dirty old cursor row to erase ghost when cursor moved between rows }
  if FCursorRow <> FLastCursorRow then
  begin
    if (FLastCursorRow >= 0) and (FLastCursorRow <= 255) then
      FDirtyRow[FLastCursorRow] := True;
    if (FCursorRow >= 0) and (FCursorRow <= 255) then
      FDirtyRow[FCursorRow] := True;
    FLastCursorRow := FCursorRow;
  end;

  { Early exit: skip GetDC/ReleaseDC when nothing needs rendering }
  if not FAllDirty then
  begin
    HasDirty := False;
    for Row := 0 to FRows - 1 do
    begin
      if FDirtyRow[Row] then
      begin
        HasDirty := True;
        Break;
      end;
    end;
    if not HasDirty then
      Exit;
  end;

  { Render dirty rows directly to screen DC.  Re-select the OEM font each   }
  { frame because Delphi's Canvas infrastructure can deselect it from the   }
  { CS_OWNDC between paint cycles.                                          }
  DC := GetDC(Handle);
  SelectObject(DC, FPaintFont);
  SetBkMode(DC, OPAQUE);
  for Row := 0 to FRows - 1 do
  begin
    if FAllDirty or FDirtyRow[Row] then
    begin
      RenderRow(DC, Row);
      FDirtyRow[Row] := False;
    end;
  end;
  FAllDirty := False;
  ReleaseDC(Handle, DC);
end;


procedure TKPAnsi.FreeLineList(List: TList);
var
  I: Integer;
begin
  for I := 0 to List.Count - 1 do
  begin
    FreeMem(PTermLine(List[I]), SizeOf(TTermLineRec));
  end;
  List.Clear;
end;


procedure TKPAnsi.InsertChars(N: Integer);
var
  Line: PTermLine;
  I:    Integer;
begin
  if N < 1 then
    N := 1;
  Line := FScreen[FCursorRow];
  for I := FCols - 1 downto FCursorCol + N do
    Line^.Cells[I] := Line^.Cells[I - N];
  for I := FCursorCol to FCursorCol + N - 1 do
  begin
    if I < FCols then
    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;
  FDirtyRow[FCursorRow] := True;
end;


procedure TKPAnsi.InsertLines(N: Integer);
var
  I:    Integer;
  J:    Integer;
  Line: PTermLine;
begin
  if N < 1 then
    N := 1;
  for I := 1 to N do
  begin
    if FScreen.Count > 0 then
    begin
      Line := FScreen[FScreen.Count - 1];
      FreeMem(Line, SizeOf(TTermLineRec));
      FScreen.Delete(FScreen.Count - 1);
    end;
    GetMem(Line, SizeOf(TTermLineRec));
    AllocLine(Line);
    FScreen.Insert(FCursorRow, Line);
  end;
  for J := FCursorRow to FRows - 1 do
    FDirtyRow[J] := True;
end;


procedure TKPAnsi.KeyDown(var Key: Word; Shift: TShiftState);
var
  S: string;
begin
  S := '';
  case Key of
    vk_Up:
      S := #27'[A';
    vk_Down:
      S := #27'[B';
    vk_Right:
      S := #27'[C';
    vk_Left:
      S := #27'[D';
    vk_Home:
      S := #27'[H';
    vk_End:
      S := #27'[K';
    vk_Prior: { Page Up }
      S := #27'[V';
    vk_Next: { Page Down }
      S := #27'[U';
    vk_Insert:
      S := #27'[@';
    vk_Delete:
      S := #27#127;
    vk_F1:
      S := #27'OP';
    vk_F2:
      S := #27'OQ';
    vk_F3:
      S := #27'OR';
    vk_F4:
      S := #27'OS';
    vk_F5:
      S := #27'Ot';
    vk_F6:
      S := #27'Ou';
    vk_F7:
      S := #27'Ov';
    vk_F8:
      S := #27'Ow';
    vk_F9:
      S := #27'Ox';
    vk_F10:
      S := #27'Oy';
  end;
  if (Length(S) > 0) and Assigned(FOnKeyData) then
  begin
    FOnKeyData(Self, S);
    Key := 0;
  end;
  inherited KeyDown(Key, Shift);
end;


procedure TKPAnsi.KeyPress(var Key: Char);
var
  S: string;
begin
  if Key = #13 then
    S := #13
  else if Key >= ' ' then
    S := Key
  else if Key = #8 then
    S := #8
  else if Key = #9 then
    S := #9
  else if Key = #27 then
    S := #27
  else
    S := '';
  if (Length(S) > 0) and Assigned(FOnKeyData) then
  begin
    FOnKeyData(Self, S);
  end;
  inherited KeyPress(Key);
end;


procedure TKPAnsi.Paint;
var
  DC:  HDC;
  Row: Integer;
begin
  if FPaintFont = 0 then
    RecalcCellSize;
  if FPaintFont = 0 then
    Exit;

  { Full repaint: render each row directly to screen }
  FAllDirty := True;
  DC := Canvas.Handle;
  SelectObject(DC, FPaintFont);
  SetBkMode(DC, OPAQUE);

  for Row := 0 to FRows - 1 do
  begin
    RenderRow(DC, Row);
    FDirtyRow[Row] := False;
  end;
  FAllDirty := False;
end;


procedure TKPAnsi.ParseDataBuf(Buf: PChar; Len: Integer);
{ Process incoming data from a PChar buffer (no string allocation needed).  }
{                                                                           }
{ Three inlined fast paths eliminate ProcessChar method call overhead:       }
{   1. Printable text runs: batch fill cells, one color computation per run }
{   2. CSI parameter accumulation: scan-ahead loop for digits/semicolons    }
{   3. Common control chars: ESC, CR, LF handled inline                    }
{                                                                           }
{ Uncommon states (psCSIQuestion, psMusic) and rare control chars (TAB,     }
{ BS, BEL, ENQ) still delegate to ProcessChar.                             }
{                                                                           }
{ Does NOT call FlipToScreen -- the caller handles rendering.               }
var
  I:           Integer;
  Ch:          Char;
  Line:        PTermLine;
  FGIdx:       Byte;
  BGIdx:       Byte;
  RunEnd:      Integer;
  Remaining:   Integer;
begin
  Line := nil;
  I    := 0;

  while I < Len do
  begin
    case FParseState of
      psNormal:
        begin
          if Buf[I] >= ' ' then
          begin
            { Fast path: batch printable characters }
            if FCursorCol >= FCols then
            begin
              if FWrapMode then
              begin
                FCursorCol := 0;
                Inc(FCursorRow);
                if FCursorRow >= FRows then
                begin
                  FCursorRow := FRows - 1;
                  DoScrollUp;
                end;
                Line := nil;
              end
              else
                FCursorCol := FCols - 1;
            end;

            if Line = nil then
              Line := FScreen[FCursorRow];

            { Compute colors once for the entire run }
            if FAttrBold then
              FGIdx := FAttrFG + 8
            else
              FGIdx := FAttrFG;
            BGIdx := FAttrBG;

            { Find run end: stop at control char, end of input, or end of row }
            Remaining := FCols - FCursorCol;
            RunEnd := I;
            while (RunEnd < Len) and (Buf[RunEnd] >= ' ') and
                  (RunEnd - I < Remaining) do
              Inc(RunEnd);

            { Fill cells in tight loop }
            if FAttrReverse then
            begin
              while I < RunEnd do
              begin
                Line^.Cells[FCursorCol].Ch    := Buf[I];
                Line^.Cells[FCursorCol].FG    := BGIdx;
                Line^.Cells[FCursorCol].BG    := FGIdx;
                Line^.Cells[FCursorCol].Bold  := FAttrBold;
                Line^.Cells[FCursorCol].Blink := FAttrBlink;
                Inc(FCursorCol);
                Inc(I);
              end;
            end
            else
            begin
              while I < RunEnd do
              begin
                Line^.Cells[FCursorCol].Ch    := Buf[I];
                Line^.Cells[FCursorCol].FG    := FGIdx;
                Line^.Cells[FCursorCol].BG    := BGIdx;
                Line^.Cells[FCursorCol].Bold  := FAttrBold;
                Line^.Cells[FCursorCol].Blink := FAttrBlink;
                Inc(FCursorCol);
                Inc(I);
              end;
            end;

            FDirtyRow[FCursorRow] := True;
          end
          else if Buf[I] = #27 then
          begin
            { ESC: start escape sequence }
            FParseState := psEscape;
            Line := nil;
            Inc(I);
          end
          else if Buf[I] = #10 then
          begin
            { LF: line feed }
            Inc(FCursorRow);
            if FCursorRow >= FRows then
            begin
              FCursorRow := FRows - 1;
              DoScrollUp;
            end;
            Line := nil;
            Inc(I);
          end
          else if Buf[I] = #13 then
          begin
            { CR: carriage return }
            FCursorCol := 0;
            Inc(I);
          end
          else
          begin
            { Uncommon control chars: BS, TAB, BEL, ENQ }
            Line := nil;
            ProcessChar(Buf[I]);
            Inc(I);
          end;
        end;

      psEscape:
        begin
          if Buf[I] = '[' then
          begin
            FParamLen    := 0;
            FCSIParam1   := 0;
            FCSIParam2   := 0;
            FCSIParamIdx := 0;
            FParseState  := psCSI;
          end
          else
            FParseState := psNormal;
          Inc(I);
        end;

      psCSI:
        begin
          { Scan ahead: parse integers inline while accumulating FParamBuf.  }
          { FCSIParam1/FCSIParam2 are built digit-by-digit during the scan   }
          { so ExecuteCSI can use them directly without ParseParamBuf.        }
          { FParamBuf is still maintained for ParseSGR (variable param count). }
          while (I < Len) and
                ((Buf[I] >= '0') and (Buf[I] <= '9') or (Buf[I] = ';')) do
          begin
            if Buf[I] = ';' then
            begin
              Inc(FCSIParamIdx);
            end
            else if FCSIParamIdx = 0 then
            begin
              FCSIParam1 := FCSIParam1 * 10 + (Ord(Buf[I]) - 48);
            end
            else if FCSIParamIdx = 1 then
            begin
              FCSIParam2 := FCSIParam2 * 10 + (Ord(Buf[I]) - 48);
            end;
            if FParamLen < 32 then
            begin
              FParamBuf[FParamLen] := Buf[I];
              Inc(FParamLen);
            end;
            Inc(I);
          end;

          { Process final command byte if available }
          if I < Len then
          begin
            Ch := Buf[I];
            if Ch = '?' then
            begin
              FParseState := psCSIQuestion;
            end
            else if (Ch = 'M') and (FParamLen = 0) then
            begin
              FMusicStr   := '';
              FParseState := psMusic;
            end
            else
            begin
              ExecuteCSI(Ch);
              FParseState := psNormal;
            end;
            Inc(I);
          end;
        end;

      else
        begin
          { psCSIQuestion, psMusic: delegate to ProcessChar }
          Line := nil;
          ProcessChar(Buf[I]);
          Inc(I);
        end;
    end;
  end;

  { Deferred scrollback trim -- batched from DoScrollUp }
  TrimScrollback;

  { Snap to bottom on new data }
  if FScrollPos <> 0 then
  begin
    FScrollPos      := 0;
    FScrollbarDirty := True;
    FAllDirty       := True;
  end;
end;


procedure TKPAnsi.ParseSGR;
var
  Params: array[0..15] of Integer;
  Count:  Integer;
  I:      Integer;
  Code:   Integer;
begin
  ParseParamBuf(@FParamBuf[0], FParamLen, Params, Count);

  { SGR with no parameters means reset }
  if Count = 0 then
  begin
    FAttrFG      := 7;
    FAttrBG      := 0;
    FAttrBold    := False;
    FAttrBlink   := False;
    FAttrReverse := False;
    Exit;
  end;

  for I := 0 to Count - 1 do
  begin
    Code := Params[I];
    case Code of
      0: { Reset }
        begin
          FAttrFG      := 7;
          FAttrBG      := 0;
          FAttrBold    := False;
          FAttrBlink   := False;
          FAttrReverse := False;
        end;
      1: { Bold }
        FAttrBold := True;
      5: { Blink }
        FAttrBlink := True;
      7: { Reverse }
        FAttrReverse := True;
      22: { Normal intensity (cancel bold) }
        FAttrBold := False;
      25: { Blink off }
        FAttrBlink := False;
      27: { Reverse off }
        FAttrReverse := False;
      30..37: { Foreground color }
        FAttrFG := Code - 30;
      40..47: { Background color }
        FAttrBG := Code - 40;
    end;
  end;
end;


procedure TKPAnsi.ProcessChar(Ch: Char);
var
  FGIdx:  Integer;
  BGIdx:  Integer;
  TabCol: Integer;
  Line:   PTermLine;
begin
  case FParseState of
    psNormal:
      begin
        case Ch of
          #27: { ESC }
            FParseState := psEscape;
          #13: { CR }
            FCursorCol := 0;
          #10: { LF }
            begin
              Inc(FCursorRow);
              if FCursorRow >= FRows then
              begin
                FCursorRow := FRows - 1;
                DoScrollUp;
              end;
            end;
          #8: { BS }
            begin
              if FCursorCol > 0 then
                Dec(FCursorCol);
            end;
          #9: { TAB }
            begin
              TabCol := ((FCursorCol div 8) + 1) * 8;
              if TabCol >= FCols then
                TabCol := FCols - 1;
              FCursorCol := TabCol;
            end;
          #5: { ENQ - Answerback }
            begin
              if Assigned(FOnKeyData) then
                FOnKeyData(Self, #27'[?1;0c');
            end;
          #7: { BEL }
            MessageBeep(0);
          else
            begin
              { Printable character }
              if (FCursorCol >= FCols) then
              begin
                if FWrapMode then
                begin
                  FCursorCol := 0;
                  Inc(FCursorRow);
                  if FCursorRow >= FRows then
                  begin
                    FCursorRow := FRows - 1;
                    DoScrollUp;
                  end;
                end
                else
                begin
                  FCursorCol := FCols - 1;
                end;
              end;

              { Calculate effective colors.  Bold maps FG to bright }
              { (index + 8).  Blink is stored as a cell attribute    }
              { and rendered in RenderRow -- NOT mapped to bright BG, }
              { so colored backgrounds (SGR 40-47) display correctly. }
              if FAttrBold then
                FGIdx := FAttrFG + 8
              else
                FGIdx := FAttrFG;
              BGIdx := FAttrBG;

              Line := FScreen[FCursorRow];
              if FAttrReverse then
              begin
                Line^.Cells[FCursorCol].FG := BGIdx;
                Line^.Cells[FCursorCol].BG := FGIdx;
              end
              else
              begin
                Line^.Cells[FCursorCol].FG := FGIdx;
                Line^.Cells[FCursorCol].BG := BGIdx;
              end;
              Line^.Cells[FCursorCol].Ch    := Ch;
              Line^.Cells[FCursorCol].Bold  := FAttrBold;
              Line^.Cells[FCursorCol].Blink := FAttrBlink;

              { Mark row dirty for deferred batch rendering }
              FDirtyRow[FCursorRow] := True;

              Inc(FCursorCol);
            end;
        end;
      end;

    psEscape:
      begin
        case Ch of
          '[':
            begin
              FParamLen    := 0;
              FCSIParam1   := 0;
              FCSIParam2   := 0;
              FCSIParamIdx := 0;
              FParseState  := psCSI;
            end;
          else
            begin
              { Unrecognized escape sequence, return to normal }
              FParseState := psNormal;
            end;
        end;
      end;

    psCSI:
      begin
        case Ch of
          '0'..'9', ';':
            begin
              if Ch = ';' then
                Inc(FCSIParamIdx)
              else if FCSIParamIdx = 0 then
                FCSIParam1 := FCSIParam1 * 10 + (Ord(Ch) - 48)
              else if FCSIParamIdx = 1 then
                FCSIParam2 := FCSIParam2 * 10 + (Ord(Ch) - 48);
              if FParamLen < 32 then
              begin
                FParamBuf[FParamLen] := Ch;
                Inc(FParamLen);
              end;
            end;
          '?':
            begin
              FParseState := psCSIQuestion;
            end;
          'M':
            begin
              { Check if this is ANSI music: ESC[M starts music mode }
              if FParamLen = 0 then
              begin
                FMusicStr   := '';
                FParseState := psMusic;
              end
              else
              begin
                { DL - Delete Lines with params }
                ExecuteCSI('M');
                FParseState := psNormal;
              end;
            end;
          else
            begin
              { Final byte: execute the command }
              ExecuteCSI(Ch);
              FParseState := psNormal;
            end;
        end;
      end;

    psCSIQuestion:
      begin
        case Ch of
          '0'..'9', ';':
            begin
              if FParamLen < 32 then
              begin
                FParamBuf[FParamLen] := Ch;
                Inc(FParamLen);
              end;
            end;
          'h': { Set Mode }
            begin
              if (FParamLen = 1) and (FParamBuf[0] = '7') then
                FWrapMode := True
              else if (FParamLen = 2) and (FParamBuf[0] = '2') and (FParamBuf[1] = '5') then
                FCursorVisible := True;
              FParseState := psNormal;
            end;
          'l': { Reset Mode }
            begin
              if (FParamLen = 1) and (FParamBuf[0] = '7') then
                FWrapMode := False
              else if (FParamLen = 2) and (FParamBuf[0] = '2') and (FParamBuf[1] = '5') then
                FCursorVisible := False;
              FParseState := psNormal;
            end;
          else
            begin
              { Unrecognized DEC private mode, return to normal }
              FParseState := psNormal;
            end;
        end;
      end;

    psMusic:
      begin
        if Ch = #14 then { Ctrl-N terminates music }
        begin
          ExecuteMusic;
          FParseState := psNormal;
        end
        else
        begin
          FMusicStr := FMusicStr + Ch;
        end;
      end;
  end;
end;


procedure TKPAnsi.RecalcCellSize;
var
  DC:     HDC;
  Extent: Longint;
begin
  if not HandleAllocated then
    Exit;

  { Recreate the OEM charset paint font from current Font properties }
  CreatePaintFont;

  { 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);
  finally
    ReleaseDC(Handle, DC);
  end;
  if FCellWidth < 1 then
    FCellWidth := 8;
  if FCellHeight < 1 then
    FCellHeight := 16;
  if FCellHeight > 32 then
    FCellHeight := 32;

  { Resize control to fit terminal dimensions }
  Width  := FCols * FCellWidth + GetSystemMetrics(sm_CxVScroll);
  Height := FRows * FCellHeight;
  FAllDirty := True;

  Invalidate;
end;


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.  No intermediate bitmap -- the     }
{ display driver renders text directly into the framebuffer.                }
var
  Line:     PTermLine;
  Col:      Integer;
  CurCol:   Integer;
  FGIdx:    Byte;
  BGIdx:    Byte;
  TmpIdx:   Byte;
  SbkCount: Integer;
  VisRow:   Integer;
  RunStart: Integer;
  RunFG:    Byte;
  RunBG:    Byte;
  RunBuf:   array[0..255] of Char;
  RunLen:   Integer;
  DxBuf:    array[0..255] of Integer;
  R:        TRect;
  RowY:     Integer;
begin
  RowY := Row * FCellHeight;

  { Fill character spacing array -- forces uniform cell width for TrueType }
  for Col := 0 to FCols - 1 do
    DxBuf[Col] := FCellWidth;

  { Determine which line to render (handles scrollback view) }
  if FScrollPos <> 0 then
  begin
    SbkCount := FScrollback.Count;
    VisRow   := Row - FScrollPos;
    if VisRow < 0 then
    begin
      if (SbkCount + VisRow >= 0) then
        Line := FScrollback[SbkCount + VisRow]
      else
        Line := nil;
    end
    else if VisRow < FScreen.Count then
      Line := FScreen[VisRow]
    else
      Line := nil;
  end
  else if Row < FScreen.Count then
    Line := FScreen[Row]
  else
    Line := nil;

  if Line = nil then
  begin
    { Blank row: fill with black background }
    SetBkColor(DC, AnsiColors[0]);
    R.Left   := 0;
    R.Top    := RowY;
    R.Right  := FCols * FCellWidth;
    R.Bottom := RowY + FCellHeight;
    ExtTextOut(DC, 0, RowY, ETO_OPAQUE, @R, nil, 0, nil);
    Exit;
  end;

  { Determine cursor column for this row (-1 if no cursor) }
  if FCursorVisible and FBlinkOn and (FScrollPos = 0) and
     (Row = FCursorRow) and (FCursorCol >= 0) and (FCursorCol < FCols) then
    CurCol := FCursorCol
  else
    CurCol := -1;

  RunStart := 0;
  RunLen   := 0;
  RunFG    := 255;
  RunBG    := 255;

  for Col := 0 to FCols - 1 do
  begin
    { Determine effective colors }
    if Line^.Cells[Col].Blink and not FBlinkOn then
      FGIdx := Line^.Cells[Col].BG
    else
      FGIdx := Line^.Cells[Col].FG;
    BGIdx := Line^.Cells[Col].BG;

    { Cursor: swap FG/BG }
    if Col = CurCol then
    begin
      TmpIdx := FGIdx;
      FGIdx  := BGIdx;
      BGIdx  := TmpIdx;
    end;

    { If colors changed, flush current run }
    if (FGIdx <> RunFG) or (BGIdx <> RunBG) then
    begin
      if RunLen > 0 then
      begin
        SetTextColor(DC, AnsiColors[RunFG]);
        SetBkColor(DC, AnsiColors[RunBG]);
        R.Left   := RunStart * FCellWidth;
        R.Top    := RowY;
        R.Right  := (RunStart + RunLen) * FCellWidth;
        R.Bottom := RowY + FCellHeight;
        ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R,
          @RunBuf[0], RunLen, @DxBuf[0]);
      end;
      RunStart := Col;
      RunLen   := 0;
      RunFG    := FGIdx;
      RunBG    := BGIdx;
    end;

    RunBuf[RunLen] := Line^.Cells[Col].Ch;
    Inc(RunLen);
  end;

  { Flush final run }
  if RunLen > 0 then
  begin
    SetTextColor(DC, AnsiColors[RunFG]);
    SetBkColor(DC, AnsiColors[RunBG]);
    R.Left   := RunStart * FCellWidth;
    R.Top    := RowY;
    R.Right  := (RunStart + RunLen) * FCellWidth;
    R.Bottom := RowY + FCellHeight;
    ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R,
      @RunBuf[0], RunLen, @DxBuf[0]);
  end;
end;


procedure TKPAnsi.Reset;
begin
  FAttrFG      := 7;
  FAttrBG      := 0;
  FAttrBold    := False;
  FAttrBlink   := False;
  FAttrReverse := False;
  FParseState  := psNormal;
  FParamLen    := 0;
  FMusicStr    := '';
  FWrapMode    := True;
  FSaveCurRow  := 0;
  FSaveCurCol  := 0;
  Clear;
end;


procedure TKPAnsi.ResizeScreen;
var
  I:    Integer;
  Line: PTermLine;
begin
  { Free existing screen lines }
  FreeLineList(FScreen);

  { Allocate new screen lines }
  for I := 0 to FRows - 1 do
  begin
    GetMem(Line, SizeOf(TTermLineRec));
    AllocLine(Line);
    FScreen.Add(Line);
  end;

  FCursorRow := 0;
  FCursorCol := 0;
  FScrollPos := 0;
  UpdateScrollbar;
  RecalcCellSize;
end;


procedure TKPAnsi.SetCols(Value: Integer);
begin
  if Value < 1 then
    Value := 1;
  if Value > 256 then
    Value := 256;
  if Value <> FCols then
  begin
    FCols := Value;
    ResizeScreen;
  end;
end;


procedure TKPAnsi.SetCursorVisible(Value: Boolean);
begin
  if Value <> FCursorVisible then
  begin
    FCursorVisible := Value;
    FDirtyRow[FCursorRow] := True;
    FlipToScreen;
  end;
end;


procedure TKPAnsi.SetFontSize(Value: Integer);
begin
  if Value < 4 then
    Value := 4;
  if Value > 72 then
    Value := 72;
  if Value <> FFontSize then
  begin
    FFontSize := Value;
    RecalcCellSize;
  end;
end;


procedure TKPAnsi.SetRows(Value: Integer);
begin
  if Value < 1 then
    Value := 1;
  if Value > 255 then
    Value := 255;
  if Value <> FRows then
  begin
    FRows := Value;
    ResizeScreen;
  end;
end;


procedure TKPAnsi.SetScrollbackSize(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  FScrollbackSize := Value;
  TrimScrollback;
end;


procedure TKPAnsi.TrimScrollback;
{ Batch-optimized: free excess items, shift remainder down in one pass,    }
{ then shrink from the end.  O(n) total vs O(k*n) for k front-deletions.  }
var
  Excess: Integer;
  I:      Integer;
  Line:   PTermLine;
begin
  Excess := FScrollback.Count - FScrollbackSize;
  if Excess <= 0 then
    Exit;
  { Free the oldest lines }
  for I := 0 to Excess - 1 do
  begin
    Line := FScrollback[I];
    FreeMem(Line, SizeOf(TTermLineRec));
  end;
  { Shift remaining items down in one pass }
  for I := 0 to FScrollback.Count - Excess - 1 do
    FScrollback[I] := FScrollback[I + Excess];
  { Remove excess slots from the end (O(1) per deletion) }
  for I := 1 to Excess do
    FScrollback.Delete(FScrollback.Count - 1);
end;


procedure TKPAnsi.UpdateScrollbar;
var
  SbkCount: Integer;
begin
  if not HandleAllocated then
    Exit;
  SbkCount := FScrollback.Count;
  if SbkCount > 0 then
  begin
    SetScrollRange(Handle, sb_Vert, 0, SbkCount, False);
    SetScrollPos(Handle, sb_Vert, SbkCount - FScrollPos, True);
  end
  else
  begin
    SetScrollRange(Handle, sb_Vert, 0, 0, False);
    SetScrollPos(Handle, sb_Vert, 0, True);
  end;
end;


procedure TKPAnsi.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  { Suppress background erase -- ExtTextOut ETO_OPAQUE covers everything }
  Msg.Result := 1;
end;


procedure TKPAnsi.WMGetDlgCode(var Msg: TMessage);
begin
  Msg.Result := dlgc_WantArrows or dlgc_WantTab or dlgc_WantChars;
end;


procedure TKPAnsi.TickBlink;
var
  Now: Longint;
begin
  Now := GetTickCount;
  if Now - FLastBlinkTick >= BlinkMs then
  begin
    FLastBlinkTick := Now;
    FBlinkOn       := not FBlinkOn;
    DirtyBlinkRows;
  end;
end;


procedure TKPAnsi.WMVScroll(var Msg: TWMScroll);
var
  SbkCount: Integer;
  NewPos:   Integer;
begin
  SbkCount := FScrollback.Count;
  if SbkCount = 0 then
    Exit;

  NewPos := FScrollPos;
  case Msg.ScrollCode of
    sb_LineUp:
      Inc(NewPos);
    sb_LineDown:
      Dec(NewPos);
    sb_PageUp:
      Inc(NewPos, FRows);
    sb_PageDown:
      Dec(NewPos, FRows);
    sb_ThumbPosition, sb_ThumbTrack:
      NewPos := SbkCount - Msg.Pos;
    sb_Top:
      NewPos := SbkCount;
    sb_Bottom:
      NewPos := 0;
  end;

  if NewPos < 0 then
    NewPos := 0;
  if NewPos > SbkCount then
    NewPos := SbkCount;

  if NewPos <> FScrollPos then
  begin
    FScrollPos := NewPos;
    SetScrollPos(Handle, sb_Vert, SbkCount - FScrollPos, True);
    FlipToScreen;
  end;
end;


procedure TKPAnsi.Write(const S: string);
begin
  if Length(S) > 0 then
  begin
    WriteDeferredBuf(@S[1], Length(S));
    FlipToScreen;
  end;
end;


procedure TKPAnsi.WriteDeferred(const S: string);
begin
  if Length(S) > 0 then
    WriteDeferredBuf(@S[1], Length(S));
end;


procedure TKPAnsi.WriteDeferredBuf(Buf: PChar; Len: Integer);
var
  Row: Integer;
begin
  if Len <= 0 then
    Exit;

  { Parse into cell buffer -- pure CPU, no GDI calls }
  ParseDataBuf(Buf, Len);

  { Render pass: flush coalesced scrolls, then redraw dirty rows }
  if HandleAllocated and (FPaintFont <> 0) and (FScrollPos = 0) then
  begin
    FLiveDC := GetDC(Handle);
    SelectObject(FLiveDC, FPaintFont);
    SetBkMode(FLiveDC, OPAQUE);
    FlushPendingScrolls;
    { Dirty old cursor row to erase ghost when cursor moved between rows }
    if FCursorRow <> FLastCursorRow then
    begin
      if (FLastCursorRow >= 0) and (FLastCursorRow < FRows) then
        FDirtyRow[FLastCursorRow] := True;
      FDirtyRow[FCursorRow] := True;
    end;
    for Row := 0 to FRows - 1 do
    begin
      if FAllDirty or FDirtyRow[Row] then
      begin
        RenderRow(FLiveDC, Row);
        FDirtyRow[Row] := False;
      end;
    end;
    FAllDirty := False;
    FLastCursorRow := FCursorRow;
    ReleaseDC(Handle, FLiveDC);
    FLiveDC := 0;
  end;
end;


{ ----------------------------------------------------------------------- }
{ Component registration                                                   }
{ ----------------------------------------------------------------------- }

procedure Register;
begin
  RegisterComponents('KP', [TKPAnsi]);
end;

end.