unit GameDiagnosticsView; {$mode objfpc}{$H+}{$codepage utf8} interface uses Classes, CastleUIControls, CastleControls, GameDiagnosticsExport; type TDiagnosticsView = class(TCastleView) private FScroll: TCastleScrollView; FContent: TCastleVerticalGroup; 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 constructor Create(AOwner: TComponent); override; procedure Start; override; procedure Resize; override; end; implementation uses SysUtils, GameDiagnosticsFileIO, GameDiagnosticsReport, GameDiagnosticsTerrainReadiness; const LayoutMargin = 16; UnavailableValue = '—'; function OptionalStringText(const AValue: TOptionalString): string; begin if AValue.HasValue then Result := AValue.Value else Result := UnavailableValue; end; function OptionalInt64Text(const AValue: TOptionalInt64): string; begin if AValue.HasValue then Result := IntToStr(AValue.Value) else Result := UnavailableValue; end; function OptionalBooleanText(const AValue: TOptionalBoolean): string; begin if AValue.HasValue then Result := BoolToStr(AValue.Value, True) else Result := UnavailableValue; end; constructor TDiagnosticsView.Create(AOwner: TComponent); var TitleLabel: TCastleLabel; begin inherited; FScroll := TCastleScrollView.Create(Self); FScroll.FullSize := True; FScroll.EnableDragging := True; InsertFront(FScroll); FContent := TCastleVerticalGroup.Create(Self); FContent.Padding := LayoutMargin; FContent.Spacing := 8; FScroll.ScrollArea.InsertFront(FContent); FStatusLabel := TCastleLabel.Create(Self); FDetailsLabel := TCastleLabel.Create(Self); 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'; FFileIOButton.OnClick := @FileIOClick; FContent.InsertFront(FFileIOButton); TitleLabel := TCastleLabel.Create(Self); TitleLabel.Caption := 'Tests / Diagnostics'; FContent.InsertFront(TitleLabel); end; procedure TDiagnosticsView.UpdateWrapWidth; var WrapWidth: Single; begin WrapWidth := Width - 2 * LayoutMargin; if WrapWidth < 1 then WrapWidth := 1; FDetailsLabel.MaxWidth := WrapWidth; FTerrainReadinessDetailsLabel.MaxWidth := WrapWidth; FExportFeedbackLabel.MaxWidth := WrapWidth; end; procedure TDiagnosticsView.RefreshReport; 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 Details := Details + LineEnding + DiagnosticStageIdToken(Stage) + ': ' + DiagnosticStatusToken(State.FileIO.Stages[Stage]); if State.FileIO.FailureStage.HasValue then Details := Details + LineEnding + 'failure_stage: ' + DiagnosticStageIdToken(State.FileIO.FailureStage.Value); if State.FileIO.Error.Present then begin Details := Details + LineEnding + 'error class: ' + OptionalStringText(State.FileIO.Error.ClassName); Details := Details + LineEnding + 'error message: ' + OptionalStringText(State.FileIO.Error.MessageText); end; with State.FileIO.Stream do begin if Size.HasValue then Details := Details + LineEnding + 'size: ' + OptionalInt64Text(Size); if PositionAfterLoad.HasValue then Details := Details + LineEnding + 'position_after_load: ' + OptionalInt64Text(PositionAfterLoad); if ReadOffset.HasValue then Details := Details + LineEnding + 'read_offset: ' + OptionalInt64Text(ReadOffset); if RequestedReadCount.HasValue then Details := Details + LineEnding + 'requested_read_count: ' + OptionalInt64Text(RequestedReadCount); if FirstReadCount.HasValue then Details := Details + LineEnding + 'first_read_count: ' + OptionalInt64Text(FirstReadCount); if PositionAfterFirstRead.HasValue then Details := Details + LineEnding + 'position_after_first_read: ' + OptionalInt64Text(PositionAfterFirstRead); if SeekBackPosition.HasValue then Details := Details + LineEnding + 'seek_back_position: ' + OptionalInt64Text(SeekBackPosition); if SecondReadCount.HasValue then Details := Details + LineEnding + 'second_read_count: ' + OptionalInt64Text(SecondReadCount); 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; 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; begin inherited; RefreshReport; end; procedure TDiagnosticsView.Resize; begin inherited; UpdateWrapWidth; end; procedure TDiagnosticsView.FileIOClick(Sender: TObject); begin if FFileIOInProgress then Exit; FFileIOInProgress := True; FFileIOButton.Enabled := False; try RunFileIODiagnostic; RefreshReport; finally FFileIOButton.Enabled := True; FFileIOInProgress := False; 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; FExportInProgress := True; FExportButton.Enabled := False; FExportFeedbackLabel.Caption := 'Exporting report…'; ExportDiagnosticReport(DiagnosticReportJsonSnapshot, @ExportComplete); end; procedure TDiagnosticsView.ExportComplete(const AOutcome: TDiagnosticExportOutcome); begin FExportInProgress := False; FExportButton.Enabled := True; case AOutcome.Kind of deokSuccess: FExportFeedbackLabel.Caption := 'Report exported.'; deokCancel: FExportFeedbackLabel.Caption := 'Export canceled.'; deokError: if AOutcome.ErrorMessage <> '' then FExportFeedbackLabel.Caption := 'Export error: ' + AOutcome.ErrorMessage else FExportFeedbackLabel.Caption := 'Export error.'; end; end; end.