Complete BigTask

code/GameDiagnosticsReport.pas

@@ -15,6 +15,13 @@ type
     dsiSeekReadConsistency
   );
 
+  TTerrainReadinessDiagnosticStageId = (
+    trsiRxTilesLoad,
+    trsiMapStreamLoad,
+    trsiMapHeader,
+    trsiTileRecords
+  );
+
   TOptionalString = record
     HasValue: Boolean;
     Value: string;
@@ -35,6 +42,11 @@ type
     Value: TDiagnosticStageId;
   end;
 
+  TOptionalTerrainReadinessDiagnosticStageId = record
+    HasValue: Boolean;
+    Value: TTerrainReadinessDiagnosticStageId;
+  end;
+
   TDiagnosticError = record
     Present: Boolean;
     ClassName: TOptionalString;
@@ -62,6 +74,24 @@ type
     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;
+
   TDiagnosticApplicationMetadata = record
     Name: string;
     PackageName: string;
@@ -88,12 +118,17 @@ type
     SelectedMap: TDiagnosticSelectedMapMetadata;
     OverallStatus: TDiagnosticStatus;
     FileIO: TFileIODiagnosticResult;
+    TerrainReadiness: TTerrainReadinessDiagnosticResult;
   end;
 
 function CurrentDiagnosticReport: TDiagnosticReportState;
 procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
+procedure ReplaceTerrainReadinessDiagnosticResult(
+  const AResult: TTerrainReadinessDiagnosticResult);
 function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
 function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
+function TerrainReadinessDiagnosticStageIdToken(
+  const AStage: TTerrainReadinessDiagnosticStageId): string;
 function DiagnosticReportJsonSnapshot: string;
 
 implementation
@@ -103,6 +138,7 @@ uses
 
 var
   CurrentFileIO: TFileIODiagnosticResult;
+  CurrentTerrainReadiness: TTerrainReadinessDiagnosticResult;
 
 function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
 begin
@@ -124,6 +160,17 @@ begin
   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';
@@ -138,7 +185,15 @@ begin
   Result.SelectedMap.RelativePath := SelectedMapRelativePath;
   Result.SelectedMap.Url := SelectedMapUrl;
   Result.FileIO := CurrentFileIO;
-  Result.OverallStatus := Result.FileIO.Status;
+  Result.TerrainReadiness := CurrentTerrainReadiness;
+  if (Result.FileIO.Status = dsFail)
+    or (Result.TerrainReadiness.Status = dsFail) then
+    Result.OverallStatus := dsFail
+  else if (Result.FileIO.Status = dsPass)
+    and (Result.TerrainReadiness.Status = dsPass) then
+    Result.OverallStatus := dsPass
+  else
+    Result.OverallStatus := dsNotRun;
 end;
 
 procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
@@ -146,6 +201,12 @@ begin
   CurrentFileIO := AResult;
 end;
 
+procedure ReplaceTerrainReadinessDiagnosticResult(
+  const AResult: TTerrainReadinessDiagnosticResult);
+begin
+  CurrentTerrainReadiness := AResult;
+end;
+
 function OptionalStringJson(const AValue: TOptionalString): TJSONData;
 begin
   if AValue.HasValue then
@@ -176,6 +237,8 @@ var
   Root, ObjectValue, Action, Stage, Stream: TJSONObject;
   Actions, Stages: TJSONArray;
   StageId: TDiagnosticStageId;
+  TerrainStageId: TTerrainReadinessDiagnosticStageId;
+  Evidence: TJSONObject;
 begin
   State := CurrentDiagnosticReport;
   Root := TJSONObject.Create;
@@ -237,6 +300,49 @@ begin
     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/GameDiagnosticsTerrainReadiness.pas

