unit AppConsole;

interface

uses Winapi.Windows, System.SysUtils, System.StrUtils, System.Math, System.SyncObjs,
     System.Generics.Collections, System.RegularExpressions, System.Rtti;

const
  fgConsole     = 0; // Couleur actuelle de la console
  fgDefault     = FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE;
  fgWhite       = FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE or FOREGROUND_INTENSITY;
  fgRed         = FOREGROUND_RED or FOREGROUND_INTENSITY;
  fgDarkRed     = FOREGROUND_RED;
  fgGreen       = FOREGROUND_GREEN or FOREGROUND_INTENSITY;
  fgDarkGreen   = FOREGROUND_GREEN;
  fgBlue        = FOREGROUND_BLUE or FOREGROUND_INTENSITY;
  fgDarkBlue    = FOREGROUND_BLUE;
  fgYellow      = FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_INTENSITY;
  fgDarkYellow  = FOREGROUND_RED or FOREGROUND_GREEN;
  fgPurple      = FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_INTENSITY;
  fgDarkPurple  = FOREGROUND_RED or FOREGROUND_BLUE;
  fgSkyBlue     = FOREGROUND_GREEN or FOREGROUND_BLUE or FOREGROUND_INTENSITY;
  fgDarkSkyBlue = FOREGROUND_GREEN or FOREGROUND_BLUE;

  bgWhite       = BACKGROUND_RED or BACKGROUND_GREEN or BACKGROUND_BLUE or BACKGROUND_INTENSITY;
  bgSilver      = BACKGROUND_RED or BACKGROUND_GREEN or BACKGROUND_BLUE;
  bgRed         = BACKGROUND_RED or BACKGROUND_INTENSITY;
  bgDarkRed     = BACKGROUND_RED;
  bgGreen       = BACKGROUND_GREEN or BACKGROUND_INTENSITY;
  bgDarkGreen   = BACKGROUND_GREEN;
  bgBlue        = BACKGROUND_BLUE or BACKGROUND_INTENSITY;
  bgDarkBlue    = BACKGROUND_BLUE;
  bgYellow      = BACKGROUND_RED or BACKGROUND_GREEN or BACKGROUND_INTENSITY;
  bgDarkYellow  = BACKGROUND_RED or BACKGROUND_GREEN;
  bgPurple      = BACKGROUND_RED or BACKGROUND_BLUE or BACKGROUND_INTENSITY;
  bgDarkPurple  = BACKGROUND_RED or BACKGROUND_BLUE;
  bgSkyBlue     = BACKGROUND_GREEN or BACKGROUND_BLUE or BACKGROUND_INTENSITY;
  bgDarkSkyBlue = BACKGROUND_GREEN or BACKGROUND_BLUE;

type
  TConsoleText = record
    Text  :TValue;
    Color :word;
  end;

// Version courte pour retourner un TConsoleText
function ct(const aValue :TValue; aColor :word = fgConsole) :TValue;

