unit GameDiagnosticsReport;

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

interface

type
  TDiagnosticStatus = (dsNotRun, dsPass, dsFail);

  TDiagnosticStageId = (
    dsiResourceExists,
    dsiResourceOpen,
    dsiCallerStreamLoad,
    dsiStreamState,
    dsiSeekReadConsistency
  );

  TTerrainReadinessDiagnosticStageId = (
    trsiRxTilesLoad,
    trsiMapStreamLoad,
    trsiMapHeader,
    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;
  end;

  TOptionalInt64 = record
    HasValue: Boolean;
    Value: Int64;
  end;

  TOptionalBoolean = record
    HasValue: Boolean;
    Value: Boolean;
  end;

  TOptionalDiagnosticStageId = record
    HasValue: Boolean;
    Value: TDiagnosticStageId;
  end;

  TOptionalTerrainReadinessDiagnosticStageId = record
    HasValue: Boolean;
    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;
    MessageText: TOptionalString;
  end;

  TFileIODiagnosticStreamResult = record
    Size: TOptionalInt64;
    PositionAfterLoad: TOptionalInt64;
    ReadOffset: TOptionalInt64;
    RequestedReadCount: TOptionalInt64;
    FirstReadCount: TOptionalInt64;
    PositionAfterFirstRead: TOptionalInt64;
    SeekBackPosition: TOptionalInt64;
    SecondReadCount: TOptionalInt64;
    PositionAfterSecondRead: TOptionalInt64;
    RepeatEqual: TOptionalBoolean;
  end;

  TFileIODiagnosticResult = record
    Status: TDiagnosticStatus;
    FailureStage: TOptionalDiagnosticStageId;
    Error: TDiagnosticError;
    Stages: array[TDiagnosticStageId] of TDiagnosticStatus;
    Stream: TFileIODiagnosticStreamResult;
  end;

  TTerrainReadinessDiagnosticEvidence = record
    RxTilesLoaded: TOptionalBoolean;
    GeneratedTransitionsReady: TOptionalBoolean;
    MapX: TOptionalInt64;
    MapY: TOptionalInt64;
    GameRev: TOptionalInt64;
    ExpectedTileCount: TOptionalInt64;
    CompletedTileCount: TOptionalInt64;
  end;

  TTerrainReadinessDiagnosticResult = record
    Status: TDiagnosticStatus;
    FailureStage: TOptionalTerrainReadinessDiagnosticStageId;
    Error: TDiagnosticError;
    Stages: array[TTerrainReadinessDiagnosticStageId] of TDiagnosticStatus;
    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;
    Version: string;
    VersionCode: Int64;
    BuildId: TOptionalString;
  end;

  TDiagnosticRuntimeMetadata = record
    Platform: string;
    OsVersion: TOptionalString;
    DeviceModel: TOptionalString;
    CpuArch: TOptionalString;
  end;

  TDiagnosticSelectedMapMetadata = record
    RelativePath: string;
    Url: string;
  end;

  TDiagnosticReportState = record
    ApplicationInfo: TDiagnosticApplicationMetadata;
    RuntimeInfo: TDiagnosticRuntimeMetadata;
    SelectedMap: TDiagnosticSelectedMapMetadata;
    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

uses
  fpjson, GameSelectedMap;

var
  CurrentFileIO: TFileIODiagnosticResult;
  CurrentTerrainReadiness: TTerrainReadinessDiagnosticResult;
  CurrentGraphicsReadiness: TGraphicsReadinessDiagnosticResult;
  CurrentGraphicsTexture: TGraphicsTextureDiagnosticResult;
  CurrentGraphicsVisibleDraw: TGraphicsVisibleDrawDiagnosticResult;

function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
begin
  case AStatus of
    dsNotRun: Result := 'NOT_RUN';
    dsPass: Result := 'PASS';
    dsFail: Result := 'FAIL';
  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
    dsiResourceExists: Result := 'resource_exists';
    dsiResourceOpen: Result := 'resource_open';
    dsiCallerStreamLoad: Result := 'caller_stream_load';
    dsiStreamState: Result := 'stream_state';
    dsiSeekReadConsistency: Result := 'seek_read_consistency';
  end;
end;

function TerrainReadinessDiagnosticStageIdToken(
  const AStage: TTerrainReadinessDiagnosticStageId): string;
begin
  case AStage of
    trsiRxTilesLoad: Result := 'rx_tiles_load';
    trsiMapStreamLoad: Result := 'map_stream_load';
    trsiMapHeader: Result := 'map_header';
    trsiTileRecords: Result := 'tile_records';
  end;
end;

function CurrentDiagnosticReport: TDiagnosticReportState;
begin
  Result.ApplicationInfo.Name := 'kam_mobile';
  Result.ApplicationInfo.PackageName := 'org.kammobile.kamremake';
  Result.ApplicationInfo.Version := '0.4.0';
  Result.ApplicationInfo.VersionCode := 30;
  Result.ApplicationInfo.BuildId.HasValue := False;
  Result.RuntimeInfo.Platform := 'android';
  Result.RuntimeInfo.OsVersion.HasValue := False;
  Result.RuntimeInfo.DeviceModel.HasValue := False;
  Result.RuntimeInfo.CpuArch.HasValue := False;
  Result.SelectedMap.RelativePath := SelectedMapRelativePath;
  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)
    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)
    and (Result.GraphicsReadiness.Status = dsPass)
    and (Result.GraphicsTexture.Status = dsPass)
    and (Result.GraphicsVisibleDraw.Status = dsPass) then
    Result.OverallStatus := dsPass
  else
    Result.OverallStatus := dsNotRun;
