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.