Complete BigTask

code/GameDiagnosticsReport.pas

@@ -22,6 +22,20 @@ type
     trsiTileRecords
   );
 
+  TGraphicsReadinessDiagnosticStageId = (
+    grsiContextReady, grsiPhysicalSurface, grsiRendererSizeMatch,
+    grsiTextureBackend, grsiSampledProgram, grsiMaxTextureSize
+  );
+  TGraphicsTextureDiagnosticStageId = (
+    gtsiInitialCreate, gtsiNonZeroTextureId, gtsiFirstBind,
+    gtsiReplacementUpdate, gtsiSecondBind, gtsiTextureDelete,
+    gtsiResourceCleanup
+  );
+  TGraphicsVisibleDrawDiagnosticStageId = (
+    gvsiPreparation, gvsiSampledRgbaPhase, gvsiBrightnessPhase,
+    gvsiTextureDelete, gvsiResourceCleanup
+  );
+
   TOptionalString = record
     HasValue: Boolean;
     Value: string;
@@ -47,6 +61,21 @@ type
     Value: TTerrainReadinessDiagnosticStageId;
   end;
 
+  TOptionalGraphicsReadinessDiagnosticStageId = record
+    HasValue: Boolean;
+    Value: TGraphicsReadinessDiagnosticStageId;
+  end;
+
+  TOptionalGraphicsTextureDiagnosticStageId = record
+    HasValue: Boolean;
+    Value: TGraphicsTextureDiagnosticStageId;
+  end;
+
+  TOptionalGraphicsVisibleDrawDiagnosticStageId = record
+    HasValue: Boolean;
+    Value: TGraphicsVisibleDrawDiagnosticStageId;
+  end;
+
   TDiagnosticError = record
     Present: Boolean;
     ClassName: TOptionalString;
@@ -92,6 +121,58 @@ type
     Evidence: TTerrainReadinessDiagnosticEvidence;
   end;
 
+  TGraphicsReadinessDiagnosticEvidence = record
+    ContextAvailable, RendererContextSynced, PhysicalSizeKnown,
+      TextureBackendReady, SampledProgramReady: TOptionalBoolean;
+    PhysicalWidth, PhysicalHeight, RendererWidth, RendererHeight,
+      MaxTextureSize: TOptionalInt64;
+  end;
+
+  TGraphicsTextureDiagnosticEvidence = record
+    InitialWidth, InitialHeight, ReplacementWidth, ReplacementHeight: TOptionalInt64;
+    InitialFormat, ReplacementFormat, MinFilter, MagFilter: TOptionalString;
+    GenTextureCompleted, NonZeroTextureId, FirstBindCompleted,
+      ReplacementUpdateCompleted, SecondBindCompleted, DeleteAttempted,
+      DeleteCompleted, CleanupCompleted, ContextLost,
+      CleanupBlockedByContext: TOptionalBoolean;
+    SecondaryCleanupError: TDiagnosticError;
+  end;
+
+  TGraphicsVisibleDrawDiagnosticEvidence = record
+    TextureWidth, TextureHeight, BaseFramesCompleted,
+      BrightnessFramesCompleted, BrightnessAmount: TOptionalInt64;
+    TextureFormat, MinFilter, MagFilter: TOptionalString;
+    TextureCreated, NonZeroTextureId, BaseTripleRgbaDrawsCompleted,
+      BrightnessTripleRgbaDrawsCompleted, BrightnessOverlayAppliedAfterDraws,
+      ContextLost, DeleteAttempted, DeleteCompleted, CleanupCompleted,
+      CleanupBlockedByContext: TOptionalBoolean;
+    SecondaryCleanupError: TDiagnosticError;
+  end;
+
+  TGraphicsReadinessDiagnosticResult = record
+    Status: TDiagnosticStatus;
+    FailureStage: TOptionalGraphicsReadinessDiagnosticStageId;
+    Error: TDiagnosticError;
+    Stages: array[TGraphicsReadinessDiagnosticStageId] of TDiagnosticStatus;
+    Evidence: TGraphicsReadinessDiagnosticEvidence;
+  end;
+
+  TGraphicsTextureDiagnosticResult = record
+    Status: TDiagnosticStatus;
+    FailureStage: TOptionalGraphicsTextureDiagnosticStageId;
+    Error: TDiagnosticError;
+    Stages: array[TGraphicsTextureDiagnosticStageId] of TDiagnosticStatus;
+    Evidence: TGraphicsTextureDiagnosticEvidence;
+  end;
+
+  TGraphicsVisibleDrawDiagnosticResult = record
+    Status: TDiagnosticStatus;
+    FailureStage: TOptionalGraphicsVisibleDrawDiagnosticStageId;
+    Error: TDiagnosticError;
+    Stages: array[TGraphicsVisibleDrawDiagnosticStageId] of TDiagnosticStatus;
+    Evidence: TGraphicsVisibleDrawDiagnosticEvidence;
+  end;
+
   TDiagnosticApplicationMetadata = record
     Name: string;
     PackageName: string;
