kam-mobile/code/GameDiagnosticsView.pas

unit GameDiagnosticsView;

{$mode objfpc}{$H+}{$codepage utf8}

interface

uses
  Classes,
  CastleUIControls, CastleControls, GameDiagnosticsExport;

type
  TDiagnosticsView = class(TCastleView)
  private
    FScroll: TCastleScrollView;
    FContent: TCastleVerticalGroup;
    FFileIOButton: TCastleButton;
    FStatusLabel, FDetailsLabel, FExportFeedbackLabel: TCastleLabel;
    FExportButton: TCastleButton;
    FFileIOInProgress, FExportInProgress: Boolean;
    procedure RefreshReport;
    procedure UpdateWrapWidth;
    procedure FileIOClick(Sender: TObject);
    procedure ExportClick(Sender: TObject);
    procedure ExportComplete(const AOutcome: TDiagnosticExportOutcome);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Start; override;
    procedure Resize; override;
  end;

implementation

uses
  SysUtils, GameDiagnosticsFileIO, GameDiagnosticsReport;

const
  LayoutMargin = 16;
  UnavailableValue = '—';

function OptionalStringText(const AValue: TOptionalString): string;
begin
  if AValue.HasValue then Result := AValue.Value else Result := UnavailableValue;
end;

function OptionalInt64Text(const AValue: TOptionalInt64): string;
begin
  if AValue.HasValue then Result := IntToStr(AValue.Value) else Result := UnavailableValue;
end;

function OptionalBooleanText(const AValue: TOptionalBoolean): string;
begin
  if AValue.HasValue then Result := BoolToStr(AValue.Value, True) else Result := UnavailableValue;
end;

constructor TDiagnosticsView.Create(AOwner: TComponent);
var
  TitleLabel: TCastleLabel;
begin
  inherited;
  FScroll := TCastleScrollView.Create(Self);
  FScroll.FullSize := True;
  FScroll.EnableDragging := True;
  InsertFront(FScroll);

  FContent := TCastleVerticalGroup.Create(Self);
  FContent.Padding := LayoutMargin;
  FContent.Spacing := 8;
  FScroll.ScrollArea.InsertFront(FContent);

  FStatusLabel := TCastleLabel.Create(Self);
  FDetailsLabel := TCastleLabel.Create(Self);
  FExportFeedbackLabel := TCastleLabel.Create(Self);
  FFileIOButton := TCastleButton.Create(Self);
  FExportButton := TCastleButton.Create(Self);

  FContent.InsertFront(FExportFeedbackLabel);
  FExportButton.Caption := 'Export Report';
  FExportButton.OnClick := @ExportClick;
  FContent.InsertFront(FExportButton);
  FContent.InsertFront(FDetailsLabel);
  FContent.InsertFront(FStatusLabel);
  FFileIOButton.Caption := 'Test File I/O';
  FFileIOButton.OnClick := @FileIOClick;
  FContent.InsertFront(FFileIOButton);
  TitleLabel := TCastleLabel.Create(Self);
  TitleLabel.Caption := 'Tests / Diagnostics';
  FContent.InsertFront(TitleLabel);
end;

procedure TDiagnosticsView.UpdateWrapWidth;
var
  WrapWidth: Single;
begin
  WrapWidth := Width - 2 * LayoutMargin;
  if WrapWidth < 1 then WrapWidth := 1;
  FDetailsLabel.MaxWidth := WrapWidth;
  FExportFeedbackLabel.MaxWidth := WrapWidth;
end;

procedure TDiagnosticsView.RefreshReport;
var
  State: TDiagnosticReportState;
  Stage: TDiagnosticStageId;
  Details: string;
