dima/kam-mobile
1
0 Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
f1b253e8428d07b5d3e3286d63ada3947044afa2
kam-mobile/code/GameDiagnosticsView.pas
T

697 lines
28 KiB
ObjectPascal
Raw Normal View History

Complete BigTask
2026-09-15 10:16:31 +05:00
unit GameDiagnosticsView;
{$mode objfpc}{$H+}{$codepage utf8}
interface
uses
Classes,
Complete BigTask
2026-10-10 01:02:27 +05:00
CastleUIControls, CastleControls, GameDiagnosticsExport,
GameDiagnosticsGraphics_Mobile;
Complete BigTask
2026-09-15 10:16:31 +05:00
type
TDiagnosticsView = class(TCastleView)
private
Complete BigTask
2026-10-10 01:02:27 +05:00
type
TGraphicsRequest = (grReadiness, grTextureLifecycle, grVisibleDraw);
Reuse Android compiler outputs and remove old build artifacts
2026-10-10 02:05:20 +05:00
private
Complete BigTask
2026-10-10 01:02:27 +05:00
FActionRegion: TCastleUserInterface;
Complete BigTask
2026-09-15 10:16:31 +05:00
FScroll: TCastleScrollView;
FContent: TCastleVerticalGroup;
FFileIOButton: TCastleButton;
FStatusLabel, FDetailsLabel, FExportFeedbackLabel: TCastleLabel;
Complete BigTask
2026-10-10 01:02:27 +05:00
FTitleLabel, FGraphicsFeedbackLabel: TCastleLabel;
Complete BigTask
2026-09-15 10:16:31 +05:00
FExportButton: TCastleButton;
Complete BigTask
2026-10-10 01:02:27 +05:00
FGraphicsReadinessButton, FTextureButton, FVisible2DButton: TCastleButton;
FGraphicsReadinessStatusLabel, FGraphicsReadinessDetailsLabel: TCastleLabel;
FTextureStatusLabel, FTextureDetailsLabel: TCastleLabel;
FVisible2DStatusLabel, FVisible2DDetailsLabel: TCastleLabel;
Complete BigTask
2026-09-15 10:16:31 +05:00
FFileIOInProgress, FExportInProgress: Boolean;
Complete BigTask
2026-10-10 01:02:27 +05:00
FGraphicsSession: TGraphicsDiagnosticSession;
FGraphicsCompletionNotifiedDuringDispatch: Boolean;
Complete BigTask
2026-09-15 10:16:31 +05:00
procedure RefreshReport;
procedure UpdateWrapWidth;
Complete BigTask
2026-10-10 01:02:27 +05:00
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);
Complete BigTask
2026-09-15 10:16:31 +05:00
procedure FileIOClick(Sender: TObject);
procedure ExportClick(Sender: TObject);
procedure ExportComplete(const AOutcome: TDiagnosticExportOutcome);
public
constructor Create(AOwner: TComponent); override;
Complete BigTask
2026-10-10 01:02:27 +05:00
destructor Destroy; override;
Complete BigTask
2026-09-15 10:16:31 +05:00
procedure Start; override;
procedure Resize; override;
end;
implementation
uses
Remove terrain readiness diagnostic and fix graphics container name
2026-10-10 03:02:42 +05:00
SysUtils, Math, GameDiagnosticsFileIO, GameDiagnosticsReport;
Complete BigTask
2026-09-15 10:16:31 +05:00
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;
Complete BigTask
2026-10-10 01:02:27 +05:00
FGraphicsSession := nil;
FGraphicsCompletionNotifiedDuringDispatch := False;
Complete BigTask
2026-09-15 10:16:31 +05:00
FScroll := TCastleScrollView.Create(Self);
Complete BigTask
2026-10-10 01:02:27 +05:00
FScroll.FullSize := False;
Complete BigTask
2026-09-15 10:16:31 +05:00
FScroll.EnableDragging := True;
Pin stable Castle toolchain compatibility
2026-09-15 21:46:19 +05:00
InsertFront(FScroll);
Complete BigTask
2026-09-15 10:16:31 +05:00
Complete BigTask
2026-10-10 01:02:27 +05:00
FActionRegion := TCastleUserInterface.Create(Self);
FActionRegion.FullSize := False;
InsertFront(FActionRegion);
Complete BigTask
2026-09-15 10:16:31 +05:00
FContent := TCastleVerticalGroup.Create(Self);
FContent.Padding := LayoutMargin;
FContent.Spacing := 8;
Pin stable Castle toolchain compatibility
2026-09-15 21:46:19 +05:00
FScroll.ScrollArea.InsertFront(FContent);
Complete BigTask
2026-09-15 10:16:31 +05:00
FStatusLabel := TCastleLabel.Create(Self);
FDetailsLabel := TCastleLabel.Create(Self);
FExportFeedbackLabel := TCastleLabel.Create(Self);
Complete BigTask
2026-10-10 01:02:27 +05:00
FGraphicsFeedbackLabel := TCastleLabel.Create(Self);
Complete BigTask
2026-09-15 10:16:31 +05:00
FFileIOButton := TCastleButton.Create(Self);
Complete BigTask
2026-10-10 01:02:27 +05:00
FFileIOButton.AutoSize := False;
Complete BigTask
2026-09-15 10:16:31 +05:00
FExportButton := TCastleButton.Create(Self);
Complete BigTask
2026-10-10 01:02:27 +05:00
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;
FGraphicsReadinessStatusLabel := TCastleLabel.Create(Self);
FGraphicsReadinessDetailsLabel := TCastleLabel.Create(Self);
FTextureStatusLabel := TCastleLabel.Create(Self);
FTextureDetailsLabel := TCastleLabel.Create(Self);
FVisible2DStatusLabel := TCastleLabel.Create(Self);
FVisible2DDetailsLabel := TCastleLabel.Create(Self);
Complete BigTask
2026-09-15 10:16:31 +05:00
Complete BigTask
2026-10-10 01:02:27 +05:00
FContent.InsertFront(FStatusLabel);
FContent.InsertFront(FDetailsLabel);
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);
Complete BigTask
2026-09-15 10:16:31 +05:00
FExportButton.Caption := 'Export Report';
FExportButton.OnClick := @ExportClick;
Complete BigTask
2026-10-10 01:02:27 +05:00
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);
Complete BigTask
2026-09-15 10:16:31 +05:00
FFileIOButton.Caption := 'Test File I/O';
FFileIOButton.OnClick := @FileIOClick;
Complete BigTask
2026-10-10 01:02:27 +05:00
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;
Remove terrain readiness diagnostic and fix graphics container name
2026-10-10 03:02:42 +05:00
ViewContainer: TCastleContainer;
Complete BigTask
2026-10-10 01:02:27 +05:00
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
Remove terrain readiness diagnostic and fix graphics container name
2026-10-10 03:02:42 +05:00
ViewContainer := Self.Container;
if ViewContainer = nil then
Complete BigTask
2026-10-10 01:02:27 +05:00
begin
FGraphicsReadinessButton.Enabled := True;
FTextureButton.Enabled := True;
FVisible2DButton.Enabled := True;
UpdateGraphicsFeedback('Graphics diagnostic unavailable.');
Exit;
end;
try
Remove terrain readiness diagnostic and fix graphics container name
2026-10-10 03:02:42 +05:00
FGraphicsSession := TGraphicsDiagnosticSession.Create(ViewContainer);
Complete BigTask
2026-10-10 01:02:27 +05:00
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.');
Complete BigTask
2026-09-15 10:16:31 +05:00
end;
procedure TDiagnosticsView.UpdateWrapWidth;
var
Complete BigTask
2026-10-10 01:02:27 +05:00
ViewWidth, ViewHeight, AvailableWidth, ActionWidth, Inset, CellWidth: Single;
TitleHeight, GraphicsFeedbackRowHeight, ExportFeedbackRowHeight: Single;
FreeHeight: Single;
Columns, Rows, Index, Column, Row: Integer;
Remove terrain readiness diagnostic and fix graphics container name
2026-10-10 03:02:42 +05:00
Buttons: array[0..4] of TCastleButton;
StatusLabels: array[0..3] of TCastleLabel;
DetailsLabels: array[0..3] of TCastleLabel;
Complete BigTask
2026-09-15 10:16:31 +05:00
begin
Complete BigTask
2026-10-10 01:02:27 +05:00
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);
Remove terrain readiness diagnostic and fix graphics container name
2026-10-10 03:02:42 +05:00
Rows := (5 + Columns - 1) div Columns;
Complete BigTask
2026-10-10 01:02:27 +05:00
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;
Remove terrain readiness diagnostic and fix graphics container name
2026-10-10 03:02:42 +05:00
Buttons[1] := FGraphicsReadinessButton;
Buttons[2] := FTextureButton;
Buttons[3] := FVisible2DButton;
Buttons[4] := FExportButton;
Complete BigTask
2026-10-10 01:02:27 +05:00
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;
Remove terrain readiness diagnostic and fix graphics container name
2026-10-10 03:02:42 +05:00
StatusLabels[1] := FGraphicsReadinessStatusLabel;
DetailsLabels[1] := FGraphicsReadinessDetailsLabel;
StatusLabels[2] := FTextureStatusLabel;
DetailsLabels[2] := FTextureDetailsLabel;
StatusLabels[3] := FVisible2DStatusLabel;
DetailsLabels[3] := FVisible2DDetailsLabel;
Complete BigTask
2026-10-10 01:02:27 +05:00
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;
Complete BigTask
2026-09-15 10:16:31 +05:00
end;
Complete BigTask
2026-10-10 01:02:27 +05:00
function FileIODetails(const State: TDiagnosticReportState): string;
Complete BigTask
2026-09-15 10:16:31 +05:00
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;
Complete BigTask
2026-10-10 01:02:27 +05:00
Result := Details;
end;
Complete BigTask
2026-09-17 13:48:56 +05:00
Complete BigTask
2026-10-10 01:02:27 +05:00
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);
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);
Complete BigTask
2026-09-15 10:16:31 +05:00
end;
procedure TDiagnosticsView.Start;
begin
inherited;
Complete BigTask
2026-10-10 01:02:27 +05:00
UpdateWrapWidth;
Complete BigTask
2026-09-15 10:16:31 +05:00
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…';
Complete BigTask
2026-10-10 01:02:27 +05:00
UpdateWrapWidth;
Complete BigTask
2026-09-15 10:16:31 +05:00
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;
Complete BigTask
2026-10-10 01:02:27 +05:00
UpdateWrapWidth;
Complete BigTask
2026-09-15 10:16:31 +05:00
end;
end.
Reference in new issue Copy Permalink