@@ -119,16 +200,31 @@ type
     OverallStatus: TDiagnosticStatus;
     FileIO: TFileIODiagnosticResult;
     TerrainReadiness: TTerrainReadinessDiagnosticResult;
+    GraphicsReadiness: TGraphicsReadinessDiagnosticResult;
+    GraphicsTexture: TGraphicsTextureDiagnosticResult;
+    GraphicsVisibleDraw: TGraphicsVisibleDrawDiagnosticResult;
   end;
 
 function CurrentDiagnosticReport: TDiagnosticReportState;
 procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
 procedure ReplaceTerrainReadinessDiagnosticResult(
   const AResult: TTerrainReadinessDiagnosticResult);
+procedure ReplaceGraphicsReadinessDiagnosticResult(
+  const AResult: TGraphicsReadinessDiagnosticResult);
+procedure ReplaceGraphicsTextureDiagnosticResult(
+  const AResult: TGraphicsTextureDiagnosticResult);
+procedure ReplaceGraphicsVisibleDrawDiagnosticResult(
+  const AResult: TGraphicsVisibleDrawDiagnosticResult);
 function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
 function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
 function TerrainReadinessDiagnosticStageIdToken(
   const AStage: TTerrainReadinessDiagnosticStageId): string;
+function GraphicsReadinessDiagnosticStageIdToken(
+  const AStage: TGraphicsReadinessDiagnosticStageId): string;
+function GraphicsTextureDiagnosticStageIdToken(
+  const AStage: TGraphicsTextureDiagnosticStageId): string;
+function GraphicsVisibleDrawDiagnosticStageIdToken(
+  const AStage: TGraphicsVisibleDrawDiagnosticStageId): string;
 function DiagnosticReportJsonSnapshot: string;
 
 implementation
@@ -139,6 +235,9 @@ uses
 var
   CurrentFileIO: TFileIODiagnosticResult;
   CurrentTerrainReadiness: TTerrainReadinessDiagnosticResult;
+  CurrentGraphicsReadiness: TGraphicsReadinessDiagnosticResult;
+  CurrentGraphicsTexture: TGraphicsTextureDiagnosticResult;
+  CurrentGraphicsVisibleDraw: TGraphicsVisibleDrawDiagnosticResult;
 
 function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
 begin
@@ -149,6 +248,45 @@ begin
   end;
 end;
 
+function GraphicsReadinessDiagnosticStageIdToken(
+  const AStage: TGraphicsReadinessDiagnosticStageId): string;
+begin
+  case AStage of
+    grsiContextReady: Result := 'context_ready';
+    grsiPhysicalSurface: Result := 'physical_surface';
+    grsiRendererSizeMatch: Result := 'renderer_size_match';
+    grsiTextureBackend: Result := 'texture_backend';
+    grsiSampledProgram: Result := 'sampled_program';
+    grsiMaxTextureSize: Result := 'max_texture_size';
+  end;
+end;
+
+function GraphicsTextureDiagnosticStageIdToken(
+  const AStage: TGraphicsTextureDiagnosticStageId): string;
+begin
+  case AStage of
+    gtsiInitialCreate: Result := 'initial_create';
+    gtsiNonZeroTextureId: Result := 'non_zero_texture_id';
+    gtsiFirstBind: Result := 'first_bind';
+    gtsiReplacementUpdate: Result := 'replacement_update';
+    gtsiSecondBind: Result := 'second_bind';
+    gtsiTextureDelete: Result := 'texture_delete';
+    gtsiResourceCleanup: Result := 'resource_cleanup';
+  end;
+end;
+
+function GraphicsVisibleDrawDiagnosticStageIdToken(
+  const AStage: TGraphicsVisibleDrawDiagnosticStageId): string;
+begin
+  case AStage of
+    gvsiPreparation: Result := 'preparation';
+    gvsiSampledRgbaPhase: Result := 'sampled_rgba_phase';
+    gvsiBrightnessPhase: Result := 'brightness_phase';
+    gvsiTextureDelete: Result := 'texture_delete';
+    gvsiResourceCleanup: Result := 'resource_cleanup';
+  end;
+end;
+
 function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
 begin
   case AStage of
@@ -186,11 +324,20 @@ begin
   Result.SelectedMap.Url := SelectedMapUrl;
   Result.FileIO := CurrentFileIO;
   Result.TerrainReadiness := CurrentTerrainReadiness;
