776 lines
32 KiB
ObjectPascal
776 lines
32 KiB
ObjectPascal
unit GameDiagnosticsView;
|
|
|
|
{$mode objfpc}{$H+}{$codepage utf8}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
CastleUIControls, CastleControls, GameDiagnosticsExport,
|
|
GameDiagnosticsGraphics_Mobile;
|
|
|
|
type
|
|
TDiagnosticsView = class(TCastleView)
|
|
private
|
|
type
|
|
TGraphicsRequest = (grReadiness, grTextureLifecycle, grVisibleDraw);
|
|
|
|
private
|
|
FActionRegion: TCastleUserInterface;
|
|
FScroll: TCastleScrollView;
|
|
FContent: TCastleVerticalGroup;
|
|
FFileIOButton: TCastleButton;
|
|
FStatusLabel, FDetailsLabel, FExportFeedbackLabel: TCastleLabel;
|
|
FTitleLabel, FGraphicsFeedbackLabel: TCastleLabel;
|
|
FExportButton: TCastleButton;
|
|
FGraphicsReadinessButton, FTextureButton, FVisible2DButton: TCastleButton;
|
|
FTerrainReadinessButton: TCastleButton;
|
|
FTerrainReadinessStatusLabel: TCastleLabel;
|
|
FTerrainReadinessDetailsLabel: TCastleLabel;
|
|
FGraphicsReadinessStatusLabel, FGraphicsReadinessDetailsLabel: TCastleLabel;
|
|
FTextureStatusLabel, FTextureDetailsLabel: TCastleLabel;
|
|
FVisible2DStatusLabel, FVisible2DDetailsLabel: TCastleLabel;
|
|
FFileIOInProgress, FExportInProgress: Boolean;
|
|
FTerrainReadinessInProgress: Boolean;
|
|
FGraphicsSession: TGraphicsDiagnosticSession;
|
|
FGraphicsCompletionNotifiedDuringDispatch: Boolean;
|
|
procedure RefreshReport;
|
|
procedure UpdateWrapWidth;
|
|
procedure UpdateGraphicsFeedback(const AText: string);
|
|
procedure DispatchGraphicsRequest(const ARequest: TGraphicsRequest);
|
|
procedure GraphicsReadinessClick(Sender: TObject);
|
|
procedure GraphicsTextureClick(Sender: TObject);
|
|
procedure GraphicsVisible2DClick(Sender: TObject);
|
|
procedure GraphicsResultPublished(Sender: TObject);
|
|
procedure FileIOClick(Sender: TObject);
|
|
procedure TerrainReadinessClick(Sender: TObject);
|
|
procedure ExportClick(Sender: TObject);
|
|
procedure ExportComplete(const AOutcome: TDiagnosticExportOutcome);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Start; override;
|
|
procedure Resize; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Math, 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);
|
|
begin
|
|
inherited;
|
|
FGraphicsSession := nil;
|
|
FGraphicsCompletionNotifiedDuringDispatch := False;
|
|
FScroll := TCastleScrollView.Create(Self);
|
|
FScroll.FullSize := False;
|
|
FScroll.EnableDragging := True;
|
|
InsertFront(FScroll);
|
|
|
|
FActionRegion := TCastleUserInterface.Create(Self);
|
|
FActionRegion.FullSize := False;
|
|
InsertFront(FActionRegion);
|
|
|
|
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);
|
|
FGraphicsFeedbackLabel := TCastleLabel.Create(Self);
|
|
FFileIOButton := TCastleButton.Create(Self);
|
|
FFileIOButton.AutoSize := False;
|
|
FExportButton := TCastleButton.Create(Self);
|
|
FExportButton.AutoSize := False;
|
|
FGraphicsReadinessButton := TCastleButton.Create(Self);
|
|
FGraphicsReadinessButton.AutoSize := False;
|
|
FGraphicsReadinessButton.Enabled := True;
|
|
FGraphicsReadinessButton.OnClick := @GraphicsReadinessClick;
|
|
FTextureButton := TCastleButton.Create(Self);
|
|
FTextureButton.AutoSize := False;
|
|
FTextureButton.Enabled := True;
|
|
FTextureButton.OnClick := @GraphicsTextureClick;
|
|
FVisible2DButton := TCastleButton.Create(Self);
|
|
FVisible2DButton.AutoSize := False;
|
|
FVisible2DButton.Enabled := True;
|
|
FVisible2DButton.OnClick := @GraphicsVisible2DClick;
|
|
FTerrainReadinessButton := TCastleButton.Create(Self);
|
|
FTerrainReadinessButton.AutoSize := False;
|
|
FTerrainReadinessStatusLabel := TCastleLabel.Create(Self);
|
|
FTerrainReadinessDetailsLabel := TCastleLabel.Create(Self);
|
|
FGraphicsReadinessStatusLabel := TCastleLabel.Create(Self);
|
|
FGraphicsReadinessDetailsLabel := TCastleLabel.Create(Self);
|
|
FTextureStatusLabel := TCastleLabel.Create(Self);
|
|
FTextureDetailsLabel := TCastleLabel.Create(Self);
|
|
FVisible2DStatusLabel := TCastleLabel.Create(Self);
|
|
FVisible2DDetailsLabel := TCastleLabel.Create(Self);
|
|
|
|
FContent.InsertFront(FStatusLabel);
|
|
FContent.InsertFront(FDetailsLabel);
|
|
FContent.InsertFront(FTerrainReadinessStatusLabel);
|
|
FContent.InsertFront(FTerrainReadinessDetailsLabel);
|
|
FContent.InsertFront(FGraphicsReadinessStatusLabel);
|
|
FContent.InsertFront(FGraphicsReadinessDetailsLabel);
|
|
FContent.InsertFront(FTextureStatusLabel);
|
|
FContent.InsertFront(FTextureDetailsLabel);
|
|
FContent.InsertFront(FVisible2DStatusLabel);
|
|
FContent.InsertFront(FVisible2DDetailsLabel);
|
|
|
|
FTitleLabel := TCastleLabel.Create(Self);
|
|
FTitleLabel.Caption := 'Tests / Diagnostics';
|
|
FActionRegion.InsertFront(FTitleLabel);
|
|
FGraphicsFeedbackLabel.Caption := '';
|
|
FActionRegion.InsertFront(FGraphicsFeedbackLabel);
|
|
FActionRegion.InsertFront(FExportFeedbackLabel);
|
|
FExportButton.Caption := 'Export Report';
|
|
FExportButton.OnClick := @ExportClick;
|
|
FActionRegion.InsertFront(FExportButton);
|
|
FGraphicsReadinessButton.Caption := 'Test Graphics Readiness' + LineEnding + 'Current Surface';
|
|
FActionRegion.InsertFront(FGraphicsReadinessButton);
|
|
FTextureButton.Caption := 'Test GPU Texture' + LineEnding + 'Lifecycle / Selection';
|
|
FActionRegion.InsertFront(FTextureButton);
|
|
FVisible2DButton.Caption := 'Test Visible 2D' + LineEnding + 'RGBA / Brightness';
|
|
FActionRegion.InsertFront(FVisible2DButton);
|
|
FTerrainReadinessButton.Caption := 'Test MAP/RXX Terrain Readiness';
|
|
FTerrainReadinessButton.OnClick := @TerrainReadinessClick;
|
|
FActionRegion.InsertFront(FTerrainReadinessButton);
|
|
FFileIOButton.Caption := 'Test File I/O';
|
|
FFileIOButton.OnClick := @FileIOClick;
|
|
FActionRegion.InsertFront(FFileIOButton);
|
|
end;
|
|
|
|
destructor TDiagnosticsView.Destroy;
|
|
begin
|
|
if FGraphicsSession <> nil then
|
|
begin
|
|
FGraphicsSession.OnResultPublished := nil;
|
|
FreeAndNil(FGraphicsSession);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDiagnosticsView.UpdateGraphicsFeedback(const AText: string);
|
|
begin
|
|
if FGraphicsFeedbackLabel.Caption = AText then Exit;
|
|
FGraphicsFeedbackLabel.Caption := AText;
|
|
UpdateWrapWidth;
|
|
end;
|
|
|
|
procedure TDiagnosticsView.GraphicsReadinessClick(Sender: TObject);
|
|
begin
|
|
DispatchGraphicsRequest(grReadiness);
|
|
end;
|
|
|
|
procedure TDiagnosticsView.GraphicsTextureClick(Sender: TObject);
|
|
begin
|
|
DispatchGraphicsRequest(grTextureLifecycle);
|
|
end;
|
|
|
|
procedure TDiagnosticsView.GraphicsVisible2DClick(Sender: TObject);
|
|
begin
|
|
DispatchGraphicsRequest(grVisibleDraw);
|
|
end;
|
|
|
|
procedure TDiagnosticsView.DispatchGraphicsRequest(const ARequest: TGraphicsRequest);
|
|
var
|
|
Accepted: Boolean;
|
|
Container: TCastleContainer;
|
|
begin
|
|
if (FGraphicsSession <> nil) and FGraphicsSession.Busy then
|
|
begin
|
|
FGraphicsReadinessButton.Enabled := False;
|
|
FTextureButton.Enabled := False;
|
|
FVisible2DButton.Enabled := False;
|
|
UpdateGraphicsFeedback('Graphics diagnostic in progress…');
|
|
Exit;
|
|
end;
|
|
|
|
if FGraphicsSession = nil then
|
|
begin
|
|
Container := Self.Container;
|
|
if Container = nil then
|
|
begin
|
|
FGraphicsReadinessButton.Enabled := True;
|
|
FTextureButton.Enabled := True;
|
|
FVisible2DButton.Enabled := True;
|
|
UpdateGraphicsFeedback('Graphics diagnostic unavailable.');
|
|
Exit;
|
|
end;
|
|
try
|
|
FGraphicsSession := TGraphicsDiagnosticSession.Create(Container);
|
|
FGraphicsSession.OnResultPublished := @GraphicsResultPublished;
|
|
except
|
|
if FGraphicsSession <> nil then
|
|
begin
|
|
FGraphicsSession.OnResultPublished := nil;
|
|
FreeAndNil(FGraphicsSession);
|
|
end;
|
|
FGraphicsReadinessButton.Enabled := True;
|
|
FTextureButton.Enabled := True;
|
|
FVisible2DButton.Enabled := True;
|
|
UpdateGraphicsFeedback('Graphics diagnostic unavailable.');
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
FGraphicsCompletionNotifiedDuringDispatch := False;
|
|
FGraphicsReadinessButton.Enabled := False;
|
|
FTextureButton.Enabled := False;
|
|
FVisible2DButton.Enabled := False;
|
|
UpdateGraphicsFeedback('Starting graphics diagnostic…');
|
|
try
|
|
case ARequest of
|
|
grReadiness: Accepted := FGraphicsSession.RequestReadiness;
|
|
grTextureLifecycle: Accepted := FGraphicsSession.RequestTextureLifecycle;
|
|
grVisibleDraw: Accepted := FGraphicsSession.RequestVisibleDraw;
|
|
end;
|
|
except
|
|
if FGraphicsCompletionNotifiedDuringDispatch then Exit;
|
|
if FGraphicsSession.Busy then
|
|
begin
|
|
FGraphicsReadinessButton.Enabled := False;
|
|
FTextureButton.Enabled := False;
|
|
FVisible2DButton.Enabled := False;
|
|
UpdateGraphicsFeedback('Graphics diagnostic in progress…');
|
|
end else
|
|
begin
|
|
FGraphicsReadinessButton.Enabled := True;
|
|
FTextureButton.Enabled := True;
|
|
FVisible2DButton.Enabled := True;
|
|
UpdateGraphicsFeedback('Graphics request could not be submitted.');
|
|
end;
|
|
Exit;
|
|
end;
|
|
|
|
if Accepted and FGraphicsCompletionNotifiedDuringDispatch then Exit;
|
|
if FGraphicsSession.Busy then
|
|
begin
|
|
FGraphicsReadinessButton.Enabled := False;
|
|
FTextureButton.Enabled := False;
|
|
FVisible2DButton.Enabled := False;
|
|
UpdateGraphicsFeedback('Graphics diagnostic in progress…');
|
|
end else
|
|
begin
|
|
FGraphicsReadinessButton.Enabled := True;
|
|
FTextureButton.Enabled := True;
|
|
FVisible2DButton.Enabled := True;
|
|
if not Accepted then
|
|
UpdateGraphicsFeedback('Graphics diagnostic request unavailable.')
|
|
else
|
|
UpdateGraphicsFeedback('Graphics request ended; result update unavailable.');
|
|
end;
|
|
end;
|
|
|
|
procedure TDiagnosticsView.GraphicsResultPublished(Sender: TObject);
|
|
begin
|
|
if (FGraphicsSession = nil) or (Sender <> FGraphicsSession) then Exit;
|
|
FGraphicsCompletionNotifiedDuringDispatch := True;
|
|
FGraphicsReadinessButton.Enabled := True;
|
|
FTextureButton.Enabled := True;
|
|
FVisible2DButton.Enabled := True;
|
|
try
|
|
RefreshReport;
|
|
except
|
|
UpdateGraphicsFeedback('Graphics result published; display refresh unavailable.');
|
|
Exit;
|
|
end;
|
|
UpdateGraphicsFeedback('Graphics result updated.');
|
|
end;
|
|
|
|
procedure TDiagnosticsView.UpdateWrapWidth;
|
|
var
|
|
ViewWidth, ViewHeight, AvailableWidth, ActionWidth, Inset, CellWidth: Single;
|
|
TitleHeight, GraphicsFeedbackRowHeight, ExportFeedbackRowHeight: Single;
|
|
FreeHeight: Single;
|
|
Columns, Rows, Index, Column, Row: Integer;
|
|
Buttons: array[0..5] of TCastleButton;
|
|
StatusLabels: array[0..4] of TCastleLabel;
|
|
DetailsLabels: array[0..4] of TCastleLabel;
|
|
begin
|
|
ViewWidth := EffectiveWidth;
|
|
ViewHeight := EffectiveHeight;
|
|
if (ViewWidth <= 0) or (ViewHeight <= 0) then Exit;
|
|
|
|
AvailableWidth := Max(1, ViewWidth - 2 * LayoutMargin);
|
|
if AvailableWidth >= 916 then Columns := 3
|
|
else if AvailableWidth >= 614 then Columns := 2
|
|
else Columns := 1;
|
|
ActionWidth := Min(AvailableWidth, Columns * 296 + (Columns - 1) * 6 + 16);
|
|
Inset := Min(8, Max(0, (ActionWidth - 1) / 2));
|
|
CellWidth := Max(1, (ActionWidth - 2 * Inset - (Columns - 1) * 6) / Columns);
|
|
Rows := (6 + Columns - 1) div Columns;
|
|
|
|
FActionRegion.Width := ActionWidth;
|
|
FActionRegion.Anchor(hpMiddle);
|
|
FActionRegion.Anchor(vpTop, -LayoutMargin);
|
|
FTitleLabel.MaxWidth := Max(1, ActionWidth - 2 * Inset);
|
|
FTitleLabel.Alignment := hpMiddle;
|
|
FTitleLabel.AutoSize := True;
|
|
FGraphicsFeedbackLabel.MaxWidth := Max(1, ActionWidth - 2 * Inset);
|
|
FGraphicsFeedbackLabel.Alignment := hpMiddle;
|
|
FGraphicsFeedbackLabel.AutoSize := True;
|
|
FExportFeedbackLabel.MaxWidth := Max(1, ActionWidth - 2 * Inset);
|
|
FExportFeedbackLabel.Alignment := hpMiddle;
|
|
FExportFeedbackLabel.AutoSize := True;
|
|
TitleHeight := FTitleLabel.EffectiveHeight;
|
|
FTitleLabel.Anchor(hpMiddle);
|
|
FTitleLabel.Anchor(vpTop, -Inset);
|
|
|
|
Buttons[0] := FFileIOButton;
|
|
Buttons[1] := FTerrainReadinessButton;
|
|
Buttons[2] := FGraphicsReadinessButton;
|
|
Buttons[3] := FTextureButton;
|
|
Buttons[4] := FVisible2DButton;
|
|
Buttons[5] := FExportButton;
|
|
for Index := 0 to High(Buttons) do
|
|
begin
|
|
Column := Index mod Columns;
|
|
Row := Index div Columns;
|
|
Buttons[Index].Width := CellWidth;
|
|
Buttons[Index].Height := 48;
|
|
Buttons[Index].Anchor(hpLeft, Inset + Column * (CellWidth + 6));
|
|
Buttons[Index].Anchor(vpTop, -(Inset + TitleHeight + 8 + Row * (48 + 6)));
|
|
end;
|
|
|
|
GraphicsFeedbackRowHeight := Max(18, FGraphicsFeedbackLabel.EffectiveHeight);
|
|
ExportFeedbackRowHeight := Max(18, FExportFeedbackLabel.EffectiveHeight);
|
|
FGraphicsFeedbackLabel.Anchor(hpMiddle);
|
|
FGraphicsFeedbackLabel.Anchor(vpTop,
|
|
-(Inset + TitleHeight + 8 + Rows * 48 + (Rows - 1) * 6 + 8));
|
|
FExportFeedbackLabel.Anchor(hpMiddle);
|
|
FExportFeedbackLabel.Anchor(vpTop,
|
|
-(Inset + TitleHeight + 8 + Rows * 48 + (Rows - 1) * 6 + 8 +
|
|
GraphicsFeedbackRowHeight + 8));
|
|
FActionRegion.Height := Inset + TitleHeight + 8 + Rows * 48 +
|
|
(Rows - 1) * 6 + 8 + GraphicsFeedbackRowHeight + 8 +
|
|
ExportFeedbackRowHeight + Inset;
|
|
|
|
FScroll.FullSize := False;
|
|
FScroll.Width := Max(1, ViewWidth - 2 * LayoutMargin);
|
|
FScroll.Anchor(hpMiddle);
|
|
FScroll.Anchor(vpBottom, LayoutMargin);
|
|
FreeHeight := ViewHeight - 2 * LayoutMargin - FActionRegion.Height - 8;
|
|
if FreeHeight > 0 then
|
|
begin
|
|
FScroll.Exists := True;
|
|
FScroll.Height := FreeHeight;
|
|
end else
|
|
begin
|
|
FScroll.Exists := False;
|
|
FScroll.Height := 1;
|
|
end;
|
|
|
|
StatusLabels[0] := FStatusLabel;
|
|
DetailsLabels[0] := FDetailsLabel;
|
|
StatusLabels[1] := FTerrainReadinessStatusLabel;
|
|
DetailsLabels[1] := FTerrainReadinessDetailsLabel;
|
|
StatusLabels[2] := FGraphicsReadinessStatusLabel;
|
|
DetailsLabels[2] := FGraphicsReadinessDetailsLabel;
|
|
StatusLabels[3] := FTextureStatusLabel;
|
|
DetailsLabels[3] := FTextureDetailsLabel;
|
|
StatusLabels[4] := FVisible2DStatusLabel;
|
|
DetailsLabels[4] := FVisible2DDetailsLabel;
|
|
for Index := 0 to High(StatusLabels) do
|
|
begin
|
|
StatusLabels[Index].MaxWidth := Max(1, FScroll.Width - 2 * LayoutMargin - 16);
|
|
DetailsLabels[Index].MaxWidth := Max(1, FScroll.Width - 2 * LayoutMargin - 16);
|
|
end;
|
|
end;
|
|
|
|
function FileIODetails(const State: TDiagnosticReportState): string;
|
|
var
|
|
Stage: TDiagnosticStageId;
|
|
Details: string;
|
|
begin
|
|
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;
|
|
Result := Details;
|
|
end;
|
|
|
|
function TerrainReadinessDetails(const State: TDiagnosticReportState): string;
|
|
var
|
|
TerrainStage: TTerrainReadinessDiagnosticStageId;
|
|
Details: string;
|
|
begin
|
|
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;
|
|
Result := Details;
|
|
end;
|
|
|
|
function GraphicsReadinessDetails(const State: TDiagnosticReportState): string;
|
|
var
|
|
ReadinessStage: TGraphicsReadinessDiagnosticStageId;
|
|
Details: string;
|
|
begin
|
|
Details := '';
|
|
for ReadinessStage := Low(TGraphicsReadinessDiagnosticStageId)
|
|
to High(TGraphicsReadinessDiagnosticStageId) do
|
|
begin
|
|
if Details <> '' then Details := Details + LineEnding;
|
|
Details := Details + GraphicsReadinessDiagnosticStageIdToken(ReadinessStage) + ': ';
|
|
Details := Details + DiagnosticStatusToken(
|
|
State.GraphicsReadiness.Stages[ReadinessStage]);
|
|
end;
|
|
if State.GraphicsReadiness.FailureStage.HasValue then
|
|
Details := Details + LineEnding + 'failure_stage: ' +
|
|
GraphicsReadinessDiagnosticStageIdToken(
|
|
State.GraphicsReadiness.FailureStage.Value);
|
|
if State.GraphicsReadiness.Error.Present then
|
|
begin
|
|
Details := Details + LineEnding + 'error class: ' +
|
|
OptionalStringText(State.GraphicsReadiness.Error.ClassName);
|
|
Details := Details + LineEnding + 'error message: ' +
|
|
OptionalStringText(State.GraphicsReadiness.Error.MessageText);
|
|
end;
|
|
with State.GraphicsReadiness.Evidence do
|
|
begin
|
|
if ContextAvailable.HasValue then
|
|
Details := Details + LineEnding + 'context_available: ' +
|
|
OptionalBooleanText(ContextAvailable);
|
|
if RendererContextSynced.HasValue then
|
|
Details := Details + LineEnding + 'renderer_context_synced: ' +
|
|
OptionalBooleanText(RendererContextSynced);
|
|
if PhysicalSizeKnown.HasValue then
|
|
Details := Details + LineEnding + 'physical_size_known: ' +
|
|
OptionalBooleanText(PhysicalSizeKnown);
|
|
if TextureBackendReady.HasValue then
|
|
Details := Details + LineEnding + 'texture_backend_ready: ' +
|
|
OptionalBooleanText(TextureBackendReady);
|
|
if SampledProgramReady.HasValue then
|
|
Details := Details + LineEnding + 'sampled_program_ready: ' +
|
|
OptionalBooleanText(SampledProgramReady);
|
|
if PhysicalWidth.HasValue then
|
|
Details := Details + LineEnding + 'physical_width: ' +
|
|
OptionalInt64Text(PhysicalWidth);
|
|
if PhysicalHeight.HasValue then
|
|
Details := Details + LineEnding + 'physical_height: ' +
|
|
OptionalInt64Text(PhysicalHeight);
|
|
if RendererWidth.HasValue then
|
|
Details := Details + LineEnding + 'renderer_width: ' +
|
|
OptionalInt64Text(RendererWidth);
|
|
if RendererHeight.HasValue then
|
|
Details := Details + LineEnding + 'renderer_height: ' +
|
|
OptionalInt64Text(RendererHeight);
|
|
if MaxTextureSize.HasValue then
|
|
Details := Details + LineEnding + 'max_texture_size: ' +
|
|
OptionalInt64Text(MaxTextureSize);
|
|
end;
|
|
Result := Details;
|
|
end;
|
|
|
|
function GraphicsTextureDetails(const State: TDiagnosticReportState): string;
|
|
var
|
|
TextureStage: TGraphicsTextureDiagnosticStageId;
|
|
Details: string;
|
|
begin
|
|
Details := '';
|
|
for TextureStage := Low(TGraphicsTextureDiagnosticStageId)
|
|
to High(TGraphicsTextureDiagnosticStageId) do
|
|
begin
|
|
if Details <> '' then Details := Details + LineEnding;
|
|
Details := Details + GraphicsTextureDiagnosticStageIdToken(TextureStage) + ': ' +
|
|
DiagnosticStatusToken(State.GraphicsTexture.Stages[TextureStage]);
|
|
end;
|
|
if State.GraphicsTexture.FailureStage.HasValue then
|
|
Details := Details + LineEnding + 'failure_stage: ' +
|
|
GraphicsTextureDiagnosticStageIdToken(
|
|
State.GraphicsTexture.FailureStage.Value);
|
|
if State.GraphicsTexture.Error.Present then
|
|
begin
|
|
Details := Details + LineEnding + 'error class: ' +
|
|
OptionalStringText(State.GraphicsTexture.Error.ClassName);
|
|
Details := Details + LineEnding + 'error message: ' +
|
|
OptionalStringText(State.GraphicsTexture.Error.MessageText);
|
|
end;
|
|
with State.GraphicsTexture.Evidence do
|
|
begin
|
|
if InitialWidth.HasValue then
|
|
Details := Details + LineEnding + 'initial_width: ' + OptionalInt64Text(InitialWidth);
|
|
if InitialHeight.HasValue then
|
|
Details := Details + LineEnding + 'initial_height: ' + OptionalInt64Text(InitialHeight);
|
|
if ReplacementWidth.HasValue then
|
|
Details := Details + LineEnding + 'replacement_width: ' + OptionalInt64Text(ReplacementWidth);
|
|
if ReplacementHeight.HasValue then
|
|
Details := Details + LineEnding + 'replacement_height: ' + OptionalInt64Text(ReplacementHeight);
|
|
if InitialFormat.HasValue then
|
|
Details := Details + LineEnding + 'initial_format: ' + OptionalStringText(InitialFormat);
|
|
if ReplacementFormat.HasValue then
|
|
Details := Details + LineEnding + 'replacement_format: ' + OptionalStringText(ReplacementFormat);
|
|
if MinFilter.HasValue then
|
|
Details := Details + LineEnding + 'min_filter: ' + OptionalStringText(MinFilter);
|
|
if MagFilter.HasValue then
|
|
Details := Details + LineEnding + 'mag_filter: ' + OptionalStringText(MagFilter);
|
|
if GenTextureCompleted.HasValue then
|
|
Details := Details + LineEnding + 'gen_texture_completed: ' + OptionalBooleanText(GenTextureCompleted);
|
|
if NonZeroTextureId.HasValue then
|
|
Details := Details + LineEnding + 'non_zero_texture_id: ' + OptionalBooleanText(NonZeroTextureId);
|
|
if FirstBindCompleted.HasValue then
|
|
Details := Details + LineEnding + 'first_bind_completed: ' + OptionalBooleanText(FirstBindCompleted);
|
|
if ReplacementUpdateCompleted.HasValue then
|
|
Details := Details + LineEnding + 'replacement_update_completed: ' + OptionalBooleanText(ReplacementUpdateCompleted);
|
|
if SecondBindCompleted.HasValue then
|
|
Details := Details + LineEnding + 'second_bind_completed: ' + OptionalBooleanText(SecondBindCompleted);
|
|
if DeleteAttempted.HasValue then
|
|
Details := Details + LineEnding + 'delete_attempted: ' + OptionalBooleanText(DeleteAttempted);
|
|
if DeleteCompleted.HasValue then
|
|
Details := Details + LineEnding + 'delete_completed: ' + OptionalBooleanText(DeleteCompleted);
|
|
if CleanupCompleted.HasValue then
|
|
Details := Details + LineEnding + 'cleanup_completed: ' + OptionalBooleanText(CleanupCompleted);
|
|
if ContextLost.HasValue then
|
|
Details := Details + LineEnding + 'context_lost: ' + OptionalBooleanText(ContextLost);
|
|
if CleanupBlockedByContext.HasValue then
|
|
Details := Details + LineEnding + 'cleanup_blocked_by_context: ' + OptionalBooleanText(CleanupBlockedByContext);
|
|
if SecondaryCleanupError.Present then
|
|
begin
|
|
Details := Details + LineEnding + 'secondary_cleanup_error class: ' +
|
|
OptionalStringText(SecondaryCleanupError.ClassName);
|
|
Details := Details + LineEnding + 'secondary_cleanup_error message: ' +
|
|
OptionalStringText(SecondaryCleanupError.MessageText);
|
|
end;
|
|
end;
|
|
Result := Details;
|
|
end;
|
|
|
|
function GraphicsVisibleDrawDetails(const State: TDiagnosticReportState): string;
|
|
var
|
|
VisibleStage: TGraphicsVisibleDrawDiagnosticStageId;
|
|
Details: string;
|
|
begin
|
|
Details := 'Renderer execution only; pixels are not automatically verified.' +
|
|
LineEnding + 'Inspect the on-screen pattern while the action runs.';
|
|
for VisibleStage := Low(TGraphicsVisibleDrawDiagnosticStageId)
|
|
to High(TGraphicsVisibleDrawDiagnosticStageId) do
|
|
begin
|
|
Details := Details + LineEnding +
|
|
GraphicsVisibleDrawDiagnosticStageIdToken(VisibleStage) + ': ' +
|
|
DiagnosticStatusToken(State.GraphicsVisibleDraw.Stages[VisibleStage]);
|
|
end;
|
|
if State.GraphicsVisibleDraw.FailureStage.HasValue then
|
|
Details := Details + LineEnding + 'failure_stage: ' +
|
|
GraphicsVisibleDrawDiagnosticStageIdToken(
|
|
State.GraphicsVisibleDraw.FailureStage.Value);
|
|
if State.GraphicsVisibleDraw.Error.Present then
|
|
begin
|
|
Details := Details + LineEnding + 'error class: ' +
|
|
OptionalStringText(State.GraphicsVisibleDraw.Error.ClassName);
|
|
Details := Details + LineEnding + 'error message: ' +
|
|
OptionalStringText(State.GraphicsVisibleDraw.Error.MessageText);
|
|
end;
|
|
with State.GraphicsVisibleDraw.Evidence do
|
|
begin
|
|
if TextureWidth.HasValue then
|
|
Details := Details + LineEnding + 'texture_width: ' + OptionalInt64Text(TextureWidth);
|
|
if TextureHeight.HasValue then
|
|
Details := Details + LineEnding + 'texture_height: ' + OptionalInt64Text(TextureHeight);
|
|
if BaseFramesCompleted.HasValue then
|
|
Details := Details + LineEnding + 'base_frames_completed: ' + OptionalInt64Text(BaseFramesCompleted);
|
|
if BrightnessFramesCompleted.HasValue then
|
|
Details := Details + LineEnding + 'brightness_frames_completed: ' + OptionalInt64Text(BrightnessFramesCompleted);
|
|
if BrightnessAmount.HasValue then
|
|
Details := Details + LineEnding + 'brightness_amount: ' + OptionalInt64Text(BrightnessAmount);
|
|
if TextureFormat.HasValue then
|
|
Details := Details + LineEnding + 'texture_format: ' + OptionalStringText(TextureFormat);
|
|
if MinFilter.HasValue then
|
|
Details := Details + LineEnding + 'min_filter: ' + OptionalStringText(MinFilter);
|
|
if MagFilter.HasValue then
|
|
Details := Details + LineEnding + 'mag_filter: ' + OptionalStringText(MagFilter);
|
|
if TextureCreated.HasValue then
|
|
Details := Details + LineEnding + 'texture_created: ' + OptionalBooleanText(TextureCreated);
|
|
if NonZeroTextureId.HasValue then
|
|
Details := Details + LineEnding + 'non_zero_texture_id: ' + OptionalBooleanText(NonZeroTextureId);
|
|
if BaseTripleRgbaDrawsCompleted.HasValue then
|
|
Details := Details + LineEnding + 'base_triple_rgba_draws_completed: ' + OptionalBooleanText(BaseTripleRgbaDrawsCompleted);
|
|
if BrightnessTripleRgbaDrawsCompleted.HasValue then
|
|
Details := Details + LineEnding + 'brightness_triple_rgba_draws_completed: ' + OptionalBooleanText(BrightnessTripleRgbaDrawsCompleted);
|
|
if BrightnessOverlayAppliedAfterDraws.HasValue then
|
|
Details := Details + LineEnding + 'brightness_overlay_applied_after_draws: ' + OptionalBooleanText(BrightnessOverlayAppliedAfterDraws);
|
|
if ContextLost.HasValue then
|
|
Details := Details + LineEnding + 'context_lost: ' + OptionalBooleanText(ContextLost);
|
|
if DeleteAttempted.HasValue then
|
|
Details := Details + LineEnding + 'delete_attempted: ' + OptionalBooleanText(DeleteAttempted);
|
|
if DeleteCompleted.HasValue then
|
|
Details := Details + LineEnding + 'delete_completed: ' + OptionalBooleanText(DeleteCompleted);
|
|
if CleanupCompleted.HasValue then
|
|
Details := Details + LineEnding + 'cleanup_completed: ' + OptionalBooleanText(CleanupCompleted);
|
|
if CleanupBlockedByContext.HasValue then
|
|
Details := Details + LineEnding + 'cleanup_blocked_by_context: ' + OptionalBooleanText(CleanupBlockedByContext);
|
|
if SecondaryCleanupError.Present then
|
|
begin
|
|
Details := Details + LineEnding + 'secondary_cleanup_error class: ' +
|
|
OptionalStringText(SecondaryCleanupError.ClassName);
|
|
Details := Details + LineEnding + 'secondary_cleanup_error message: ' +
|
|
OptionalStringText(SecondaryCleanupError.MessageText);
|
|
end;
|
|
end;
|
|
Result := Details;
|
|
end;
|
|
|
|
procedure TDiagnosticsView.RefreshReport;
|
|
var
|
|
State: TDiagnosticReportState;
|
|
begin
|
|
State := CurrentDiagnosticReport;
|
|
FStatusLabel.Caption := 'File I/O: ' + DiagnosticStatusToken(State.FileIO.Status);
|
|
FDetailsLabel.Caption := FileIODetails(State);
|
|
FTerrainReadinessStatusLabel.Caption := 'MAP/RXX terrain readiness: ' +
|
|
DiagnosticStatusToken(State.TerrainReadiness.Status);
|
|
FTerrainReadinessDetailsLabel.Caption := TerrainReadinessDetails(State);
|
|
FGraphicsReadinessStatusLabel.Caption := 'Graphics readiness/current surface: ' +
|
|
DiagnosticStatusToken(State.GraphicsReadiness.Status);
|
|
FGraphicsReadinessDetailsLabel.Caption := GraphicsReadinessDetails(State);
|
|
FTextureStatusLabel.Caption := 'GPU texture lifecycle/selection: ' +
|
|
DiagnosticStatusToken(State.GraphicsTexture.Status);
|
|
FTextureDetailsLabel.Caption := GraphicsTextureDetails(State);
|
|
FVisible2DStatusLabel.Caption := 'Visible 2D renderer execution: ' +
|
|
DiagnosticStatusToken(State.GraphicsVisibleDraw.Status);
|
|
FVisible2DDetailsLabel.Caption := GraphicsVisibleDrawDetails(State);
|
|
end;
|
|
|
|
procedure TDiagnosticsView.Start;
|
|
begin
|
|
inherited;
|
|
UpdateWrapWidth;
|
|
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…';
|
|
UpdateWrapWidth;
|
|
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;
|
|
UpdateWrapWidth;
|
|
end;
|
|
|
|
end.
|