This commit is contained in:
admin_d committed
1 parent
19ee837986
commit
c2127c3f31
14 files changed
+3621
-5
No files matched your search
@@ -0,0 +1,182 @@
|
||||
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);
|
||||
begin
|
||||
inherited;
|
||||
FScroll := TCastleScrollView.Create(Self);
|
||||
FScroll.FullSize := True;
|
||||
FScroll.EnableDragging := True;
|
||||
Controls.InsertFront(FScroll);
|
||||
|
||||
FContent := TCastleVerticalGroup.Create(Self);
|
||||
FContent.Padding := LayoutMargin;
|
||||
FContent.Spacing := 8;
|
||||
FScroll.ScrollArea.Controls.InsertFront(FContent);
|
||||
|
||||
FStatusLabel := TCastleLabel.Create(Self);
|
||||
FDetailsLabel := TCastleLabel.Create(Self);
|
||||
FExportFeedbackLabel := TCastleLabel.Create(Self);
|
||||
FFileIOButton := TCastleButton.Create(Self);
|
||||
FExportButton := TCastleButton.Create(Self);
|
||||
|
||||
FContent.Controls.InsertFront(FExportFeedbackLabel);
|
||||
FExportButton.Caption := 'Export Report';
|
||||
FExportButton.OnClick := @ExportClick;
|
||||
FContent.Controls.InsertFront(FExportButton);
|
||||
FContent.Controls.InsertFront(FDetailsLabel);
|
||||
FContent.Controls.InsertFront(FStatusLabel);
|
||||
FFileIOButton.Caption := 'Test File I/O';
|
||||
FFileIOButton.OnClick := @FileIOClick;
|
||||
FContent.Controls.InsertFront(FFileIOButton);
|
||||
with TCastleLabel.Create(Self) do begin Caption := 'Tests / Diagnostics'; FContent.Controls.InsertFront(Self); end;
|
||||
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.
|
||||
Reference in new issue
Block a user