+  Result.GraphicsReadiness := CurrentGraphicsReadiness;
+  Result.GraphicsTexture := CurrentGraphicsTexture;
+  Result.GraphicsVisibleDraw := CurrentGraphicsVisibleDraw;
   if (Result.FileIO.Status = dsFail)
-    or (Result.TerrainReadiness.Status = dsFail) then
+    or (Result.TerrainReadiness.Status = dsFail)
+    or (Result.GraphicsReadiness.Status = dsFail)
+    or (Result.GraphicsTexture.Status = dsFail)
+    or (Result.GraphicsVisibleDraw.Status = dsFail) then
     Result.OverallStatus := dsFail
   else if (Result.FileIO.Status = dsPass)
-    and (Result.TerrainReadiness.Status = dsPass) then
+    and (Result.TerrainReadiness.Status = dsPass)
+    and (Result.GraphicsReadiness.Status = dsPass)
+    and (Result.GraphicsTexture.Status = dsPass)
+    and (Result.GraphicsVisibleDraw.Status = dsPass) then
     Result.OverallStatus := dsPass
   else
     Result.OverallStatus := dsNotRun;
@@ -207,6 +354,24 @@ begin
   CurrentTerrainReadiness := AResult;
 end;
 
+procedure ReplaceGraphicsReadinessDiagnosticResult(
+  const AResult: TGraphicsReadinessDiagnosticResult);
+begin
+  CurrentGraphicsReadiness := AResult;
+end;
+
+procedure ReplaceGraphicsTextureDiagnosticResult(
+  const AResult: TGraphicsTextureDiagnosticResult);
+begin
+  CurrentGraphicsTexture := AResult;
+end;
+
+procedure ReplaceGraphicsVisibleDrawDiagnosticResult(
+  const AResult: TGraphicsVisibleDrawDiagnosticResult);
+begin
+  CurrentGraphicsVisibleDraw := AResult;
+end;
+
 function OptionalStringJson(const AValue: TOptionalString): TJSONData;
 begin
   if AValue.HasValue then
@@ -231,14 +396,246 @@ begin
     Result := TJSONNull.Create;
 end;
 