@@ -0,0 +1,148 @@
+unit GameDiagnosticsTerrainReadiness;
+
+{$mode objfpc}{$H+}
+
+interface
+
+procedure RunTerrainReadinessDiagnostic;
+
+implementation
+
+uses
+  GameSelectedMap, GameDiagnosticsReport, KM_ResSprites, KM_ResTypes,
+  KM_CommonClasses, KM_Utils, KM_TerrainUtils, KM_TerrainTypes, SysUtils;
+
+procedure InitializeResult(out AResult: TTerrainReadinessDiagnosticResult);
+var
+  Stage: TTerrainReadinessDiagnosticStageId;
+begin
+  FillChar(AResult, SizeOf(AResult), 0);
+  AResult.Status := dsNotRun;
+  for Stage := Low(TTerrainReadinessDiagnosticStageId) to
+    High(TTerrainReadinessDiagnosticStageId) do
+    AResult.Stages[Stage] := dsNotRun;
+end;
+
+procedure FailStage(var AResult: TTerrainReadinessDiagnosticResult;
+  const AStage: TTerrainReadinessDiagnosticStageId; const AMessage: string;
+  const AException: Exception = nil);
+begin
+  AResult.Stages[AStage] := dsFail;
+  AResult.Status := dsFail;
+  AResult.FailureStage.HasValue := True;
+  AResult.FailureStage.Value := AStage;
+  AResult.Error.Present := True;
+  AResult.Error.MessageText.HasValue := True;
+  AResult.Error.MessageText.Value := AMessage;
+  if AException <> nil then
+  begin
+    AResult.Error.ClassName.HasValue := True;
+    AResult.Error.ClassName.Value := AException.ClassName;
+  end;
+end;
+
+procedure FailException(var AResult: TTerrainReadinessDiagnosticResult;
+  const AStage: TTerrainReadinessDiagnosticStageId; const AException: Exception);
+begin
+  FailStage(AResult, AStage, AException.Message, AException);
+end;
+
+procedure RunTerrainReadinessDiagnostic;
+var
+  ResultData: TTerrainReadinessDiagnosticResult;
+  SpriteOwner: TKMResSprites;
+  MapStream: TKMemoryStreamBinary;
+  MapUrl: string;
+  MapX, MapY, GameRev: Integer;
+  TileBasic: TKMTerrainTileBasic;
+begin
+  InitializeResult(ResultData);
+  SpriteOwner := nil;
+  MapStream := nil;
+  try
+    try
+      SpriteOwner := TKMResSprites.Create(nil, nil, False);
+      if not SpriteOwner.LoadSprites(rxTiles, False) then
+      begin
+        ResultData.Evidence.RxTilesLoaded.HasValue := True;
+        ResultData.Evidence.RxTilesLoaded.Value := False;
+        ResultData.Evidence.GeneratedTransitionsReady.HasValue := True;
+        ResultData.Evidence.GeneratedTransitionsReady.Value := False;
+        FailStage(ResultData, trsiRxTilesLoad,
+          'Canonical rxTiles loading did not succeed');
+      end
+      else
+      begin
+        ResultData.Stages[trsiRxTilesLoad] := dsPass;
+        ResultData.Evidence.RxTilesLoaded.HasValue := True;
+        ResultData.Evidence.RxTilesLoaded.Value := True;
+        ResultData.Evidence.GeneratedTransitionsReady.HasValue := True;
+        ResultData.Evidence.GeneratedTransitionsReady.Value := True;
+      end;
+    except
+      on E: Exception do
+        FailException(ResultData, trsiRxTilesLoad, E);
+    end;
+
+    if ResultData.Status = dsNotRun then
+      try
+        MapUrl := SelectedMapUrl;
+        MapStream := TKMemoryStreamBinary.Create;
+        MapStream.LoadFromFile(MapUrl);
+        ResultData.Stages[trsiMapStreamLoad] := dsPass;
+      except
+        on E: Exception do
+          FailException(ResultData, trsiMapStreamLoad, E);
+      end;
+
+    if ResultData.Status = dsNotRun then
+      try
+        LoadMapHeader(MapStream, MapX, MapY, GameRev);
+        ResultData.Stages[trsiMapHeader] := dsPass;
+        ResultData.Evidence.MapX.HasValue := True;
+        ResultData.Evidence.MapX.Value := Int64(MapX);
+        ResultData.Evidence.MapY.HasValue := True;
+        ResultData.Evidence.MapY.Value := Int64(MapY);
+        ResultData.Evidence.GameRev.HasValue := True;
+        ResultData.Evidence.GameRev.Value := Int64(GameRev);
+        ResultData.Evidence.ExpectedTileCount.HasValue := True;
+        ResultData.Evidence.ExpectedTileCount.Value := Int64(MapX) * Int64(MapY);
+        ResultData.Evidence.CompletedTileCount.HasValue := True;
+        ResultData.Evidence.CompletedTileCount.Value := 0;
+      except
+        on E: Exception do
+          FailException(ResultData, trsiMapHeader, E);
+      end;
+
+    if ResultData.Status = dsNotRun then
+      try
+        while ResultData.Evidence.CompletedTileCount.Value <
+          ResultData.Evidence.ExpectedTileCount.Value do
+        begin
+          ReadTileFromStream(MapStream, TileBasic, GameRev);
+          Inc(ResultData.Evidence.CompletedTileCount.Value);
+        end;
+        if ResultData.Evidence.CompletedTileCount.Value =
+          ResultData.Evidence.ExpectedTileCount.Value then
+        begin
+          ResultData.Stages[trsiTileRecords] := dsPass;
+          ResultData.Status := dsPass;
+        end;
+      except
+        on E: Exception do
+          FailException(ResultData, trsiTileRecords, E);
+      end;
+  finally
+    try
+      ReplaceTerrainReadinessDiagnosticResult(ResultData);
+    finally
+      try
+        MapStream.Free;
+      finally
+        SpriteOwner.Free;
+      end;
+    end;
+  end;
+end;
+
+end.