begin
  State := CurrentDiagnosticReport;
  FStatusLabel.Caption := 'File I/O: ' + DiagnosticStatusToken(State.FileIO.Status);
  Details := 'selected map relative_path: ' + State.SelectedMap.RelativePath + LineEnding +
    'selected map url: ' + State.SelectedMap.Url;
  for Stage := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
    Details := Details + LineEnding + DiagnosticStageIdToken(Stage) + ': ' +
      DiagnosticStatusToken(State.FileIO.Stages[Stage]);
  if State.FileIO.FailureStage.HasValue then
    Details := Details + LineEnding + 'failure_stage: ' +
      DiagnosticStageIdToken(State.FileIO.FailureStage.Value);
  if State.FileIO.Error.Present then
  begin
    Details := Details + LineEnding + 'error class: ' + OptionalStringText(State.FileIO.Error.ClassName);
    Details := Details + LineEnding + 'error message: ' + OptionalStringText(State.FileIO.Error.MessageText);
  end;
  with State.FileIO.Stream do
  begin
    if Size.HasValue then Details := Details + LineEnding + 'size: ' + OptionalInt64Text(Size);
    if PositionAfterLoad.HasValue then Details := Details + LineEnding + 'position_after_load: ' + OptionalInt64Text(PositionAfterLoad);
    if ReadOffset.HasValue then Details := Details + LineEnding + 'read_offset: ' + OptionalInt64Text(ReadOffset);
    if RequestedReadCount.HasValue then Details := Details + LineEnding + 'requested_read_count: ' + OptionalInt64Text(RequestedReadCount);
    if FirstReadCount.HasValue then Details := Details + LineEnding + 'first_read_count: ' + OptionalInt64Text(FirstReadCount);
    if PositionAfterFirstRead.HasValue then Details := Details + LineEnding + 'position_after_first_read: ' + OptionalInt64Text(PositionAfterFirstRead);
    if SeekBackPosition.HasValue then Details := Details + LineEnding + 'seek_back_position: ' + OptionalInt64Text(SeekBackPosition);
    if SecondReadCount.HasValue then Details := Details + LineEnding + 'second_read_count: ' + OptionalInt64Text(SecondReadCount);
    if PositionAfterSecondRead.HasValue then Details := Details + LineEnding + 'position_after_second_read: ' + OptionalInt64Text(PositionAfterSecondRead);
    if RepeatEqual.HasValue then Details := Details + LineEnding + 'repeat_equal: ' + OptionalBooleanText(RepeatEqual);
  end;
  FDetailsLabel.Caption := Details;
end;

procedure TDiagnosticsView.Start;
begin
  inherited;
  RefreshReport;
end;

procedure TDiagnosticsView.Resize;
begin
  inherited;
  UpdateWrapWidth;
end;

procedure TDiagnosticsView.FileIOClick(Sender: TObject);
begin
  if FFileIOInProgress then Exit;
  FFileIOInProgress := True;
  FFileIOButton.Enabled := False;
  try
    RunFileIODiagnostic;
    RefreshReport;
  finally
    FFileIOButton.Enabled := True;
    FFileIOInProgress := False;
  end;
end;

procedure TDiagnosticsView.ExportClick(Sender: TObject);
begin
  if FExportInProgress then Exit;
  FExportInProgress := True;
  FExportButton.Enabled := False;
  FExportFeedbackLabel.Caption := 'Exporting report…';
  ExportDiagnosticReport(DiagnosticReportJsonSnapshot, @ExportComplete);
end;

procedure TDiagnosticsView.ExportComplete(const AOutcome: TDiagnosticExportOutcome);
begin
  FExportInProgress := False;
  FExportButton.Enabled := True;
  case AOutcome.Kind of
    deokSuccess: FExportFeedbackLabel.Caption := 'Report exported.';
    deokCancel: FExportFeedbackLabel.Caption := 'Export canceled.';
    deokError: if AOutcome.ErrorMessage <> '' then
      FExportFeedbackLabel.Caption := 'Export error: ' + AOutcome.ErrorMessage
    else
      FExportFeedbackLabel.Caption := 'Export error.';
  end;
end;

end.