+function DiagnosticErrorJson(const AError: TDiagnosticError): TJSONData;
+var
+  ObjectValue: TJSONObject;
+begin
+  if not AError.Present then
+    Exit(TJSONNull.Create);
+  ObjectValue := TJSONObject.Create;
+  ObjectValue.Add('class', OptionalStringJson(AError.ClassName));
+  ObjectValue.Add('message', OptionalStringJson(AError.MessageText));
+  Result := ObjectValue;
+end;
+
+procedure AppendFileIOJson(AActions: TJSONArray; const AResult: TFileIODiagnosticResult);
+var
+  Action, Stage, Stream: TJSONObject;
+  Stages: TJSONArray;
+  StageId: TDiagnosticStageId;
+begin
+  Action := TJSONObject.Create;
+  Action.Add('id', 'file_io');
+  Action.Add('status', DiagnosticStatusToken(AResult.Status));
+  if AResult.FailureStage.HasValue then
+    Action.Add('failure_stage', DiagnosticStageIdToken(AResult.FailureStage.Value))
+  else
+    Action.Add('failure_stage', TJSONNull.Create);
+  Action.Add('error', DiagnosticErrorJson(AResult.Error));
+  Stages := TJSONArray.Create;
+  for StageId := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
+  begin
+    Stage := TJSONObject.Create;
+    Stage.Add('id', DiagnosticStageIdToken(StageId));
+    Stage.Add('status', DiagnosticStatusToken(AResult.Stages[StageId]));
+    Stages.Add(Stage);
+  end;
+  Action.Add('stages', Stages);
+  Stream := TJSONObject.Create;
+  Stream.Add('size', OptionalInt64Json(AResult.Stream.Size));
+  Stream.Add('position_after_load', OptionalInt64Json(AResult.Stream.PositionAfterLoad));
+  Stream.Add('read_offset', OptionalInt64Json(AResult.Stream.ReadOffset));
+  Stream.Add('requested_read_count', OptionalInt64Json(AResult.Stream.RequestedReadCount));
+  Stream.Add('first_read_count', OptionalInt64Json(AResult.Stream.FirstReadCount));
+  Stream.Add('position_after_first_read', OptionalInt64Json(AResult.Stream.PositionAfterFirstRead));
+  Stream.Add('seek_back_position', OptionalInt64Json(AResult.Stream.SeekBackPosition));
+  Stream.Add('second_read_count', OptionalInt64Json(AResult.Stream.SecondReadCount));
+  Stream.Add('position_after_second_read', OptionalInt64Json(AResult.Stream.PositionAfterSecondRead));
+  Stream.Add('repeat_equal', OptionalBooleanJson(AResult.Stream.RepeatEqual));
+  Action.Add('stream', Stream);
+  AActions.Add(Action);
+end;
+
+procedure AppendTerrainReadinessJson(AActions: TJSONArray; const AResult: TTerrainReadinessDiagnosticResult);
+var
+  Action, Stage, Evidence: TJSONObject;
+  Stages: TJSONArray;
+  TerrainStageId: TTerrainReadinessDiagnosticStageId;
+begin
+  Action := TJSONObject.Create;
+  Action.Add('id', 'terrain_readiness');
+  Action.Add('status', DiagnosticStatusToken(AResult.Status));
+  if AResult.FailureStage.HasValue then
+    Action.Add('failure_stage', TerrainReadinessDiagnosticStageIdToken(
+      AResult.FailureStage.Value))
+  else
+    Action.Add('failure_stage', TJSONNull.Create);
+  Action.Add('error', DiagnosticErrorJson(AResult.Error));
+  Stages := TJSONArray.Create;
+  for TerrainStageId := Low(TTerrainReadinessDiagnosticStageId)
+    to High(TTerrainReadinessDiagnosticStageId) do
+  begin
+    Stage := TJSONObject.Create;
+    Stage.Add('id', TerrainReadinessDiagnosticStageIdToken(TerrainStageId));
+    Stage.Add('status', DiagnosticStatusToken(
+      AResult.Stages[TerrainStageId]));
+    Stages.Add(Stage);
+  end;
+  Action.Add('stages', Stages);
+  Evidence := TJSONObject.Create;
+  Evidence.Add('rx_tiles_loaded', OptionalBooleanJson(
+    AResult.Evidence.RxTilesLoaded));
+  Evidence.Add('generated_transitions_ready', OptionalBooleanJson(
+    AResult.Evidence.GeneratedTransitionsReady));
+  Evidence.Add('map_x', OptionalInt64Json(AResult.Evidence.MapX));
+  Evidence.Add('map_y', OptionalInt64Json(AResult.Evidence.MapY));
+  Evidence.Add('game_rev', OptionalInt64Json(AResult.Evidence.GameRev));
+  Evidence.Add('expected_tile_count', OptionalInt64Json(
+    AResult.Evidence.ExpectedTileCount));
+  Evidence.Add('completed_tile_count', OptionalInt64Json(
+    AResult.Evidence.CompletedTileCount));
+  Action.Add('evidence', Evidence);
+  AActions.Add(Action);
+end;
+
+procedure AppendGraphicsReadinessJson(AActions: TJSONArray; const AResult: TGraphicsReadinessDiagnosticResult);
+var
+  Action, Stage, Evidence: TJSONObject;
+  Stages: TJSONArray;
+  GraphicsReadinessStageId: TGraphicsReadinessDiagnosticStageId;
+begin
+  Action := TJSONObject.Create;
+  Action.Add('id', 'graphics_readiness');
+  Action.Add('status', DiagnosticStatusToken(AResult.Status));
+  if AResult.FailureStage.HasValue then
+    Action.Add('failure_stage', GraphicsReadinessDiagnosticStageIdToken(
+      AResult.FailureStage.Value))
+  else
+    Action.Add('failure_stage', TJSONNull.Create);
+  Action.Add('error', DiagnosticErrorJson(AResult.Error));
+  Stages := TJSONArray.Create;
+  for GraphicsReadinessStageId := Low(TGraphicsReadinessDiagnosticStageId)
+    to High(TGraphicsReadinessDiagnosticStageId) do
+  begin
+    Stage := TJSONObject.Create;
+    Stage.Add('id', GraphicsReadinessDiagnosticStageIdToken(GraphicsReadinessStageId));
+    Stage.Add('status', DiagnosticStatusToken(
+      AResult.Stages[GraphicsReadinessStageId]));
+    Stages.Add(Stage);
+  end;
+  Action.Add('stages', Stages);
+  Evidence := TJSONObject.Create;
+  Evidence.Add('context_available', OptionalBooleanJson(AResult.Evidence.ContextAvailable));
+  Evidence.Add('renderer_context_synced', OptionalBooleanJson(AResult.Evidence.RendererContextSynced));
+  Evidence.Add('physical_size_known', OptionalBooleanJson(AResult.Evidence.PhysicalSizeKnown));
+  Evidence.Add('texture_backend_ready', OptionalBooleanJson(AResult.Evidence.TextureBackendReady));
+  Evidence.Add('sampled_program_ready', OptionalBooleanJson(AResult.Evidence.SampledProgramReady));
+  Evidence.Add('physical_width', OptionalInt64Json(AResult.Evidence.PhysicalWidth));
+  Evidence.Add('physical_height', OptionalInt64Json(AResult.Evidence.PhysicalHeight));
+  Evidence.Add('renderer_width', OptionalInt64Json(AResult.Evidence.RendererWidth));
+  Evidence.Add('renderer_height', OptionalInt64Json(AResult.Evidence.RendererHeight));
+  Evidence.Add('max_texture_size', OptionalInt64Json(AResult.Evidence.MaxTextureSize));
+  Action.Add('evidence', Evidence);
+  AActions.Add(Action);
+end;
+
+procedure AppendGraphicsTextureJson(AActions: TJSONArray; const AResult: TGraphicsTextureDiagnosticResult);
+var
+  Action, Stage, Evidence: TJSONObject;
+  Stages: TJSONArray;
+  GraphicsTextureStageId: TGraphicsTextureDiagnosticStageId;
+begin
+  Action := TJSONObject.Create;
+  Action.Add('id', 'graphics_texture');
+  Action.Add('status', DiagnosticStatusToken(AResult.Status));
+  if AResult.FailureStage.HasValue then
+    Action.Add('failure_stage', GraphicsTextureDiagnosticStageIdToken(
+      AResult.FailureStage.Value))
+  else
+    Action.Add('failure_stage', TJSONNull.Create);
+  Action.Add('error', DiagnosticErrorJson(AResult.Error));
+  Stages := TJSONArray.Create;
+  for GraphicsTextureStageId := Low(TGraphicsTextureDiagnosticStageId)
+    to High(TGraphicsTextureDiagnosticStageId) do
+  begin
+    Stage := TJSONObject.Create;
+    Stage.Add('id', GraphicsTextureDiagnosticStageIdToken(GraphicsTextureStageId));
+    Stage.Add('status', DiagnosticStatusToken(
+      AResult.Stages[GraphicsTextureStageId]));
+    Stages.Add(Stage);
+  end;
+  Action.Add('stages', Stages);
+  Evidence := TJSONObject.Create;
+  Evidence.Add('initial_width', OptionalInt64Json(AResult.Evidence.InitialWidth));
+  Evidence.Add('initial_height', OptionalInt64Json(AResult.Evidence.InitialHeight));
+  Evidence.Add('replacement_width', OptionalInt64Json(AResult.Evidence.ReplacementWidth));
+  Evidence.Add('replacement_height', OptionalInt64Json(AResult.Evidence.ReplacementHeight));
+  Evidence.Add('initial_format', OptionalStringJson(AResult.Evidence.InitialFormat));
+  Evidence.Add('replacement_format', OptionalStringJson(AResult.Evidence.ReplacementFormat));
+  Evidence.Add('min_filter', OptionalStringJson(AResult.Evidence.MinFilter));
+  Evidence.Add('mag_filter', OptionalStringJson(AResult.Evidence.MagFilter));
+  Evidence.Add('gen_texture_completed', OptionalBooleanJson(AResult.Evidence.GenTextureCompleted));
+  Evidence.Add('non_zero_texture_id', OptionalBooleanJson(AResult.Evidence.NonZeroTextureId));
+  Evidence.Add('first_bind_completed', OptionalBooleanJson(AResult.Evidence.FirstBindCompleted));
+  Evidence.Add('replacement_update_completed', OptionalBooleanJson(AResult.Evidence.ReplacementUpdateCompleted));
+  Evidence.Add('second_bind_completed', OptionalBooleanJson(AResult.Evidence.SecondBindCompleted));
+  Evidence.Add('delete_attempted', OptionalBooleanJson(AResult.Evidence.DeleteAttempted));
+  Evidence.Add('delete_completed', OptionalBooleanJson(AResult.Evidence.DeleteCompleted));
+  Evidence.Add('cleanup_completed', OptionalBooleanJson(AResult.Evidence.CleanupCompleted));
+  Evidence.Add('context_lost', OptionalBooleanJson(AResult.Evidence.ContextLost));
+  Evidence.Add('cleanup_blocked_by_context', OptionalBooleanJson(AResult.Evidence.CleanupBlockedByContext));
+  Evidence.Add('secondary_cleanup_error',
+    DiagnosticErrorJson(AResult.Evidence.SecondaryCleanupError));
+  Action.Add('evidence', Evidence);
+  AActions.Add(Action);
+end;
+
+procedure AppendGraphicsVisibleDrawJson(AActions: TJSONArray; const AResult: TGraphicsVisibleDrawDiagnosticResult);
+var
+  Action, Stage, Evidence: TJSONObject;
+  Stages: TJSONArray;
+  GraphicsVisibleDrawStageId: TGraphicsVisibleDrawDiagnosticStageId;
+begin
+  Action := TJSONObject.Create;
+  Action.Add('id', 'graphics_visible_draw');
+  Action.Add('status', DiagnosticStatusToken(AResult.Status));
+  if AResult.FailureStage.HasValue then
+    Action.Add('failure_stage', GraphicsVisibleDrawDiagnosticStageIdToken(
+      AResult.FailureStage.Value))
+  else
+    Action.Add('failure_stage', TJSONNull.Create);
+  Action.Add('error', DiagnosticErrorJson(AResult.Error));
+  Stages := TJSONArray.Create;
+  for GraphicsVisibleDrawStageId := Low(TGraphicsVisibleDrawDiagnosticStageId)
+    to High(TGraphicsVisibleDrawDiagnosticStageId) do
+  begin
+    Stage := TJSONObject.Create;
+    Stage.Add('id', GraphicsVisibleDrawDiagnosticStageIdToken(GraphicsVisibleDrawStageId));
+    Stage.Add('status', DiagnosticStatusToken(
+      AResult.Stages[GraphicsVisibleDrawStageId]));
+    Stages.Add(Stage);
+  end;
+  Action.Add('stages', Stages);
+  Evidence := TJSONObject.Create;
+  Evidence.Add('texture_width', OptionalInt64Json(AResult.Evidence.TextureWidth));
+  Evidence.Add('texture_height', OptionalInt64Json(AResult.Evidence.TextureHeight));
+  Evidence.Add('base_frames_completed', OptionalInt64Json(AResult.Evidence.BaseFramesCompleted));
+  Evidence.Add('brightness_frames_completed', OptionalInt64Json(AResult.Evidence.BrightnessFramesCompleted));
+  Evidence.Add('brightness_amount', OptionalInt64Json(AResult.Evidence.BrightnessAmount));
+  Evidence.Add('texture_format', OptionalStringJson(AResult.Evidence.TextureFormat));
+  Evidence.Add('min_filter', OptionalStringJson(AResult.Evidence.MinFilter));
+  Evidence.Add('mag_filter', OptionalStringJson(AResult.Evidence.MagFilter));
+  Evidence.Add('texture_created', OptionalBooleanJson(AResult.Evidence.TextureCreated));
+  Evidence.Add('non_zero_texture_id', OptionalBooleanJson(AResult.Evidence.NonZeroTextureId));
+  Evidence.Add('base_triple_rgba_draws_completed', OptionalBooleanJson(AResult.Evidence.BaseTripleRgbaDrawsCompleted));
+  Evidence.Add('brightness_triple_rgba_draws_completed', OptionalBooleanJson(AResult.Evidence.BrightnessTripleRgbaDrawsCompleted));
+  Evidence.Add('brightness_overlay_applied_after_draws', OptionalBooleanJson(AResult.Evidence.BrightnessOverlayAppliedAfterDraws));
+  Evidence.Add('context_lost', OptionalBooleanJson(AResult.Evidence.ContextLost));
+  Evidence.Add('delete_attempted', OptionalBooleanJson(AResult.Evidence.DeleteAttempted));
+  Evidence.Add('delete_completed', OptionalBooleanJson(AResult.Evidence.DeleteCompleted));
+  Evidence.Add('cleanup_completed', OptionalBooleanJson(AResult.Evidence.CleanupCompleted));
+  Evidence.Add('cleanup_blocked_by_context', OptionalBooleanJson(AResult.Evidence.CleanupBlockedByContext));
+  Evidence.Add('secondary_cleanup_error',
+    DiagnosticErrorJson(AResult.Evidence.SecondaryCleanupError));
+  Action.Add('evidence', Evidence);
+  AActions.Add(Action);
+end;
+
 function DiagnosticReportJsonSnapshot: string;
 var
   State: TDiagnosticReportState;