code/GameDiagnosticsView.pas

@@ -16,10 +16,15 @@ type
     FFileIOButton: TCastleButton;
     FStatusLabel, FDetailsLabel, FExportFeedbackLabel: TCastleLabel;
     FExportButton: TCastleButton;
+    FTerrainReadinessButton: TCastleButton;
+    FTerrainReadinessStatusLabel: TCastleLabel;
+    FTerrainReadinessDetailsLabel: TCastleLabel;
     FFileIOInProgress, FExportInProgress: Boolean;
+    FTerrainReadinessInProgress: Boolean;
     procedure RefreshReport;
     procedure UpdateWrapWidth;
     procedure FileIOClick(Sender: TObject);
+    procedure TerrainReadinessClick(Sender: TObject);
     procedure ExportClick(Sender: TObject);
     procedure ExportComplete(const AOutcome: TDiagnosticExportOutcome);
   public
@@ -31,7 +36,8 @@ type
 implementation
 
 uses
-  SysUtils, GameDiagnosticsFileIO, GameDiagnosticsReport;
+  SysUtils, GameDiagnosticsFileIO, GameDiagnosticsReport,
+  GameDiagnosticsTerrainReadiness;
 
 const
   LayoutMargin = 16;
@@ -72,11 +78,19 @@ begin
   FExportFeedbackLabel := TCastleLabel.Create(Self);
   FFileIOButton := TCastleButton.Create(Self);
   FExportButton := TCastleButton.Create(Self);
+  FTerrainReadinessButton := TCastleButton.Create(Self);
+  FTerrainReadinessStatusLabel := TCastleLabel.Create(Self);
+  FTerrainReadinessDetailsLabel := TCastleLabel.Create(Self);
 
   FContent.InsertFront(FExportFeedbackLabel);
   FExportButton.Caption := 'Export Report';
   FExportButton.OnClick := @ExportClick;
   FContent.InsertFront(FExportButton);
+  FContent.InsertFront(FTerrainReadinessDetailsLabel);
+  FContent.InsertFront(FTerrainReadinessStatusLabel);
+  FTerrainReadinessButton.Caption := 'Test MAP/RXX Terrain Readiness';
+  FTerrainReadinessButton.OnClick := @TerrainReadinessClick;
+  FContent.InsertFront(FTerrainReadinessButton);
   FContent.InsertFront(FDetailsLabel);
   FContent.InsertFront(FStatusLabel);
   FFileIOButton.Caption := 'Test File I/O';