type
  TCoordHelper = record helper for TCoord
    function Offset(dX, dY :smallint) :TCoord;
    constructor Create(aX, aY :smallint);
  end;

  Console = class abstract
  private type
    TTask        = TPair<integer, TCoord>;
    TTasks       = class(TDictionary<integer, TCoord>);
    TTaskState   = (tsSuccess, tsError, tsAborted);
    TTaskAlign   = (taLeft, taAnimeLeft, taCenter, taRight);
    TTaskFunc    = reference to function(aID :integer) :boolean;
    TBoxStyle    = (bsBorder1, bsBorder2);
    TTitleStyle  = (tsUnderline1, tsUnderline2, tsLine1, tsLine2);
    TConsoleOption = (coClearReadLn, coClearWaitInput);
    TConsoleOptions = set of TConsoleOption;
  private
    const
      TextSplitFmt = '(.{0,%d})(?:\s|$)';
    class var
      Tasks   :TTasks;
      TaskIDs :integer;

      FLock         :TCriticalSection;
      FLineLength   :integer;
      FAnimate      :boolean;
      FAnimateColor :word;
      FOptions      :TConsoleOptions;
      FTaskTexts    :array[TTaskState] of string;

      AnimeTimer    :PTPTimer;
      AnimeFlipFlop :boolean;

    class procedure   StartAnimeTimer;
    class procedure   StopAnimeTimer;
    class procedure   DoWriteAnime(aCoord :TCoord);
    class procedure   WriteAnime(aInstance :PTPCallbackInstance; aData: pointer; aTimer :PTPTimer); stdcall; static;

    class function    ConcateValues(aValues :TArray<TValue>): string;
    class function    DoWrite(const aValues: TArray<TValue>; aColor :word; aFromWriteLn :boolean = FALSE; aPadding :byte = 0) :integer; overload; inline;
    class procedure   DoWrite(aCoord :TCoord; const aValues :TArray<TValue>; aColor :word); overload; inline;
    class procedure   DoWriteColor(const aValue: string; aColor :word; aPadding :byte; aWriteLn :boolean);
    class function    GetWriteColor(aColor :word) :word;
    class function    GetValueText(aValue :TValue) :string;
    class function    GetValueColor(aValue :TValue; aDefault :word = fgConsole) :word;
    class function    IsConsoleText(aValue :TValue) :boolean;
    class function    ToArray(aValue :TValue) :TArray<TValue>;
    class function    GetInfo :TConsoleScreenBufferInfo;
    class procedure   ShowCursor(aVisible :boolean);
    class function    StatusLen :integer;
    class procedure   Sync(aProc :TProc);

    class function    GetCodePage: cardinal; static;
    class procedure   SetCodePage(const Value: cardinal); static;
    class function    GetTitle: string; static;
    class procedure   SetTitle(const Value: string); static;
    class procedure   SetLineLength(const Value: integer); static;
    class function    GetSize: TCoord; static;
    class function    GetPosition: TCoord; static;
    class procedure   SetPosition(const Value: TCoord); static;
    class function    GetTaskText(const aState :TTaskState): string; static;
    class procedure   SetTaskText(const aState :TTaskState; const Value: string); static;
    class function    GetColor: word; static;
    class procedure   SetColor(const Value: word); overload; static;
    class procedure   AfterWriteOffset(aOriginalCoord :TCoord; aCount: byte);
    class function    MakeMultiLines(const aValue: string; aMaxLength: integer): TArray<string>;
    class function    GetInput: THandle; static; inline;
    class function    GetOutput: THandle; static; inline;

  public
    class property    Animate :boolean read FAnimate write FAnimate;
    class property    AnimateColor :word read FAnimateColor write FAnimateColor;
    class property    CodePage :cardinal read GetCodePage write SetCodePage;
    class property    Color :word read GetColor write SetColor;
    class property    Input :THandle read GetInput;
    class property    LineLength :integer read FLineLength write SetLineLength;
    class property    Options :TConsoleOptions read FOptions write FOptions;
    class property    Output :THandle read GetOutput;
    class property    Position :TCoord read GetPosition write SetPosition;
    class property    Size :TCoord read GetSize;
    class property    TaskAborted :string index tsAborted read GetTaskText write SetTaskText;
    class property    TaskError :string index tsError read GetTaskText write SetTaskText;
    class property    TaskSuccess :string index tsSuccess read GetTaskText write SetTaskText;
    class property    Title :string read GetTitle write SetTitle;

    class procedure   Clear(aCoord :TCoord; aLen :integer = MAXINT); overload;
    class procedure   Clear; overload;

    class function    WaitInput :AnsiChar; overload;
    class function    WaitInput(const aValue :TValue) :AnsiChar; overload;
    class function    WaitInput(aOptions :TSysCharSet) :AnsiChar; overload;
    class function    WaitInput(aOptions :TSysCharSet; const aValue :TValue) :AnsiChar; overload;
    class function    WaitInput(aOptions :TSysCharSet; const aValues :TArray<TValue>) :AnsiChar; overload;

    class function    ReadLn(const aValue :TValue; aInputColor :word = fgWhite) :string; overload;
    class function    ReadLn(const aValues :TArray<TValue>; aInputColor :word = fgWhite) :string; overload;
    class function    ReadPassword(const aValue :TValue) :string; overload;
    class function    ReadPassword(const aValues :TArray<TValue>) :string; overload;

    class procedure   Write(const aValue :TValue); overload;
    class procedure   Write(const aValue :TValue; aColor :word); overload;
    class procedure   Write(const aValues :TArray<TValue>); overload;
    class procedure   Write(aCoord :TCoord; const aValue :TValue; aColor :word); overload;
    class procedure   Write(aCoord :TCoord; const aValues :TArray<TValue>); overload;
    class procedure   Write(aCoord :TCoord; const aValue :TValue); overload;
    class procedure   WriteLn(const aValue :TValue); overload;
    class procedure   WriteLn(const aValue :TValue; aColor :word); overload;
    class procedure   WriteLn(const aValues :TArray<TValue>); overload;
    class procedure   WriteLn; overload;
    class procedure   WriteBox(const aValue :TValue; aBorderColor :word = fgConsole; aStyle :TBoxStyle = bsBorder1); overload;
    class procedure   WriteBox(const aValues :TArray<TValue>; aBorderColor :word = fgConsole; aStyle :TBoxStyle = bsBorder1); overload;
    class procedure   WriteTitle(const aValue :TValue; aLineColor :word = fgConsole; aStyle :TTitleStyle = tsUnderline1; aSpaceAfter: boolean = TRUE); overload;
    class procedure   WriteTitle(const aValues :TArray<TValue>; aLineColor :word = fgConsole; aStyle :TTitleStyle = tsUnderline1; aSpaceAfter: boolean = TRUE); overload;
    class procedure   WriteRule(aColor :word = fgConsole; aChar :char = '─');
    class function    WriteTask(const aValue :TValue; const aFunc :TTaskFunc) :boolean; overload;
    class function    WriteTask(const aValue :TValue; aColor: word; const aFunc :TTaskFunc) :boolean; overload;
    class function    WriteTask(const aValues :TArray<TValue>; const aFunc :TTaskFunc) :boolean; overload;
    class procedure   WriteTaskStep(aID :integer; const aValue :TValue; aAlign :TTaskAlign = taAnimeLeft);

    class Constructor Create;
    class destructor  Destroy;
  end;