-  Root, ObjectValue, Action, Stage, Stream: TJSONObject;
+  Root, ObjectValue: TJSONObject;
-  Actions, Stages: TJSONArray;
+  Actions: TJSONArray;
-  StageId: TDiagnosticStageId;
-  TerrainStageId: TTerrainReadinessDiagnosticStageId;
-  Evidence: TJSONObject;
 begin
   State := CurrentDiagnosticReport;
   Root := TJSONObject.Create;
@@ -263,86 +660,13 @@ begin
     Root.Add('selected_map', ObjectValue);
     Root.Add('overall_status', DiagnosticStatusToken(State.OverallStatus));
     Actions := TJSONArray.Create;
-    Action := TJSONObject.Create;
+    AppendFileIOJson(Actions, State.FileIO);
-    Action.Add('id', 'file_io');
+    AppendTerrainReadinessJson(Actions, State.TerrainReadiness);
-    Action.Add('status', DiagnosticStatusToken(State.FileIO.Status));
+    AppendGraphicsReadinessJson(Actions, State.GraphicsReadiness);
-    if State.FileIO.FailureStage.HasValue then
+
-      Action.Add('failure_stage', DiagnosticStageIdToken(State.FileIO.FailureStage.Value))
+    AppendGraphicsTextureJson(Actions, State.GraphicsTexture);
-    else
+
-      Action.Add('failure_stage', TJSONNull.Create);
+    AppendGraphicsVisibleDrawJson(Actions, State.GraphicsVisibleDraw);
-    if State.FileIO.Error.Present then
-    begin
-      ObjectValue := TJSONObject.Create;
-      ObjectValue.Add('class', OptionalStringJson(State.FileIO.Error.ClassName));
-      ObjectValue.Add('message', OptionalStringJson(State.FileIO.Error.MessageText));
-      Action.Add('error', ObjectValue);
-    end else
-      Action.Add('error', TJSONNull.Create);
-    Stages := TJSONArray.Create;
-    for StageId := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
-    begin
-      Stage := TJSONObject.Create;
-      Stage.Add('id', DiagnosticStageIdToken(StageId));
-      Stage.Add('status', DiagnosticStatusToken(State.FileIO.Stages[StageId]));
-      Stages.Add(Stage);
-    end;
-    Action.Add('stages', Stages);
-    Stream := TJSONObject.Create;
-    Stream.Add('size', OptionalInt64Json(State.FileIO.Stream.Size));
-    Stream.Add('position_after_load', OptionalInt64Json(State.FileIO.Stream.PositionAfterLoad));
-    Stream.Add('read_offset', OptionalInt64Json(State.FileIO.Stream.ReadOffset));
-    Stream.Add('requested_read_count', OptionalInt64Json(State.FileIO.Stream.RequestedReadCount));
-    Stream.Add('first_read_count', OptionalInt64Json(State.FileIO.Stream.FirstReadCount));
-    Stream.Add('position_after_first_read', OptionalInt64Json(State.FileIO.Stream.PositionAfterFirstRead));
-    Stream.Add('seek_back_position', OptionalInt64Json(State.FileIO.Stream.SeekBackPosition));
-    Stream.Add('second_read_count', OptionalInt64Json(State.FileIO.Stream.SecondReadCount));
-    Stream.Add('position_after_second_read', OptionalInt64Json(State.FileIO.Stream.PositionAfterSecondRead));
-    Stream.Add('repeat_equal', OptionalBooleanJson(State.FileIO.Stream.RepeatEqual));
-    Action.Add('stream', Stream);
-    Actions.Add(Action);
-    Action := TJSONObject.Create;
-    Action.Add('id', 'terrain_readiness');
-    Action.Add('status', DiagnosticStatusToken(State.TerrainReadiness.Status));
-    if State.TerrainReadiness.FailureStage.HasValue then
-      Action.Add('failure_stage', TerrainReadinessDiagnosticStageIdToken(
-        State.TerrainReadiness.FailureStage.Value))
-    else
-      Action.Add('failure_stage', TJSONNull.Create);
-    if State.TerrainReadiness.Error.Present then
-    begin
-      ObjectValue := TJSONObject.Create;
-      ObjectValue.Add('class', OptionalStringJson(
-        State.TerrainReadiness.Error.ClassName));
-      ObjectValue.Add('message', OptionalStringJson(
-        State.TerrainReadiness.Error.MessageText));
-      Action.Add('error', ObjectValue);
-    end else
-      Action.Add('error', TJSONNull.Create);
-    Stages := TJSONArray.Create;
-    for TerrainStageId := Low(TTerrainReadinessDiagnosticStageId)
-      to High(TTerrainReadinessDiagnosticStageId) do
-    begin
-      Stage := TJSONObject.Create;
-      Stage.Add('id', TerrainReadinessDiagnosticStageIdToken(TerrainStageId));
-      Stage.Add('status', DiagnosticStatusToken(
-        State.TerrainReadiness.Stages[TerrainStageId]));
-      Stages.Add(Stage);
-    end;
-    Action.Add('stages', Stages);
-    Evidence := TJSONObject.Create;
-    Evidence.Add('rx_tiles_loaded', OptionalBooleanJson(
-      State.TerrainReadiness.Evidence.RxTilesLoaded));
-    Evidence.Add('generated_transitions_ready', OptionalBooleanJson(
-      State.TerrainReadiness.Evidence.GeneratedTransitionsReady));
-    Evidence.Add('map_x', OptionalInt64Json(State.TerrainReadiness.Evidence.MapX));
-    Evidence.Add('map_y', OptionalInt64Json(State.TerrainReadiness.Evidence.MapY));
-    Evidence.Add('game_rev', OptionalInt64Json(State.TerrainReadiness.Evidence.GameRev));
-    Evidence.Add('expected_tile_count', OptionalInt64Json(
-      State.TerrainReadiness.Evidence.ExpectedTileCount));
-    Evidence.Add('completed_tile_count', OptionalInt64Json(
-      State.TerrainReadiness.Evidence.CompletedTileCount));
-    Action.Add('evidence', Evidence);
-    Actions.Add(Action);
     Root.Add('actions', Actions);
     Result := Root.AsJSON;
   finally

