* Easy-to-use Ansi escape sequences

packages/rtl-console/demo/demoansi.pp

@@ -0,0 +1,153 @@
+program demoansi;
+
+{$mode objfpc}
+{$h+}
+
+uses sysutils, fpansi;
+
+var
+  ANI : Array[0..3] of string = ('|','/','-','\');
+
+var
+  i : Integer;
+  aText : TAnsi;
+  aLine : AnsiString;
+  
+procedure Pause;
+begin
+  Writeln;
+  Write('Press Enter to continue...');
+  Readln;
+  Writeln(TAnsi.EraseDisplay(edScreen));
+  Writeln(TAnsi.CursorAt(1,1));
+end;
+
+begin
+  Writeln(TAnsi.EraseDisplay(edScreen));  
+  Writeln('--- Basic & Existing Demo ---');
+  aText:='Hello world!';
+  aLine:=aText.Bold.Fg(TAnsi.Red);
+  Writeln(TAnsi.CursorAt(1,1),aLine);
+  aText:='Hello world, again!';
+  aText.Bold.Fg(TAnsi.BrightGreen).At(2,1).EmitLn;
+  
+  Write('Running animation... ');
+  for I:=1 to 100 do
+    begin
+    aText:=Ani[i mod 4]+' '+Format('%.2d',[(100-I)]);
+    AText.Backward(4).FG(TAnsi.BrightRed).Emit;
+    Sleep(20);
+    end;
+  
+  Pause;
+
+  // --- Attributes Demo ---
+  Writeln('--- Attributes Demo ---');
+  aText := 'This text is BLINKING (may not work in all terminals)';
+  aText.Blinking.EmitLn;
+  
+  aText := 'This text is FAINT';
+  aText.Faint.EmitLn;
+  
+  aText := 'This text is STRIKETHROUGH';
+  aText.Strikethrough.EmitLn;
+  
+  aText := 'This text is BOLD and FAINT combined';
+  aText.Bold.Faint.EmitLn;
+
+  Pause;
+
+  // --- Colors Demo ---
+  Writeln('--- Colors Demo ---');
+  aText := 'Standard Blue Background with White Text';
+  aText.Bg(TAnsi.Blue).Fg(TAnsi.White).EmitLn;
+
+  aText := 'Custom RGB Foreground (Orange: 255, 165, 0)';
+  aText.FgRGB(255, 165, 0).EmitLn;
+
+  aText := 'Custom RGB Background (Purple: 128, 0, 128)';
+  aText.BgRGB(128, 0, 128).Fg(TAnsi.White).EmitLn;
+
+  Writeln('Grayscale Ramp (Bg):');
+  for i := 0 to 23 do
+  begin
+    aText := ' ';
+    aText.Bg(aText.GrayScale(i)).Emit;
+  end;
+  Writeln;
+  
+  Writeln('RGB Helper Demo (Red Gradient Bg):');
+  for i := 0 to 5 do
+  begin
+    aText := '  ';
+    aText.Bg(aText.RGB(i, 0, 0)).Emit;
+  end;
+  Writeln;
+
+  Pause;
+
+  // --- Cursor Movement Demo ---
+  Writeln('--- Cursor Movement Demo ---');
+  Writeln('Line 1: Origin');
+  Writeln('Line 2: Target for Up/Down');
+  Writeln('Line 3: Target for PreviousLine');
+  Writeln;
+  
+  // Go back up to Line 1
+  aText := ' <--- Appended on Line 1 via PreviousLine';
+  aText.PreviousLine(4).Forward(15).Emit; 
+  
+  // Go down to Line 2
+  aText := ' <--- Appended on Line 2 via NextLine';
+  aText.NextLine.Forward(15).Emit;
+
+  // Move absolute
+  aText := 'Absolute Position (Row 10, Col 20)';
+  aText.At(20, 10).Emit;
+
+  // Column movement
+  Writeln;
+  Writeln; // Ensure we are below
+  Write('Column 1');
+  aText := 'Column 30 via AtCol';
+  aText.AtCol(30).EmitLn;
+  
+  // Directional
+  Writeln;
+  Write('Start');
+  aText := 'Up and Right';
+  // Move Up 1 and Right 5 from current position
+  aText.Up(1).Forward(5).EmitLn;
+  Writeln;
+
+  Pause;
+
+  // --- Erase Demo ---
+  Writeln('--- Erase Demo ---');
+  Writeln('1. This line will be partially erased from the END (Watch this part -> XXXXX)');
+  Writeln('2. This line will be partially erased from the BEGINNING');
+  Writeln('3. This line will be FULLY erased');
+  Writeln('4. This line stays.');
+  
+  // 1. Erase End
+  // Move up 4 lines (to line 1), move to column 55 approx
+  Write(TAnsi.CursorPreviousLine(4)); 
+  Write(TAnsi.CursorAtCol(55)); 
+  Write(TAnsi.EraseLine(elEndOfLine));
+  
+  // 2. Erase Start
+  Write(TAnsi.CursorNextLine(1));
+  Write(TAnsi.CursorAtCol(10)); // Move in a bit
+  Write(TAnsi.EraseLine(edBeginOfLine));
+
+  // 3. Erase Full
+  Write(TAnsi.CursorNextLine(1));
+  Write(TAnsi.EraseLine(edLine));
+
+  // Return to bottom
+  Write(TAnsi.CursorNextLine(2));
+  
+  Pause;
+
+  Writeln('Demo Complete.');
+end.

packages/rtl-console/fpmake.pp

@@ -69,6 +69,8 @@ begin
 
     T:=P.Targets.AddUnit('winevent.pp',WinEventOSes);
 
+    T:=P.Targets.AddUnit('fpansi.pp');
+    
     T:=P.Targets.AddUnit('keyboard.pp',KbdOSes);
     with T.Dependencies do
       begin

packages/rtl-console/namespaced/System.Console.Ansi.pp

@@ -0,0 +1,3 @@
+unit System.Console.Ansi;
+{$DEFINE FPC_DOTTEDUNITS}
+{$i fpansi.pp}

packages/rtl-console/namespaces.lst

@@ -1,3 +1,4 @@
+src/inc/fpansi.pp=namespaced/System.Console.Ansi.pp
 src/emx/crt.pp=namespaced/System.Console.Crt.pp
 {s*:src/emx/}=namespaced/
 {i+:src/emx/}

packages/rtl-console/src/inc/fpansi.pp

@@ -0,0 +1,343 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2026 by Michael Van Canneyt
+    member of the Free Pascal development team
+
+    Emit ANSI escape sequences
+    (Based on an idea by Vianney Gagnière)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$IFNDEF FPC_DOTTEDUNITS}
+unit FPAnsi;
+{$ENDIF}
+
+{$mode objfpc}
+{$h+}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils, System.StrUtils
+{$ELSE}
+  SysUtils,StrUtils  
+{$ENDIF}
+  ;
+
+type
+  TRGBComponent = 0..5;
+  TGrayScale = 0..23;
+  TEraseDisplay = (edEndOfScreen,edBeginOfScreen,edScreen,edScreenAndBuffer);
+  TEraseLine = (elEndOfLine,edBeginOfLine,edLine);
+    
+  TAnsi = record
+  private
+    FCmds : string;
+    FSGR : string;
+    FText: string;
+    procedure SGR(const aEscape: string);
+    procedure AddCommand(const aCommand : string);
+  public
+  const
+    // https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit
+    Black     = 0;
+    Red       = 1;
+    Green     = 2;
+    Yellow    = 3;
+    Blue      = 4;
+    Magenta   = 5;
+    Cyan      = 6;
+    White     = 7;
+   
+    BrightBlack   = 8;  
+    BrightRed     = 9;
+    BrightGreen   = 10;
+    BrightYellow  = 11;
+    BrightBlue    = 12;
+    BrightMagenta = 13;
+    BrightCyan    = 14;
+    BrightWhite   = 15;
+   
+    function RGB(R,G,B : TRGBComponent) : Byte;
+    Function GrayScale(aScale : TGrayScale) : Byte;
+    function FgRGB(R,G,B : Byte) : TAnsi;
+    function BgRGB(R,G,B : Byte) : TAnsi;
+    function Fg(const aColorCode: Byte): TAnsi;
+    function Bg(const aColorCode: Byte): TAnsi;
+    function Blinking: TAnsi;
+    function Bold: TAnsi;
+    function Faint: TAnsi;
+    function Strikethrough: TAnsi;
+    function ToString : String;
+    // Return ANSI escape control string
+    class function CursorAt(aCol,aRow : Word; asFormat : boolean = True) : string; static;
+    class function CursorAtCol(aCol : Word) : string; static;
+    class function CursorUp(aLines : Word = 1) : string; static;
+    class function CursorDown(aLines : Word = 1) : string; static;
+    class function CursorForward(aCols : Word = 1) : string; static;
+    class function CursorBackward(aCols : Word = 1) : string; static;
+    class function CursorNextLine(aLines : Word = 1) : string; static;
+    class function CursorPreviousLine(aLines : Word = 1) : string; static;
+    class function EraseDisplay(aWhich : TEraseDisplay) : string; static;
+    class function EraseLine(aWhich : TEraseLine) : string; static;
+    // Apply ANSI escape control string.
+    function At(aCol,aRow : Word; asFormat : Boolean = True): TAnsi;
+    function AtCol(aCol : Word): TAnsi;
+    function Up(aLines : Word = 1): TAnsi;
+    function Down(aLines : Word = 1): TAnsi;
+    function Forward(aCols : Word = 1): TAnsi;
+    function Backward(aCols : Word = 1): TAnsi;
+    function NextLine(aLines : Word = 1): TAnsi;
+    function PreviousLine(aLines : Word = 1): TAnsi;
+    function Emit(aClear : Boolean = True) : TAnsi;
+    function EmitLn(aClear : Boolean = True) : TAnsi;
+    Function Clear(aClearText : Boolean = False) : TAnsi;
+    class operator :=(const aText: AnsiString): TAnsi;
+    class operator :=(const aAnsi: TAnsi): AnsiString;
+    class operator :=(const aText: ShortString): TAnsi;
+    class operator :=(const aAnsi: TAnsi): ShortString;
+  end;
+
+implementation
+
+class operator TAnsi.:=(const aText: AnsiString): TAnsi;
+begin
+  Result:=Default(TAnsi);
+  Result.FText := aText;
+end;
+
+class operator TAnsi.:=(const aText: ShortString): TAnsi;
+begin
+  Result:=Default(TAnsi);
+  Result.FText := aText;
+end;
+
+class operator TAnsi.:=(const aAnsi: TAnsi): AnsiString;
+begin
+  Result:=aAnsi.ToString;
+end;
+
+class operator TAnsi.:=(const aAnsi: TAnsi): Shortstring;
+begin
+  Result:=aAnsi.ToString;
+end;
+
+procedure TAnsi.SGR(const aEscape: string);
+begin
+  if FSGR<>'' then
+    FSGR:=FSGR+';';
+  FSGR := FSGR+aEscape;
+end;
+
+function TAnsi.GrayScale(aScale : TGrayScale) : Byte;
+
+begin
+  Result:=232+aScale;
+end; 
+
+function TAnsi.RGB(R,G,B : TRGBComponent) : Byte;
+
+begin
+  Result:=16+(36*r)+(6*g)+b;
+end;
+
+function TAnsi.ToString : string;
+begin
+  Result:=FCmds+#27'['+FSGR+'m'+FText+#27'[0m';
+end;
+
+function TAnsi.Fg(const aColorCode: Byte): TAnsi;
+begin
+  SGR(Format('38;5;%d',[aColorCode]));
+  Result := Self;
+end;
+
+function TAnsi.Bg(const aColorCode: Byte): TAnsi;
+begin
+  SGR(Format('48;5;%d',[aColorCode]));
+  Result := Self;
+end;
+
+function Tansi.FgRGB(R,G,B : Byte) : TAnsi;
+begin
+  SGR(Format('38,2;%d;%d;%d',[R,G,B]));
+end;
+
+function TAnsi.BgRGB(R,G,B : Byte) : TAnsi;
+begin
+  SGR(Format('48,2;%d;%d;%d',[R,G,B]));
+end;
+
+class function TAnsi.CursorUp(aLines : Word = 1) : string;
+begin
+  Result:=Format(#27'[%dA',[aLines]);
+end;
+
+class function TAnsi.CursorDown(aLines : Word = 1) : string;
+begin
+  Result:=Format(#27'[%dB',[aLines]);
+end;
+
+class function TAnsi.CursorForward(aCols : Word = 1) : string;
+begin
+  Result:=Format(#27'[%dC',[aCols]);
+end;
+
+class function TAnsi.CursorBackward(aCols : Word = 1) : string;
+begin
+  Result:=Format(#27'[%dD',[aCols]);
+end;
+
+class function TAnsi.CursorNextLine(aLines : Word = 1) : string;
+begin
+  Result:=Format(#27'[%dE',[aLines]);
+end;
+
+class function TAnsi.CursorPreviousLine(aLines : Word = 1) : string;
+begin
+  Result:=Format(#27'[%dF',[aLines]);
+end;
+
+class function TAnsi.CursorAt(aCol,aRow : Word; asFormat : boolean = True) : string;
+
+Const
+  Chars : Array[Boolean] of String = ('H','f');
+  
+begin
+  Result:=Format(#27'[%d;%d%s',[aCol,aRow,Chars[asFormat]]);
+end;
+
+class function TAnsi.CursorAtCol(aCol : Word) : string;
+
+begin
+  Result:=Format(#27'[%dG',[aCol]);
+end;
+
+class function TAnsi.EraseDisplay(aWhich : TEraseDisplay) : string; 
+
+begin
+  Result:=Format(#27'[%dJ',[Ord(aWhich)]);
+end;
+
+class function TAnsi.EraseLine(aWhich : TEraseLine) : string; 
+
+begin
+  Result:=Format(#27'[%dK',[Ord(aWhich)]);
+end;
+
+procedure TAnsi.AddCommand(const aCommand : string);
+begin
+  FCmds:=FCmds+aCommand;
+end;
+
+function TAnsi.At(aCol,aRow : Word; asFormat : boolean = True) : TAnsi;
+
+begin
+  AddCommand(CursorAt(aCol,aRow,asFormat));
+  Result:=Self;
+end;
+
+function TAnsi.AtCol(aCol : Word) : TAnsi;
+
+begin
+  AddCommand(CursorAtCol(aCol));
+  Result:=Self;
+end;
+
+function TAnsi.Up(aLines : Word = 1): TAnsi;
+begin
+  AddCommand(CursorUp(aLines));
+  Result:=Self;
+end;
+
+function TAnsi.Down(aLines : Word = 1): TAnsi;
+begin
+  AddCommand(CursorDown(aLines));
+  Result:=Self;
+end;
+
+function TAnsi.Forward(aCols : Word = 1): TAnsi;
+begin
+  AddCommand(CursorForward(aCols));
+  Result:=Self;
+end;
+
+function TAnsi.Backward(aCols : Word = 1): TAnsi;
+begin
+  AddCommand(CursorBackWard(aCols));
+  Result:=Self;
+end;
+
+function TAnsi.NextLine(aLines : Word = 1): TAnsi;
+begin
+  AddCommand(CursorNextLine(aLines));
+  Result:=Self;
+end;
+
+function TAnsi.PreviousLine(aLines : Word = 1): TAnsi;
+begin
+  AddCommand(CursorPreviousLine(aLines));
+  Result:=Self;
+end;
+
+function TAnsi.Blinking: TAnsi;
+begin
+  SGR('5');
+  Result := Self;
+end;
+
+function TAnsi.Bold: TAnsi;
+begin
+  SGR('1');
+  Result := Self;
+end;
+
+function TAnsi.Faint: TAnsi;
+begin
+  SGR('2');
+  Result := Self;
+end;
+
+function TAnsi.StrikeThrough: TAnsi;
+begin
+  SGR('9');
+  Result := Self;
+end;
+
+function TAnsi.Emit(aClear : Boolean = True) : TAnsi;
+begin
+  Write(ToString); 
+  flush(output);
+  if aClear then
+    Clear(False);
+  Result:=Self;  
+end;
+
+function TAnsi.EmitLn(aClear : Boolean = True) : TAnsi;
+begin
+  WriteLn(ToString); 
+  flush(output);
+  if aClear then
+    Clear(False);
+  Result:=Self;
+end;
+
+Function TAnsi.Clear(aClearText : Boolean = False) : TAnsi;
+
+begin
+  FCmds:='';
+  FSGR:='';
+  if aClearText then
+    FText:='';
+  result:=Self;  
+end;
+
+end.