unit SelfTestUI;

interface

uses
  Windows, SysUtils, Types, Classes, ASKernel, ASKernelDefs, ASExecutionContext,
  SelfTest, SyncObjs;

type
  TSelfTestCUI = class
  strict private
    type
      TProgressUpdater = class(TThread)
      protected
        procedure Execute; override;
      end;
    class var
      h: THandle;
      InitialCoord, BottomCoord: TCoord;
      Kernel: TASKernel;
      CSBI: TConsoleScreenBufferInfo;
      Progress: record
        Total,
        Performed,
        Succeeded,
        Failed: Integer;
      end;
      ProgressUpdater: TProgressUpdater;
      ConsoleCS: TCriticalSection;
    class procedure TesterProgress(ATotal, APerformed, ASucceeded, AFailed: Integer);
    class procedure TesterChapter(AChapterNumber: Integer;
      const AChapterName: string);
    class procedure OutputProgress;
    class function KernelCommand(ACommand: Cardinal; AParam1, AParam2, AParam3,
      AParam4: NativeInt): TCmdRes;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  public
    class procedure OutputText(const AText: string);
    class var
      StartTime, PcFreq, CurrentTime: Int64;
    class procedure RunSelfTest;
  end;

implementation

uses
  Math;

{ TKernelDummyObj }

class constructor TSelfTestCUI.ClassCreate;
begin
  ConsoleCS := TCriticalSection.Create;
end;

class destructor TSelfTestCUI.ClassDestroy;
begin
  ConsoleCS.WaitFor;
  FreeAndNil(ConsoleCS);
end;

class function TSelfTestCUI.KernelCommand(ACommand: Cardinal; AParam1,
  AParam2, AParam3, AParam4: NativeInt): TCmdRes;
begin
  case ACommand of
    CLIENT_COMMAND_PRINT:
      begin
        if AParam1 = 0 then
          OutputText(PChar(AParam2));
        Result := True;
      end;
  else
    Result := TCmdRes.Unhandled;
  end;
end;

class procedure TSelfTestCUI.OutputProgress;
var
  Coord: TCoord;
  Amt: Cardinal;
  i: Integer;

const
  WL = 16;
  WR = 10;

  procedure StatItem(const AName, AValue: string); overload;
  var
    S: string;
  begin
    S := (AName + ':  ').PadRight(WL) + AValue.PadLeft(WR);
    WriteConsoleOutputCharacter(h, PChar(S), S.Length, Coord, Amt);
    Inc(Coord.Y);
    Coord.X := 0;
  end;

  procedure StatItem(const AName: string; AValue: Integer); overload;
  begin
    StatItem(AName, IntToPrettyStr(AValue));
  end;

var
  ProgressBar: string;

const
  PBL = WL + WR;
  BoxV = '│';
  Block = '█';

begin

  ConsoleCS.Enter;
  try

    QueryPerformanceCounter(CurrentTime);

    Coord := InitialCoord;

    StatItem('Total', Progress.Total);
    StatItem('Performed', Progress.Performed);
    StatItem('Failed', Progress.Failed);
    StatItem('Elapsed time', FormatFloat('0.0', (CurrentTime - StartTime) / PcFreq) + ' s');

    Inc(Coord.Y);

    if (Progress.Total <> 0) and (PBL >= 5) then
    begin
      ProgressBar := StringOfChar(#32, PBL);
      ProgressBar[1] := BoxV;
      for i := 1 to (PBL - 2) * Min(Progress.Performed, Progress.Total) div Progress.Total do
        ProgressBar[i + 1] := Block;
      ProgressBar[PBL] := BoxV;
    end;

    WriteConsoleOutputCharacter(h, PChar(ProgressBar), PBL, Coord, Amt);

    Inc(Coord.Y);

    SetConsoleCursorPosition(h, BottomCoord);

  finally
    ConsoleCS.Leave;
  end;

end;

class procedure TSelfTestCUI.OutputText(const AText: string);
begin
  ConsoleCS.Enter;
  try
    SetConsoleCursorPosition(h, BottomCoord);
    Writeln(AText);
    if not GetConsoleScreenBufferInfo(h, CSBI) then
      RaiseLastOSError;
    TSelfTestCUI.BottomCoord := CSBI.dwCursorPosition;
    Inc(TSelfTestCUI.BottomCoord.Y);
    TSelfTestCUI.BottomCoord.X := 0;
  finally
    ConsoleCS.Leave;
  end;
end;

class procedure TSelfTestCUI.RunSelfTest;
begin
  if not AllocConsole then
    ExitProcess(1);
  try
    try
      ReportMemoryLeaksOnShutdown := True;
      Kernel := TASKernel.Create;
      try
        h := GetStdHandle(STD_OUTPUT_HANDLE);
        Kernel.OnCommand := TSelfTestCUI.KernelCommand;
        Kernel.Init;
        if not GetConsoleScreenBufferInfo(h, CSBI) then
          RaiseLastOSError;
        TSelfTestCUI.InitialCoord := CSBI.dwCursorPosition;
        TSelfTestCUI.BottomCoord := TSelfTestCUI.InitialCoord;
        Inc(TSelfTestCUI.BottomCoord.Y, 8);
        QueryPerformanceFrequency(PcFreq);
        ProgressUpdater := TProgressUpdater.Create(True);
        try
          QueryPerformanceCounter(StartTime);
          ProgressUpdater.Start;
          SelfTest.Run(Kernel, TSelfTestCUI.TesterProgress, TSelfTestCUI.TesterChapter);
          QueryPerformanceCounter(TSelfTestCUI.CurrentTime);
        finally
          FreeAndNil(ProgressUpdater);
        end;
        OutputProgress;
      finally
        Kernel.Free;
      end;
    except
      on E: Exception do
        Writeln(E.Message);
    end;
  finally
    Writeln(
      'Elapsed time: ',
      FormatFloat('0.000', (CurrentTime - StartTime) / PcFreq) + ' s'
    );
    Writeln('Press Return to exit.');
    Readln;
  end;
end;

class procedure TSelfTestCUI.TesterChapter(AChapterNumber: Integer;
  const AChapterName: string);
begin
  OutputText('CHAPTER ' + AChapterNumber.ToString + ': ' + AChapterName);
end;

class procedure TSelfTestCUI.TesterProgress(ATotal, APerformed, ASucceeded,
  AFailed: Integer);
begin
  Progress.Total := ATotal;
  Progress.Performed := APerformed;
  Progress.Succeeded := ASucceeded;
  Progress.Failed := AFailed;
end;

{ TSelfTestCUI.TProgressUpdater }

procedure TSelfTestCUI.TProgressUpdater.Execute;
begin
  while not Terminated do
  begin
    OutputProgress;
    Sleep(100);
  end;
end;

end.