code/GameDiagnosticsView.pas

@@ -6,29 +6,48 @@ interface
 
 uses
   Classes,
-  CastleUIControls, CastleControls, GameDiagnosticsExport;
+  CastleUIControls, CastleControls, GameDiagnosticsExport,
+  GameDiagnosticsGraphics_Mobile;
 
 type
   TDiagnosticsView = class(TCastleView)
   private
+    type
+      TGraphicsRequest = (grReadiness, grTextureLifecycle, grVisibleDraw);
+
+    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;
@@ -36,7 +55,7 @@ type
 implementation
 
 uses
-  SysUtils, GameDiagnosticsFileIO, GameDiagnosticsReport,
+  SysUtils, Math, GameDiagnosticsFileIO, GameDiagnosticsReport,
   GameDiagnosticsTerrainReadiness;
 
 const
@@ -59,15 +78,19 @@ begin
 end;
 
 constructor TDiagnosticsView.Create(AOwner: TComponent);
-var
-  TitleLabel: TCastleLabel;
 begin
   inherited;
+  FGraphicsSession := nil;
+  FGraphicsCompletionNotifiedDuringDispatch := False;
   FScroll := TCastleScrollView.Create(Self);
-  FScroll.FullSize := True;
+  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;
@@ -76,51 +99,311 @@ begin
   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(FExportFeedbackLabel);
