diff --git a/code/GameDiagnosticsReport.pas b/code/GameDiagnosticsReport.pas index 5804afc..84a1e64 100644 --- a/code/GameDiagnosticsReport.pas +++ b/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 diff --git a/code/GameDiagnosticsTerrainReadiness.pas b/code/GameDiagnosticsTerrainReadiness.pas new file mode 100644 index 0000000..a841d6d --- /dev/null +++ b/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. diff --git a/code/GameDiagnosticsView.pas b/code/GameDiagnosticsView.pas index 965593b..4bf6134 100644 --- a/code/GameDiagnosticsView.pas +++ b/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; diff --git a/port-source/kam_remake/src/res/KM_ResSprites.pas b/port-source/kam_remake/src/res/KM_ResSprites.pas index 4212ffe..9863c1a 100644 --- a/port-source/kam_remake/src/res/KM_ResSprites.pas +++ b/port-source/kam_remake/src/res/KM_ResSprites.pas @@ -802,7 +802,8 @@ begin try decompressionStream.Read(rxxCount, 4); - gLog.AddTime(RX_INFO[fRT].FileName + ' - %d', [rxxCount]); + if gLog <> nil then + gLog.AddTime(RX_INFO[fRT].FileName + ' - %d', [rxxCount]); if rxxCount = 0 then Exit; @@ -1722,7 +1723,8 @@ var begin Assert(not aLegacyGeneration or (aSprites = nil)); - gLog.AddTime('GenerateTerrainTransitions started. Legacy = ' + BoolToStr(aLegacyGeneration, True)); + if gLog <> nil then + gLog.AddTime('GenerateTerrainTransitions started. Legacy = ' + BoolToStr(aLegacyGeneration, True)); if aLegacyGeneration then begin @@ -1734,7 +1736,8 @@ begin *Integer(High(TKMTileMaskType))*(Integer(High(TKMTileMaskSubType)) + 1); SetLength(fGenTerrainToTerKindLegacy, genTilesCntTemp); FillChar(fGenTerrainToTerKindLegacy[0], SizeOf(fGenTerrainToTerKindLegacy[0])*GenTilesCntTemp, #0); - gLog.AddTime('Legacy: TexId = %d GenTilesCntTemp = %d', [texId, genTilesCntTemp]); + if gLog <> nil then + gLog.AddTime('Legacy: TexId = %d GenTilesCntTemp = %d', [texId, genTilesCntTemp]); end else begin @@ -1747,7 +1750,8 @@ begin SetLength(fGenTerrainToTerKind, genTilesCnt); aSprites.Allocate(texId + genTilesCnt); FillChar(fGenTerrainToTerKind[0], SizeOf(fGenTerrainToTerKind[0])*GenTilesCnt, #0); - gLog.AddTime('TexId = %d GenTilesCnt = %d', [texId, genTilesCnt]); + if gLog <> nil then + gLog.AddTime('TexId = %d GenTilesCnt = %d', [texId, genTilesCnt]); end; generatedMasks := TDictionary.Create; @@ -1858,21 +1862,25 @@ begin if aLegacyGeneration then begin SetLength(fGenTerrainToTerKindLegacy, texId - fGenTexIdStartILegacy); - gLog.AddTime('TexId = %d; TexId - fGenTexIdStartILegacy = %d; uniqueTex = %d; totalTex = %d', [texId, texId - fGenTexIdStartILegacy, uniqueTex, totalTex]); + if gLog <> nil then + gLog.AddTime('TexId = %d; TexId - fGenTexIdStartILegacy = %d; uniqueTex = %d; totalTex = %d', [texId, texId - fGenTexIdStartILegacy, uniqueTex, totalTex]); end else begin // There could be usused place in arrays, as we could use same mask image for different purposes aSprites.Allocate(texId); SetLength(fGenTerrainToTerKind, texId - fGenTexIdStartI); - gLog.AddTime('TexId = %d; TexId - fGenTexIdStartI = %d; uniqueTex = %d; totalTex = %d', [texId, texId - fGenTexIdStartI, uniqueTex, totalTex]); + if gLog <> nil then + gLog.AddTime('TexId = %d; TexId - fGenTexIdStartI = %d; uniqueTex = %d; totalTex = %d', [texId, texId - fGenTexIdStartI, uniqueTex, totalTex]); end; finally - gLog.AddTime('GeneratedMasks cnt = ' + IntToStr(generatedMasks.Count)); + if gLog <> nil then + gLog.AddTime('GeneratedMasks cnt = ' + IntToStr(generatedMasks.Count)); generatedMasks.Free; end; - gLog.AddTime('GenerateTerrainTransitions Done'); + if gLog <> nil then + gLog.AddTime('GenerateTerrainTransitions Done'); end; @@ -2031,7 +2039,8 @@ function TKMResSprites.LoadSprites(aRT: TRXType; aAlphaShadows: Boolean): Boolea var alphaReference, normalReference: string; begin - gLog.AddTime('Load Sprites started'); + if gLog <> nil then + gLog.AddTime('Load Sprites started'); Result := False; if aRT = rxTiles then begin @@ -2072,7 +2081,8 @@ begin // 'Sprites' folder name confused some of the players, cause there is already data/Sprites folder fSprites[aRT].OverloadRXDataFromFolder(ExeDir + 'Modding graphics' + PathDelim, nil); - gLog.AddTime('Load Sprites Done'); + if gLog <> nil then + gLog.AddTime('Load Sprites Done'); // Generate terrain transitions if aRT = rxTiles then