256 lines
9.6 KiB
ObjectPascal
256 lines
9.6 KiB
ObjectPascal
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;
|
|
FTerrainReadinessButton: TCastleButton;
|
|
FTerrainReadinessStatusLabel: TCastleLabel;
|
|
FTerrainReadinessDetailsLabel: TCastleLabel;
|
|
FFileIOInProgress, FExportInProgress: Boolean;
|
|
FTerrainReadinessInProgress: Boolean;
|
|
procedure RefreshReport;
|
|
procedure UpdateWrapWidth;
|
|
procedure FileIOClick(Sender: TObject);
|
|
procedure TerrainReadinessClick(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,
|
|
GameDiagnosticsTerrainReadiness;
|
|
|
|
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);
|
|
FTerrainReadinessButton := TCastleButton.Create(Self);
|
|
FTerrainReadinessStatusLabel := TCastleLabel.Create(Self);
|
|
FTerrainReadinessDetailsLabel := TCastleLabel.Create(Self);
|
|
|
|
FContent.InsertFront(FExportFeedbackLabel);
|
|
FExportButton.Caption := 'Export Report';
|
|
FExportButton.OnClick := @ExportClick;
|
|
FContent.InsertFront(FExportButton);
|
|
FContent.InsertFront(FTerrainReadinessDetailsLabel);
|
|
FContent.InsertFront(FTerrainReadinessStatusLabel);
|
|
FTerrainReadinessButton.Caption := 'Test MAP/RXX Terrain Readiness';
|
|
FTerrainReadinessButton.OnClick := @TerrainReadinessClick;
|
|
FContent.InsertFront(FTerrainReadinessButton);
|
|
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;
|
|
FTerrainReadinessDetailsLabel.MaxWidth := WrapWidth;
|
|
FExportFeedbackLabel.MaxWidth := WrapWidth;
|
|
end;
|
|
|
|
procedure TDiagnosticsView.RefreshReport;
|
|
var
|
|
State: TDiagnosticReportState;
|
|
Stage: TDiagnosticStageId;
|
|
TerrainStage: TTerrainReadinessDiagnosticStageId;
|
|
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;
|
|
|
|
FTerrainReadinessStatusLabel.Caption := 'MAP/RXX terrain readiness: ' +
|
|
DiagnosticStatusToken(State.TerrainReadiness.Status);
|
|
Details := '';
|
|
for TerrainStage := Low(TTerrainReadinessDiagnosticStageId)
|
|
to High(TTerrainReadinessDiagnosticStageId) do
|
|
begin
|
|
if Details <> '' then Details := Details + LineEnding;
|
|
Details := Details + TerrainReadinessDiagnosticStageIdToken(TerrainStage) + ': ' +
|
|
DiagnosticStatusToken(State.TerrainReadiness.Stages[TerrainStage]);
|
|
end;
|
|
if State.TerrainReadiness.FailureStage.HasValue then
|
|
Details := Details + LineEnding + 'failure_stage: ' +
|
|
TerrainReadinessDiagnosticStageIdToken(
|
|
State.TerrainReadiness.FailureStage.Value);
|
|
if State.TerrainReadiness.Error.Present then
|
|
begin
|
|
Details := Details + LineEnding + 'error class: ' +
|
|
OptionalStringText(State.TerrainReadiness.Error.ClassName);
|
|
Details := Details + LineEnding + 'error message: ' +
|
|
OptionalStringText(State.TerrainReadiness.Error.MessageText);
|
|
end;
|
|
with State.TerrainReadiness.Evidence do
|
|
begin
|
|
if RxTilesLoaded.HasValue then
|
|
Details := Details + LineEnding + 'rx_tiles_loaded: ' +
|
|
OptionalBooleanText(RxTilesLoaded);
|
|
if GeneratedTransitionsReady.HasValue then
|
|
Details := Details + LineEnding + 'generated_transitions_ready: ' +
|
|
OptionalBooleanText(GeneratedTransitionsReady);
|
|
if MapX.HasValue then Details := Details + LineEnding + 'map_x: ' + OptionalInt64Text(MapX);
|
|
if MapY.HasValue then Details := Details + LineEnding + 'map_y: ' + OptionalInt64Text(MapY);
|
|
if GameRev.HasValue then Details := Details + LineEnding + 'game_rev: ' + OptionalInt64Text(GameRev);
|
|
if ExpectedTileCount.HasValue then
|
|
Details := Details + LineEnding + 'expected_tile_count: ' + OptionalInt64Text(ExpectedTileCount);
|
|
if CompletedTileCount.HasValue then
|
|
Details := Details + LineEnding + 'completed_tile_count: ' + OptionalInt64Text(CompletedTileCount);
|
|
end;
|
|
FTerrainReadinessDetailsLabel.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.TerrainReadinessClick(Sender: TObject);
|
|
begin
|
|
if FTerrainReadinessInProgress then Exit;
|
|
FTerrainReadinessInProgress := True;
|
|
FTerrainReadinessButton.Enabled := False;
|
|
try
|
|
RunTerrainReadinessDiagnostic;
|
|
RefreshReport;
|
|
finally
|
|
FTerrainReadinessButton.Enabled := True;
|
|
FTerrainReadinessInProgress := 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.
|