+  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;
-  FContent.InsertFront(FExportButton);
+  FActionRegion.InsertFront(FExportButton);
-  FContent.InsertFront(FTerrainReadinessDetailsLabel);
+  FGraphicsReadinessButton.Caption := 'Test Graphics Readiness' + LineEnding + 'Current Surface';
-  FContent.InsertFront(FTerrainReadinessStatusLabel);
+  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;
-  FContent.InsertFront(FTerrainReadinessButton);
+  FActionRegion.InsertFront(FTerrainReadinessButton);
-  FContent.InsertFront(FDetailsLabel);
-  FContent.InsertFront(FStatusLabel);
   FFileIOButton.Caption := 'Test File I/O';
   FFileIOButton.OnClick := @FileIOClick;
-  FContent.InsertFront(FFileIOButton);
+  FActionRegion.InsertFront(FFileIOButton);
-  TitleLabel := TCastleLabel.Create(Self);
+end;
-  TitleLabel.Caption := 'Tests / Diagnostics';
+
-  FContent.InsertFront(TitleLabel);
+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
-  WrapWidth: Single;
+  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
-  WrapWidth := Width - 2 * LayoutMargin;
+  ViewWidth := EffectiveWidth;
-  if WrapWidth < 1 then WrapWidth := 1;
+  ViewHeight := EffectiveHeight;
-  FDetailsLabel.MaxWidth := WrapWidth;
+  if (ViewWidth <= 0) or (ViewHeight <= 0) then Exit;
-  FTerrainReadinessDetailsLabel.MaxWidth := WrapWidth;
+
-  FExportFeedbackLabel.MaxWidth := WrapWidth;
+  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;
 