@@ -94,6 +108,7 @@ begin
   WrapWidth := Width - 2 * LayoutMargin;
   if WrapWidth < 1 then WrapWidth := 1;
   FDetailsLabel.MaxWidth := WrapWidth;
+  FTerrainReadinessDetailsLabel.MaxWidth := WrapWidth;
   FExportFeedbackLabel.MaxWidth := WrapWidth;
 end;
 
@@ -101,6 +116,7 @@ procedure TDiagnosticsView.RefreshReport;
 var
   State: TDiagnosticReportState;
   Stage: TDiagnosticStageId;
+  TerrainStage: TTerrainReadinessDiagnosticStageId;
   Details: string;
 begin
   State := CurrentDiagnosticReport;
@@ -132,6 +148,45 @@ begin
     if RepeatEqual.HasValue then Details := Details + LineEnding + 'repeat_equal: ' + OptionalBooleanText(RepeatEqual);
   end;
   FDetailsLabel.Caption := Details;
+
+  FTerrainReadinessStatusLabel.Caption := 'MAP/RXX terrain readiness: ' +
+    DiagnosticStatusToken(State.TerrainReadiness.Status);
+  Details := '';
+  for TerrainStage := Low(TTerrainReadinessDiagnosticStageId)
+    to High(TTerrainReadinessDiagnosticStageId) do
+  begin
+    if Details <> '' then Details := Details + LineEnding;
+    Details := Details + TerrainReadinessDiagnosticStageIdToken(TerrainStage) + ': ' +
+      DiagnosticStatusToken(State.TerrainReadiness.Stages[TerrainStage]);
+  end;
+  if State.TerrainReadiness.FailureStage.HasValue then
+    Details := Details + LineEnding + 'failure_stage: ' +
+      TerrainReadinessDiagnosticStageIdToken(
+        State.TerrainReadiness.FailureStage.Value);
+  if State.TerrainReadiness.Error.Present then
+  begin
+    Details := Details + LineEnding + 'error class: ' +
+      OptionalStringText(State.TerrainReadiness.Error.ClassName);
+    Details := Details + LineEnding + 'error message: ' +
+      OptionalStringText(State.TerrainReadiness.Error.MessageText);
+  end;
+  with State.TerrainReadiness.Evidence do
+  begin
+    if RxTilesLoaded.HasValue then
+      Details := Details + LineEnding + 'rx_tiles_loaded: ' +
+        OptionalBooleanText(RxTilesLoaded);
+    if GeneratedTransitionsReady.HasValue then
+      Details := Details + LineEnding + 'generated_transitions_ready: ' +
+        OptionalBooleanText(GeneratedTransitionsReady);
+    if MapX.HasValue then Details := Details + LineEnding + 'map_x: ' + OptionalInt64Text(MapX);
+    if MapY.HasValue then Details := Details + LineEnding + 'map_y: ' + OptionalInt64Text(MapY);
+    if GameRev.HasValue then Details := Details + LineEnding + 'game_rev: ' + OptionalInt64Text(GameRev);
+    if ExpectedTileCount.HasValue then
+      Details := Details + LineEnding + 'expected_tile_count: ' + OptionalInt64Text(ExpectedTileCount);
+    if CompletedTileCount.HasValue then
+      Details := Details + LineEnding + 'completed_tile_count: ' + OptionalInt64Text(CompletedTileCount);
+  end;
+  FTerrainReadinessDetailsLabel.Caption := Details;
 end;
 
 procedure TDiagnosticsView.Start;
@@ -160,6 +215,20 @@ begin
   end;
 end;
 
+procedure TDiagnosticsView.TerrainReadinessClick(Sender: TObject);
+begin
+  if FTerrainReadinessInProgress then Exit;
+  FTerrainReadinessInProgress := True;
+  FTerrainReadinessButton.Enabled := False;
+  try
+    RunTerrainReadinessDiagnostic;
+    RefreshReport;
+  finally
+    FTerrainReadinessButton.Enabled := True;
+    FTerrainReadinessInProgress := False;
+  end;
+end;
+
 procedure TDiagnosticsView.ExportClick(Sender: TObject);
 begin
   if FExportInProgress then Exit;