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; FFileIOInProgress, FExportInProgress: Boolean; procedure RefreshReport; procedure UpdateWrapWidth; procedure FileIOClick(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; 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); FContent.InsertFront(FExportFeedbackLabel); FExportButton.Caption := 'Export Report'; FExportButton.OnClick := @ExportClick; FContent.InsertFront(FExportButton); 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; FExportFeedbackLabel.MaxWidth := WrapWidth; end; procedure TDiagnosticsView.RefreshReport; var State: TDiagnosticReportState; Stage: TDiagnosticStageId; 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; 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.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.