implementation

function ct(const aValue :TValue; aColor :word) :TValue;
var
  ConsoleText :TConsoleText;
begin
  ConsoleText.Text  := aValue;
  ConsoleText.Color := aColor;
  Result := TValue.From<TConsoleText>(ConsoleText);
end;

{ TCoordHelper }

constructor TCoordHelper.Create(aX, aY: smallint);
begin
  X := aX;
  Y := aY;
end;

function TCoordHelper.Offset(dX, dY: smallint): TCoord;
begin
  Result.X := X +dX;
  Result.Y := Y +dY;
end;

{ Console }

class constructor Console.Create;
begin
  Tasks      := TTasks.Create;
  FLock      := TCriticalSection.Create;
  AnimeTimer := CreateThreadpoolTimer(@WriteAnime, nil, nil);

  FAnimate      := TRUE;
  FAnimateColor := fgPurple;

  FTaskTexts[tsSuccess] := 'SUCCES';
  FTaskTexts[tsError]   := 'ERREUR';
  FTaskTexts[tsAborted] := 'ANNULE';

  ShowCursor(FALSE);

  if IsConsole then
    FLineLength := Size.X;
end;

class destructor Console.Destroy;
begin
  WaitForThreadpoolTimerCallbacks(AnimeTimer, TRUE);
  CloseThreadpoolTimer(AnimeTimer);

  SetColor(fgDefault);

  Tasks.Free;
  FLock.Free;
end;

class procedure Console.Sync(aProc: TProc);
begin
  FLock.Enter;
  try
    aProc;
  finally
    FLock.Release;
  end;
end;

class function Console.ToArray(aValue: TValue): TArray<TValue>;
begin
  if IsConsoleText(aValue)
  then Result := [aValue]
  else Result := [ct(aValue)];
end;

class function Console.GetCodePage: cardinal;
begin
  Result := GetConsoleOutputCP;
end;

class procedure Console.SetCodePage(const Value: cardinal);
begin
  SetConsoleOutputCP(Value);
end;

class function Console.GetColor: word;
begin
  Result := GetInfo.wAttributes;
end;

class procedure Console.SetColor(const Value: word);
begin
  SetConsoleTextAttribute(Output, Value);
end;

class function Console.GetInfo: TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(Output, Result);
end;

class function Console.GetInput: THandle;
begin
  Result := GetStdHandle(STD_INPUT_HANDLE);

  if Result = 0 then
  begin
    AllocConsole;
    FLineLength := Size.X;
    Result := GetStdHandle(STD_INPUT_HANDLE);
  end;
end;

class function Console.GetOutput: THandle;
begin
  Result := GetStdHandle(STD_OUTPUT_HANDLE);

  if Result = 0 then
  begin
    AllocConsole;
    FLineLength := Size.X;
    Result := GetStdHandle(STD_OUTPUT_HANDLE);
  end;