end;

procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
begin
  CurrentFileIO := AResult;
end;

procedure ReplaceTerrainReadinessDiagnosticResult(
  const AResult: TTerrainReadinessDiagnosticResult);
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
    Result := TJSONString.Create(AValue.Value)
  else
    Result := TJSONNull.Create;
end;

function OptionalInt64Json(const AValue: TOptionalInt64): TJSONData;
begin
  if AValue.HasValue then
    Result := TJSONIntegerNumber.Create(AValue.Value)
  else
    Result := TJSONNull.Create;
end;

function OptionalBooleanJson(const AValue: TOptionalBoolean): TJSONData;
begin
  if AValue.HasValue then
    Result := TJSONBoolean.Create(AValue.Value)
  else
    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: TJSONObject;
  Actions: TJSONArray;
begin
  State := CurrentDiagnosticReport;
  Root := TJSONObject.Create;
  try
    Root.Add('schema', 'kam-mobile-diagnostics/1');
    ObjectValue := TJSONObject.Create;
    ObjectValue.Add('name', State.ApplicationInfo.Name);
    ObjectValue.Add('package', State.ApplicationInfo.PackageName);
    ObjectValue.Add('version', State.ApplicationInfo.Version);
    ObjectValue.Add('version_code', State.ApplicationInfo.VersionCode);
    ObjectValue.Add('build_id', OptionalStringJson(State.ApplicationInfo.BuildId));
    Root.Add('application', ObjectValue);
    ObjectValue := TJSONObject.Create;
    ObjectValue.Add('platform', State.RuntimeInfo.Platform);
    ObjectValue.Add('os_version', OptionalStringJson(State.RuntimeInfo.OsVersion));
    ObjectValue.Add('device_model', OptionalStringJson(State.RuntimeInfo.DeviceModel));
    ObjectValue.Add('cpu_arch', OptionalStringJson(State.RuntimeInfo.CpuArch));
    Root.Add('runtime', ObjectValue);
    ObjectValue := TJSONObject.Create;
    ObjectValue.Add('relative_path', State.SelectedMap.RelativePath);
    ObjectValue.Add('url', State.SelectedMap.Url);
    Root.Add('selected_map', ObjectValue);
    Root.Add('overall_status', DiagnosticStatusToken(State.OverallStatus));
    Actions := TJSONArray.Create;
    AppendFileIOJson(Actions, State.FileIO);
    AppendTerrainReadinessJson(Actions, State.TerrainReadiness);
    AppendGraphicsReadinessJson(Actions, State.GraphicsReadiness);

    AppendGraphicsTextureJson(Actions, State.GraphicsTexture);

    AppendGraphicsVisibleDrawJson(Actions, State.GraphicsVisibleDraw);
    Root.Add('actions', Actions);
    Result := Root.AsJSON;
  finally
    Root.Free;
  end;
end;

end.