-procedure TDiagnosticsView.RefreshReport;
+  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
-  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
@@ -147,10 +430,14 @@ begin
     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;
+  Result := Details;
+end;
 
-  FTerrainReadinessStatusLabel.Caption := 'MAP/RXX terrain readiness: ' +
+function TerrainReadinessDetails(const State: TDiagnosticReportState): string;
-    DiagnosticStatusToken(State.TerrainReadiness.Status);
+var
+  TerrainStage: TTerrainReadinessDiagnosticStageId;
+  Details: string;
+begin
   Details := '';
   for TerrainStage := Low(TTerrainReadinessDiagnosticStageId)
     to High(TTerrainReadinessDiagnosticStageId) do
@@ -186,12 +473,242 @@ begin
     if CompletedTileCount.HasValue then
       Details := Details + LineEnding + 'completed_tile_count: ' + OptionalInt64Text(CompletedTileCount);
   end;
-  FTerrainReadinessDetailsLabel.Caption := Details;
+  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;
 
@@ -235,6 +752,7 @@ begin
   FExportInProgress := True;
   FExportButton.Enabled := False;
   FExportFeedbackLabel.Caption := 'Exporting report…';
+  UpdateWrapWidth;
   ExportDiagnosticReport(DiagnosticReportJsonSnapshot, @ExportComplete);
 end;
 
@@ -250,6 +768,7 @@ begin
     else
       FExportFeedbackLabel.Caption := 'Export error.';
   end;
+  UpdateWrapWidth;
 end;
 
 end.