end;

class function Console.GetTitle: string;
begin
  SetLength(Result, MAX_PATH);
  SetLength(Result, GetConsoleTitle(PChar(Result), MAX_PATH));
end;

class function Console.ConcateValues(aValues: TArray<TValue>): string;
begin
  Result := '';

  for var Value in aValues do
    Result := Result +GetValueText(Value);
end;

class function Console.GetValueColor(aValue: TValue; aDefault :word): word;
begin
  if IsConsoleText(aValue)
  then Result := aValue.AsType<TConsoleText>.Color
  else Result := aDefault;
end;

class function Console.GetValueText(aValue: TValue): string;
begin
  if IsConsoleText(aValue)
  then Result := aValue.AsType<TConsoleText>.Text.ToString
  else Result := aValue.ToString;
end;

class function Console.GetWriteColor(aColor: word): word;
begin
  Result := IfThen(aColor = fgConsole, GetColor, aColor);
end;

class function Console.IsConsoleText(aValue: TValue): boolean;
begin
  Result := (aValue.Kind = tkRecord) and (aValue.TypeInfo = TypeInfo(TConsoleText));
end;

class function Console.MakeMultiLines(const aValue: string; aMaxLength: integer): TArray<string>;
begin
  Result := [];

  // Remplissage si X > 0 pour facilité l'expression régulière
  const Text = StringOfChar('-', GetPosition.X) +aValue;

  for var Match in TRegEx.Matches(Text.Replace(#13#10, #10).Replace(#13, #10), Format(TextSplitFmt, [aMaxLength])) do
    Result := Result +[Match.Value];

  if Length(Result) > 0 then
    Result[0] := Result[0].Remove(0,  GetPosition.X);
end;

class procedure Console.SetTitle(const Value: string);
begin
  SetConsoleTitle(PChar(Value));
end;

class procedure Console.ShowCursor(aVisible: boolean);
var
  CursorInfo :TConsoleCursorInfo;
begin
  CursorInfo.dwSize   := 1;
  CursorInfo.bVisible := aVisible;
  SetConsoleCursorInfo(Output, CursorInfo);
end;

class procedure Console.DoWriteAnime(aCoord: TCoord);
begin
  DoWrite(aCoord, [IfThen(AnimeFlipFlop, '>', ' ')], FAnimateColor);
end;

class procedure Console.WriteAnime(aInstance: PTPCallbackInstance; aData: pointer; aTimer: PTPTimer);
begin
  sync(procedure
       begin
         AnimeFlipFlop := not AnimeFlipFlop;

         for var Task in Tasks do
           DoWriteAnime(Task.Value);
       end);
end;

class procedure Console.WriteBox(const aValue: TValue; aBorderColor: word; aStyle: TBoxStyle);
begin
  WriteBox(ToArray(aValue), aBorderColor, aStyle)
end;

class procedure Console.WriteBox(const aValues: TArray<TValue>; aBorderColor: word; aStyle: TBoxStyle);
var
  Border :TArray<char>;
begin
  sync(procedure
       begin
         if Position.X > 0 then
           System.WriteLn;

         const BorderColor = GetWriteColor(aBorderColor);

         case aStyle of
           bsBorder1: Border := ['─', '│', '┌', '┐', '└', '┘'];
           bsBorder2: Border := ['═', '║', '╔', '╗', '╚', '╝'];
         end;

         System.WriteLn;
         const Count = DoWrite(aValues, GetColor, FALSE, 2) +1;
         System.WriteLn;

         var Coord := GetPosition.Offset(-Position.X, -(Count +1));

         DoWrite(Coord, [Border[2] +StringOfChar(Border[0], FLineLength -2) +Border[3]], BorderColor);

         for var i := 1 to Count do
         begin
           inc(Coord.Y);
           DoWrite(Coord, [Border[1]], BorderColor);
           DoWrite(TCoord.Create(FLineLength -1, Coord.Y), [Border[1]], BorderColor);
         end;

         inc(Coord.Y);
         DoWrite(Coord, [Border[4] +StringOfChar(Border[0], FLineLength -2) +Border[5]], BorderColor);
         System.WriteLn;
         System.WriteLn;
       end);
end;

class procedure Console.DoWriteColor(const aValue: string; aColor: word; aPadding :byte; aWriteLn :boolean);
begin
  const Text = Format('%*s', [aValue.Length +IfThen(GetPosition.X = 0, aPadding), aValue]);
  const PrevColor = GetColor;
  SetColor(aColor);

  if aWriteLn
  then System.WriteLn(Text)
  else System.Write(Text);

  SetColor(PrevColor);
end;

class function Console.DoWrite(const aValues: TArray<TValue>; aColor :word; aFromWriteLn :boolean; aPadding: byte): integer;
begin
  const Coord = GetPosition;

  Result := Max(0, Length(MakeMultiLines(ConcateValues(aValues), FLineLength -2 *aPadding)) -1);  // Retourne le nombre de lignes incrémentées

  for var i := 0 to High(aValues) do
  begin
    const Text = GetValueText(aValues[i]);
    const Color = GetValueColor(aValues[i], aColor);
    const Texts = MakeMultiLines(Text, FLineLength -2 *aPadding);

    if Length(Texts) > 0 then
    begin
      for var j := 0 to High(Texts) -1 do
        DoWriteColor(Texts[j].TrimRight, GetWriteColor(Color), aPadding, TRUE);

      DoWriteColor(Texts[High(Texts)], GetWriteColor(Color), aPadding, FALSE);
    end;
  end;

  AfterWriteOffset(Coord, Result +IfThen(aFromWriteLn, 1));
end;

class procedure Console.DoWrite(aCoord: TCoord; const aValues: TArray<TValue>; aColor: word);
begin
  const Coord = GetPosition;
  SetPosition(aCoord);
  DoWrite(aValues, aColor);
  SetPosition(Coord);
end;

class procedure Console.StartAnimeTimer;
const
  DueTime :UInt64 = 0;
begin
  if FAnimate and not IsThreadpoolTimerSet(AnimeTimer) then
    SetThreadpoolTimerEx(AnimeTimer, @DueTime, 750, 0);
end;

class procedure Console.StopAnimeTimer;
begin
  if IsThreadpoolTimerSet(AnimeTimer) and (Tasks.Count = 0) then
    SetThreadpoolTimerEx(AnimeTimer, nil, 0, 0);
end;

class function Console.StatusLen: integer;
begin
  Result := MaxIntValue([FTaskTexts[tsSuccess].Length,
                         FTaskTexts[tsError].Length,
                         FTaskTexts[tsAborted].Length]);
end;

class function Console.GetPosition: TCoord;
begin
  Result := GetInfo.dwCursorPosition;
end;

class procedure Console.SetPosition(const Value: TCoord);
begin
  SetConsoleCursorPosition(Output, Value);
end;

class function Console.GetSize: TCoord;
begin
  Result := GetInfo.dwSize;
  if not IsConsole then
    Dec(Result.X);
end;

class function Console.GetTaskText(const aState :TTaskState): string;
begin
  Result := FTaskTexts[aState];
end;

class procedure Console.AfterWriteOffset(aOriginalCoord :TCoord; aCount: byte);
begin
  const dY = (aOriginalCoord.Y +aCount) -Size.Y +1;

  if dY > 0 then
    for var Task in Tasks do
    begin
      var Coord := Task.Value;
      Dec(Coord.Y, dY);
      Tasks.AddOrSetValue(Task.Key, Coord);
    end;
end;

class procedure Console.SetTaskText(const aState :TTaskState; const Value: string);
begin
  FTaskTexts[aState] := Value;
end;

class procedure Console.SetLineLength(const Value: integer);
begin
  FLineLength := Min(Value, Size.X -1);
end;

class procedure Console.Clear(aCoord: TCoord; aLen: integer);
var
  Written :cardinal;
begin
  FillConsoleOutputCharacterA(Output, ' ', aLen, aCoord, Written);
  FillConsoleOutputAttribute(Output, GetColor, aLen, aCoord, Written);
  SetPosition(aCoord);
end;

class procedure Console.Clear;
begin
  SetPosition(TCoord.Create(0, 0));
  Clear(Position);
end;

class function Console.ReadLn(const aValue: TValue; aInputColor: word): string;
begin
  Result := ReadLn([ct(aValue)], aInputColor);
end;

class function Console.ReadLn(const aValues: TArray<TValue>; aInputColor: word): string;
var
  Read :cardinal;
begin
  ShowCursor(TRUE);
  const PrevColor = GetColor;

  try
    const Count = DoWrite(aValues, GetColor);

    SetColor(aInputColor);

    SetLength(Result, MAX_PATH);

    ReadConsole(Input, PChar(Result), MAX_PATH, Read, nil);
    SetLength(Result, Read -2);

    if coClearReadLn in Options then
    begin
      SetPosition(TCoord.Create(0, GetPosition.Y -Count -1));
      Clear(GetPosition);
    end;

  finally
    SetColor(PrevColor);
    ShowCursor(FALSE);
  end;
end;

class function Console.ReadPassword(const aValue: TValue): string;
begin
  Result := ReadPassword(ToArray(aValue));
end;

class function Console.ReadPassword(const aValues: TArray<TValue>): string;
var
  Mode :dword;
begin
  GetConsoleMode(Input, Mode);
  SetConsoleMode(Input, Mode and not ENABLE_ECHO_INPUT);
  Result := ReadLn(aValues, GetColor);
  SetConsoleMode(Input, Mode);
end;

class procedure Console.Write(const aValue: TValue);
begin
  Write(ToArray(aValue));
end;

class procedure Console.Write(const aValues: TArray<TValue>);
begin
  Sync(procedure
       begin
          DoWrite(aValues, GetColor);
       end);
end;

class procedure Console.WriteRule(aColor: word; aChar: char);
begin
  Sync(procedure
       begin
         if Position.X > 0 then
           WriteLn;

         DoWrite([StringOfChar(aChar, FLineLength)], GetWriteColor(aColor));
         WriteLn;
       end);
end;

class function Console.WriteTask(const aValue: TValue; const aFunc: TTaskFunc) :boolean;
begin
  Result := WriteTask(ToArray(aValue), aFunc)
end;

class function Console.WriteTask(const aValues: TArray<TValue>; const aFunc: TTaskFunc): boolean;
const
  Colors : array[TTaskState] of word = (fgDarkGreen, fgDarkRed, fgDarkYellow);
var
  State  :TTaskState;
begin
  const ID = TInterlocked.Increment(TaskIDs);

  StartAnimeTimer;

  try
    Sync(procedure
         begin
           var Coord := GetPosition;
           var Len := 0;

           for var i := 0 to High(aValues) do
             inc(Len, GetValueText(aValues[i]).Length);

           const Sep = StringOfChar('.', LineLength -Coord.X -StatusLen -Len -2);

           Coord.X := LineLength -StatusLen -1;

           Tasks.Add(ID, Coord);

           for var i := 0 to High(aValues) do
             DoWrite([aValues[i]], GetColor);

           WriteLn([ct(Format('%s[%*.s]', [Sep, StatusLen, '']))]);

           if FAnimate then
           begin
             Tasks.TryGetValue(ID, Coord);
             DoWriteAnime(Coord);
           end;
         end);

    try
      if aFunc(ID)
      then State := tsSuccess
      else State := tsError;

    except
      on E:EAbort do
        State := tsAborted;

      on E:Exception do
      begin
        DoWrite([E.Message], fgRed, TRUE);
        State := tsError;
      end;
    end;

    Sync(procedure
         begin
           const Coord = Tasks.ExtractPair(ID).Value;
           const Text = FTaskTexts[State].Trim;

           if Length(Text) > 0 then
             DoWrite(Coord, [Format('%-*.s', [StatusLen, Text])], Colors[State]);
         end);

  finally
    Result := State = tsSuccess;
    StopAnimeTimer;
  end;
end;

class function Console.WriteTask(const aValue: TValue; aColor: word; const aFunc: TTaskFunc): boolean;
begin
  if IsConsoleText(aValue)
  then WriteTask(aValue, aFunc)
  else WriteTask(ct(aValue, aColor), aFunc);
end;

class procedure Console.WriteTaskStep(aID: integer; const aValue: TValue; aAlign :TTaskAlign);
begin
  sync(procedure
       var
         Coord :TCoord;
       begin
         if Tasks.TryGetValue(aID, Coord) then
         begin
           var Pad := IfThen(FAnimate and (aAlign <> taLeft), 1);
           const Len = StatusLen -Pad;
           const Color = GetValueColor(aValue);
           var Text := GetValueText(aValue).Substring(0, Len);

           inc(Coord.X, Pad);

           case aAlign of
             taLeft,
             taAnimeLeft : Text := Format('%-*.s', [Len, Text]);
             taRight     : Text := Format('%*.s', [Len, Text]);
             taCenter    : begin
                             Pad  := (Len -Text.Length) div 2;
                             Text := Format('%*.s%*.s', [Pad +Text.Length, Text, Len -Text.Length -Pad, '']);
                           end;
           end;

           DoWrite(Coord, [Text], Color);
         end;
       end);
end;

class procedure Console.WriteTitle(const aValue: TValue; aLineColor: word; aStyle: TTitleStyle; aSpaceAfter: boolean);
begin
  WriteTitle(ToArray(aValue), aLineColor, aStyle, aSpaceAfter);
end;

class procedure Console.WriteTitle(const aValues: TArray<TValue>; aLineColor: word; aStyle: TTitleStyle; aSpaceAfter: boolean);
begin
  sync(procedure
       begin
         var Len := 0;
         const LineChar = IfThen(aStyle in [tsUnderline1, tsLine1], '─', '═');

         if aStyle in [tsUnderline1, tsUnderline2] then
         begin
           var Text := ConcateValues(aValues);
           const Matches = TRegEx.Matches(Text, Format(TextSplitFmt , [FLineLength]));

           for var Match in Matches do
             Len := Max(Match.Value.Length, Len);
         end
         else
         begin
           Len := FLineLength;
           WriteLn;
         end;

         var Coord := GetPosition;
         WriteLn;

         const Count = DoWrite(aValues, GetColor) +1;
         inc(Coord.Y, Count +1);

         DoWrite(Coord, [StringOfChar(LineChar.Chars[0], Len)], GetWriteColor(aLineColor));
         SetPosition(Coord.Offset(0, IfThen(aSpaceAfter, 2, 1)));
       end);
end;

class procedure Console.Write(aCoord: TCoord; const aValue: TValue);
begin
  Write(aCoord, ToArray(aValue));
end;

class procedure Console.Write(aCoord: TCoord; const aValue: TValue; aColor: word);
begin
  Write(aCoord, ct(aValue, aColor));
end;

class procedure Console.Write(aCoord: TCoord; const aValues: TArray<TValue>);
begin
  sync(procedure
       begin
         DoWrite(aCoord, aValues, GetColor);
       end);
end;

class procedure Console.Write(const aValue: TValue; aColor: word);
begin
  if IsConsoleText(aValue)
  then Write(aValue)
  else Write(ct(aValue, aColor));
end;

class procedure Console.WriteLn(const aValue: TValue);
begin
  WriteLn(ToArray(aValue));
end;

class procedure Console.WriteLn(const aValues: TArray<TValue>);
begin
  Sync(procedure
       begin
         DoWrite(aValues, GetColor, TRUE);
         System.WriteLn;
       end);
end;

class procedure Console.WriteLn;
begin
  Writeln(['']);
end;

class procedure Console.WriteLn(const aValue: TValue; aColor: word);
begin
  if IsConsoleText(aValue)
  then WriteLn(aValue)
  else WriteLn(ct(aValue, aColor));
end;

class function Console.WaitInput(aOptions: TSysCharSet; const aValue :TValue): AnsiChar;
begin
  Result := WaitInput(aOptions, ToArray(aValue));
end;

class function Console.WaitInput(const aValue: TValue): AnsiChar;
begin
  Result := WaitInput([#1..#255], aValue);
end;

class function Console.WaitInput: AnsiChar;
begin
  Result := WaitInput([#1..#255]);
end;

class function Console.WaitInput(aOptions: TSysCharSet): AnsiChar;
begin
  Result := WaitInput(aOptions, '');
end;

class function Console.WaitInput(aOptions: TSysCharSet; const aValues: TArray<TValue>): AnsiChar;
var
  Rec  :TInputRecord;
  Read :cardinal;
begin
//    FlushConsoleInputBuffer(Input);  // Ne fonctionne pas comme attendu -> problème si ReadLn + WaitInput

  var Opts :TSysCharSet := [];

  for var Opt in aOptions do
    Include(Opts, UpCase(Opt));

  const Count = DoWrite(aValues, GetColor);

  repeat
    ReadConsoleInput(Input, Rec, 1, Read);
    Result := UpCase(Rec.Event.KeyEvent.AsciiChar);
  until (Rec.EventType = KEY_EVENT) and not Rec.Event.KeyEvent.bKeyDown and CharInSet(Result, Opts);

  if coClearWaitInput in Options then
  sync(procedure
       begin
         SetPosition(TCoord.Create(0, GetPosition.Y -Count));
         Clear(GetPosition);
       end);
end;

end.