This commit is contained in:
1 parent
19ee837986
commit
c2127c3f31
14 files changed
+3621
-5
No files matched your search
@@ -0,0 +1,116 @@
|
||||
unit GameDiagnosticsExport;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TDiagnosticExportOutcomeKind = (deokSuccess, deokCancel, deokError);
|
||||
|
||||
TDiagnosticExportOutcome = record
|
||||
Kind: TDiagnosticExportOutcomeKind;
|
||||
ErrorMessage: string;
|
||||
end;
|
||||
|
||||
TDiagnosticExportCallback = procedure(const AOutcome: TDiagnosticExportOutcome) of object;
|
||||
|
||||
procedure ExportDiagnosticReport(
|
||||
const AJsonSnapshot: string;
|
||||
const ACallback: TDiagnosticExportCallback
|
||||
);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Classes, CastleMessaging, CastleStringUtils, SysUtils;
|
||||
|
||||
const
|
||||
ExportResultToken = 'diagnostic-report-export-result';
|
||||
|
||||
type
|
||||
TDiagnosticExportListener = class
|
||||
private
|
||||
FPending: Boolean;
|
||||
FCallback: TDiagnosticExportCallback;
|
||||
procedure Complete(const AKind: TDiagnosticExportOutcomeKind;
|
||||
const AErrorMessage: string);
|
||||
function MessageReceived(const Received: TCastleStringList;
|
||||
const ReceivedStream: TMemoryStream): Boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Export(const AJsonSnapshot: string;
|
||||
const ACallback: TDiagnosticExportCallback);
|
||||
end;
|
||||
|
||||
constructor TDiagnosticExportListener.Create;
|
||||
begin
|
||||
inherited;
|
||||
Messaging.OnReceive.Add(@MessageReceived);
|
||||
end;
|
||||
|
||||
destructor TDiagnosticExportListener.Destroy;
|
||||
begin
|
||||
Messaging.OnReceive.Remove(@MessageReceived);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TDiagnosticExportListener.Complete(const AKind: TDiagnosticExportOutcomeKind;
|
||||
const AErrorMessage: string);
|
||||
var
|
||||
Outcome: TDiagnosticExportOutcome;
|
||||
Callback: TDiagnosticExportCallback;
|
||||
begin
|
||||
Callback := FCallback;
|
||||
FCallback := nil;
|
||||
FPending := False;
|
||||
Outcome.Kind := AKind;
|
||||
Outcome.ErrorMessage := AErrorMessage;
|
||||
if Assigned(Callback) then
|
||||
Callback(Outcome);
|
||||
end;
|
||||
|
||||
function TDiagnosticExportListener.MessageReceived(
|
||||
const Received: TCastleStringList;
|
||||
const ReceivedStream: TMemoryStream): Boolean;
|
||||
begin
|
||||
Result := (Received.Count > 0) and (Received[0] = ExportResultToken);
|
||||
if not Result or not FPending then
|
||||
Exit;
|
||||
|
||||
if (Received.Count = 2) and (Received[1] = 'success') then
|
||||
Complete(deokSuccess, '')
|
||||
else
|
||||
if (Received.Count = 2) and (Received[1] = 'cancel') then
|
||||
Complete(deokCancel, '')
|
||||
else
|
||||
if (Received.Count = 3) and (Received[1] = 'error') then
|
||||
Complete(deokError, Received[2])
|
||||
else
|
||||
Complete(deokError, 'Malformed export-service response');
|
||||
end;
|
||||
|
||||
procedure TDiagnosticExportListener.Export(const AJsonSnapshot: string;
|
||||
const ACallback: TDiagnosticExportCallback);
|
||||
begin
|
||||
if FPending then
|
||||
raise Exception.Create('Diagnostic report export is already pending');
|
||||
FPending := True;
|
||||
FCallback := ACallback;
|
||||
Messaging.Send(['diagnostic-report-export', AJsonSnapshot]);
|
||||
end;
|
||||
|
||||
var
|
||||
ExportListener: TDiagnosticExportListener;
|
||||
|
||||
procedure ExportDiagnosticReport(const AJsonSnapshot: string;
|
||||
const ACallback: TDiagnosticExportCallback);
|
||||
begin
|
||||
ExportListener.Export(AJsonSnapshot, ACallback);
|
||||
end;
|
||||
|
||||
initialization
|
||||
ExportListener := TDiagnosticExportListener.Create;
|
||||
finalization
|
||||
FreeAndNil(ExportListener);
|
||||
end.
|
||||
@@ -0,0 +1,265 @@
|
||||
unit GameDiagnosticsFileIO;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
procedure RunFileIODiagnostic;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Classes, SysUtils, GameSelectedMap, GameDiagnosticsReport, KaMResourceInput,
|
||||
KM_CommonClasses;
|
||||
|
||||
procedure InitializeResult(out AResult: TFileIODiagnosticResult);
|
||||
var
|
||||
Stage: TDiagnosticStageId;
|
||||
begin
|
||||
FillChar(AResult, SizeOf(AResult), 0);
|
||||
AResult.Status := dsNotRun;
|
||||
for Stage := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
|
||||
AResult.Stages[Stage] := dsNotRun;
|
||||
end;
|
||||
|
||||
procedure FailStage(var AResult: TFileIODiagnosticResult;
|
||||
const AStage: TDiagnosticStageId; 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: TFileIODiagnosticResult;
|
||||
const AStage: TDiagnosticStageId; const AException: Exception);
|
||||
begin
|
||||
FailStage(AResult, AStage, AException.Message, AException);
|
||||
end;
|
||||
|
||||
function RunResourceExists(const AMapUrl: string;
|
||||
var AResult: TFileIODiagnosticResult): Boolean;
|
||||
begin
|
||||
try
|
||||
Result := KaMResourceExists(AMapUrl);
|
||||
if Result then
|
||||
AResult.Stages[dsiResourceExists] := dsPass
|
||||
else
|
||||
FailStage(AResult, dsiResourceExists,
|
||||
'Selected resource is not present');
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
FailException(AResult, dsiResourceExists, E);
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function RunResourceOpen(const AMapUrl: string;
|
||||
var AResult: TFileIODiagnosticResult): Boolean;
|
||||
var
|
||||
Source: TStream;
|
||||
begin
|
||||
Result := False;
|
||||
Source := nil;
|
||||
try
|
||||
try
|
||||
Source := KaMOpenResourceStream(AMapUrl);
|
||||
if Source = nil then
|
||||
begin
|
||||
FailStage(AResult, dsiResourceOpen, 'Resource open returned no stream');
|
||||
Exit;
|
||||
end;
|
||||
Source.Free;
|
||||
Source := nil;
|
||||
AResult.Stages[dsiResourceOpen] := dsPass;
|
||||
Result := True;
|
||||
except
|
||||
on E: Exception do
|
||||
FailException(AResult, dsiResourceOpen, E);
|
||||
end;
|
||||
finally
|
||||
if Source <> nil then
|
||||
try
|
||||
Source.Free;
|
||||
except
|
||||
on E: Exception do
|
||||
if AResult.Status <> dsFail then
|
||||
FailException(AResult, dsiResourceOpen, E);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function RunCallerStreamLoad(const AMapUrl: string;
|
||||
var AStream: TKMemoryStreamBinary; var AResult: TFileIODiagnosticResult): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
try
|
||||
AStream := TKMemoryStreamBinary.Create;
|
||||
AStream.LoadFromFile(AMapUrl);
|
||||
AResult.Stages[dsiCallerStreamLoad] := dsPass;
|
||||
Result := True;
|
||||
except
|
||||
on E: Exception do
|
||||
FailException(AResult, dsiCallerStreamLoad, E);
|
||||
end;
|
||||
end;
|
||||
|
||||
function RunStreamState(const AStream: TKMemoryStreamBinary;
|
||||
var AResult: TFileIODiagnosticResult): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
try
|
||||
AResult.Stream.Size.Value := AStream.Size;
|
||||
AResult.Stream.Size.HasValue := True;
|
||||
AResult.Stream.PositionAfterLoad.Value := AStream.Position;
|
||||
AResult.Stream.PositionAfterLoad.HasValue := True;
|
||||
if AStream.Size <= 0 then
|
||||
FailStage(AResult, dsiStreamState, 'Loaded stream is empty')
|
||||
else if AStream.Position <> 0 then
|
||||
FailStage(AResult, dsiStreamState, 'Loaded stream position is not zero')
|
||||
else
|
||||
begin
|
||||
AResult.Stages[dsiStreamState] := dsPass;
|
||||
Result := True;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
FailException(AResult, dsiStreamState, E);
|
||||
end;
|
||||
end;
|
||||
|
||||
function RunSeekReadConsistency(const AStream: TKMemoryStreamBinary;
|
||||
var AResult: TFileIODiagnosticResult): Boolean;
|
||||
var
|
||||
Requested, FirstCount, SecondCount, ExpectedPosition, RestoredPosition: LongInt;
|
||||
FirstBytes, SecondBytes: array of Byte;
|
||||
I: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
try
|
||||
try
|
||||
AResult.Stream.ReadOffset.Value := 0;
|
||||
AResult.Stream.ReadOffset.HasValue := True;
|
||||
Requested := 32;
|
||||
if AStream.Size < Requested then Requested := LongInt(AStream.Size);
|
||||
AResult.Stream.RequestedReadCount.Value := Requested;
|
||||
AResult.Stream.RequestedReadCount.HasValue := True;
|
||||
SetLength(FirstBytes, Requested);
|
||||
SetLength(SecondBytes, Requested);
|
||||
|
||||
FirstCount := AStream.Read(FirstBytes[0], Requested);
|
||||
AResult.Stream.FirstReadCount.Value := FirstCount;
|
||||
AResult.Stream.FirstReadCount.HasValue := True;
|
||||
AResult.Stream.PositionAfterFirstRead.Value := AStream.Position;
|
||||
AResult.Stream.PositionAfterFirstRead.HasValue := True;
|
||||
ExpectedPosition := FirstCount;
|
||||
if (FirstCount <> Requested) or (AStream.Position <> ExpectedPosition) then
|
||||
begin
|
||||
FailStage(AResult, dsiSeekReadConsistency, 'First read did not advance as required');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
AResult.Stream.SeekBackPosition.Value := AStream.Seek(0, soBeginning);
|
||||
AResult.Stream.SeekBackPosition.HasValue := True;
|
||||
if (AResult.Stream.SeekBackPosition.Value <> 0) or (AStream.Position <> 0) then
|
||||
begin
|
||||
FailStage(AResult, dsiSeekReadConsistency, 'Seek back did not return to zero');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SecondCount := AStream.Read(SecondBytes[0], Requested);
|
||||
AResult.Stream.SecondReadCount.Value := SecondCount;
|
||||
AResult.Stream.SecondReadCount.HasValue := True;
|
||||
AResult.Stream.PositionAfterSecondRead.Value := AStream.Position;
|
||||
AResult.Stream.PositionAfterSecondRead.HasValue := True;
|
||||
ExpectedPosition := SecondCount;
|
||||
if (SecondCount <> Requested) or (AStream.Position <> ExpectedPosition) then
|
||||
begin
|
||||
FailStage(AResult, dsiSeekReadConsistency, 'Second read did not advance as required');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
AResult.Stream.RepeatEqual.Value := True;
|
||||
AResult.Stream.RepeatEqual.HasValue := True;
|
||||
for I := 0 to Requested - 1 do
|
||||
if FirstBytes[I] <> SecondBytes[I] then
|
||||
begin
|
||||
AResult.Stream.RepeatEqual.Value := False;
|
||||
Break;
|
||||
end;
|
||||
if not AResult.Stream.RepeatEqual.Value then
|
||||
begin
|
||||
FailStage(AResult, dsiSeekReadConsistency, 'Repeated reads differ');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
except
|
||||
on E: Exception do
|
||||
FailException(AResult, dsiSeekReadConsistency, E);
|
||||
end;
|
||||
finally
|
||||
try
|
||||
RestoredPosition := AStream.Seek(AResult.Stream.PositionAfterLoad.Value, soBeginning);
|
||||
if ((RestoredPosition <> AResult.Stream.PositionAfterLoad.Value) or
|
||||
(AStream.Position <> AResult.Stream.PositionAfterLoad.Value)) and
|
||||
(AResult.Status <> dsFail) then
|
||||
begin
|
||||
FailStage(AResult, dsiSeekReadConsistency, 'Could not restore stream position');
|
||||
Result := False;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
if AResult.Status <> dsFail then
|
||||
begin
|
||||
FailException(AResult, dsiSeekReadConsistency, E);
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if AResult.Status <> dsFail then
|
||||
begin
|
||||
AResult.Stages[dsiSeekReadConsistency] := dsPass;
|
||||
AResult.Status := dsPass;
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure RunFileIODiagnostic;
|
||||
var
|
||||
ResultData: TFileIODiagnosticResult;
|
||||
MapUrl: string;
|
||||
Stream: TKMemoryStreamBinary;
|
||||
begin
|
||||
InitializeResult(ResultData);
|
||||
Stream := nil;
|
||||
MapUrl := SelectedMapUrl;
|
||||
try
|
||||
if RunResourceExists(MapUrl, ResultData) and
|
||||
RunResourceOpen(MapUrl, ResultData) and
|
||||
RunCallerStreamLoad(MapUrl, Stream, ResultData) and
|
||||
RunStreamState(Stream, ResultData) then
|
||||
RunSeekReadConsistency(Stream, ResultData);
|
||||
finally
|
||||
try
|
||||
Stream.Free;
|
||||
except
|
||||
on E: Exception do
|
||||
if ResultData.Status <> dsFail then
|
||||
FailException(ResultData, dsiSeekReadConsistency, E);
|
||||
end;
|
||||
end;
|
||||
ReplaceFileIODiagnosticResult(ResultData);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,247 @@
|
||||
unit GameDiagnosticsReport;
|
||||
|
||||
{$mode objfpc}{$H+}{$codepage utf8}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TDiagnosticStatus = (dsNotRun, dsPass, dsFail);
|
||||
|
||||
TDiagnosticStageId = (
|
||||
dsiResourceExists,
|
||||
dsiResourceOpen,
|
||||
dsiCallerStreamLoad,
|
||||
dsiStreamState,
|
||||
dsiSeekReadConsistency
|
||||
);
|
||||
|
||||
TOptionalString = record
|
||||
HasValue: Boolean;
|
||||
Value: string;
|
||||
end;
|
||||
|
||||
TOptionalInt64 = record
|
||||
HasValue: Boolean;
|
||||
Value: Int64;
|
||||
end;
|
||||
|
||||
TOptionalBoolean = record
|
||||
HasValue: Boolean;
|
||||
Value: Boolean;
|
||||
end;
|
||||
|
||||
TOptionalDiagnosticStageId = record
|
||||
HasValue: Boolean;
|
||||
Value: TDiagnosticStageId;
|
||||
end;
|
||||
|
||||
TDiagnosticError = record
|
||||
Present: Boolean;
|
||||
ClassName: TOptionalString;
|
||||
MessageText: TOptionalString;
|
||||
end;
|
||||
|
||||
TFileIODiagnosticStreamResult = record
|
||||
Size: TOptionalInt64;
|
||||
PositionAfterLoad: TOptionalInt64;
|
||||
ReadOffset: TOptionalInt64;
|
||||
RequestedReadCount: TOptionalInt64;
|
||||
FirstReadCount: TOptionalInt64;
|
||||
PositionAfterFirstRead: TOptionalInt64;
|
||||
SeekBackPosition: TOptionalInt64;
|
||||
SecondReadCount: TOptionalInt64;
|
||||
PositionAfterSecondRead: TOptionalInt64;
|
||||
RepeatEqual: TOptionalBoolean;
|
||||
end;
|
||||
|
||||
TFileIODiagnosticResult = record
|
||||
Status: TDiagnosticStatus;
|
||||
FailureStage: TOptionalDiagnosticStageId;
|
||||
Error: TDiagnosticError;
|
||||
Stages: array[TDiagnosticStageId] of TDiagnosticStatus;
|
||||
Stream: TFileIODiagnosticStreamResult;
|
||||
end;
|
||||
|
||||
TDiagnosticApplicationMetadata = record
|
||||
Name: string;
|
||||
PackageName: string;
|
||||
Version: string;
|
||||
VersionCode: Int64;
|
||||
BuildId: TOptionalString;
|
||||
end;
|
||||
|
||||
TDiagnosticRuntimeMetadata = record
|
||||
Platform: string;
|
||||
OsVersion: TOptionalString;
|
||||
DeviceModel: TOptionalString;
|
||||
CpuArch: TOptionalString;
|
||||
end;
|
||||
|
||||
TDiagnosticSelectedMapMetadata = record
|
||||
RelativePath: string;
|
||||
Url: string;
|
||||
end;
|
||||
|
||||
TDiagnosticReportState = record
|
||||
ApplicationInfo: TDiagnosticApplicationMetadata;
|
||||
RuntimeInfo: TDiagnosticRuntimeMetadata;
|
||||
SelectedMap: TDiagnosticSelectedMapMetadata;
|
||||
OverallStatus: TDiagnosticStatus;
|
||||
FileIO: TFileIODiagnosticResult;
|
||||
end;
|
||||
|
||||
function CurrentDiagnosticReport: TDiagnosticReportState;
|
||||
procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
|
||||
function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
|
||||
function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
|
||||
function DiagnosticReportJsonSnapshot: string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
fpjson, GameSelectedMap;
|
||||
|
||||
var
|
||||
CurrentFileIO: TFileIODiagnosticResult;
|
||||
|
||||
function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
|
||||
begin
|
||||
case AStatus of
|
||||
dsNotRun: Result := 'NOT_RUN';
|
||||
dsPass: Result := 'PASS';
|
||||
dsFail: Result := 'FAIL';
|
||||
end;
|
||||
end;
|
||||
|
||||
function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
|
||||
begin
|
||||
case AStage of
|
||||
dsiResourceExists: Result := 'resource_exists';
|
||||
dsiResourceOpen: Result := 'resource_open';
|
||||
dsiCallerStreamLoad: Result := 'caller_stream_load';
|
||||
dsiStreamState: Result := 'stream_state';
|
||||
dsiSeekReadConsistency: Result := 'seek_read_consistency';
|
||||
end;
|
||||
end;
|
||||
|
||||
function CurrentDiagnosticReport: TDiagnosticReportState;
|
||||
begin
|
||||
Result.ApplicationInfo.Name := 'kam_mobile';
|
||||
Result.ApplicationInfo.PackageName := 'org.kammobile.kamremake';
|
||||
Result.ApplicationInfo.Version := '0.4.0';
|
||||
Result.ApplicationInfo.VersionCode := 30;
|
||||
Result.ApplicationInfo.BuildId.HasValue := False;
|
||||
Result.RuntimeInfo.Platform := 'android';
|
||||
Result.RuntimeInfo.OsVersion.HasValue := False;
|
||||
Result.RuntimeInfo.DeviceModel.HasValue := False;
|
||||
Result.RuntimeInfo.CpuArch.HasValue := False;
|
||||
Result.SelectedMap.RelativePath := SelectedMapRelativePath;
|
||||
Result.SelectedMap.Url := SelectedMapUrl;
|
||||
Result.FileIO := CurrentFileIO;
|
||||
Result.OverallStatus := Result.FileIO.Status;
|
||||
end;
|
||||
|
||||
procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
|
||||
begin
|
||||
CurrentFileIO := AResult;
|
||||
end;
|
||||
|
||||
function OptionalStringJson(const AValue: TOptionalString): TJSONData;
|
||||
begin
|
||||
if AValue.HasValue then
|
||||
Result := TJSONString.Create(AValue.Value)
|
||||
else
|
||||
Result := TJSONNull.Create;
|
||||
end;
|
||||
|
||||
function OptionalInt64Json(const AValue: TOptionalInt64): TJSONData;
|
||||
begin
|
||||
if AValue.HasValue then
|
||||
Result := TJSONIntegerNumber.Create(AValue.Value)
|
||||
else
|
||||
Result := TJSONNull.Create;
|
||||
end;
|
||||
|
||||
function OptionalBooleanJson(const AValue: TOptionalBoolean): TJSONData;
|
||||
begin
|
||||
if AValue.HasValue then
|
||||
Result := TJSONBoolean.Create(AValue.Value)
|
||||
else
|
||||
Result := TJSONNull.Create;
|
||||
end;
|
||||
|
||||
function DiagnosticReportJsonSnapshot: string;
|
||||
var
|
||||
State: TDiagnosticReportState;
|
||||
Root, ObjectValue, Action, Stage, Stream: TJSONObject;
|
||||
Actions, Stages: TJSONArray;
|
||||
StageId: TDiagnosticStageId;
|
||||
begin
|
||||
State := CurrentDiagnosticReport;
|
||||
Root := TJSONObject.Create;
|
||||
try
|
||||
Root.Add('schema', 'kam-mobile-diagnostics/1');
|
||||
ObjectValue := TJSONObject.Create;
|
||||
ObjectValue.Add('name', State.ApplicationInfo.Name);
|
||||
ObjectValue.Add('package', State.ApplicationInfo.PackageName);
|
||||
ObjectValue.Add('version', State.ApplicationInfo.Version);
|
||||
ObjectValue.Add('version_code', State.ApplicationInfo.VersionCode);
|
||||
ObjectValue.Add('build_id', OptionalStringJson(State.ApplicationInfo.BuildId));
|
||||
Root.Add('application', ObjectValue);
|
||||
ObjectValue := TJSONObject.Create;
|
||||
ObjectValue.Add('platform', State.RuntimeInfo.Platform);
|
||||
ObjectValue.Add('os_version', OptionalStringJson(State.RuntimeInfo.OsVersion));
|
||||
ObjectValue.Add('device_model', OptionalStringJson(State.RuntimeInfo.DeviceModel));
|
||||
ObjectValue.Add('cpu_arch', OptionalStringJson(State.RuntimeInfo.CpuArch));
|
||||
Root.Add('runtime', ObjectValue);
|
||||
ObjectValue := TJSONObject.Create;
|
||||
ObjectValue.Add('relative_path', State.SelectedMap.RelativePath);
|
||||
ObjectValue.Add('url', State.SelectedMap.Url);
|
||||
Root.Add('selected_map', ObjectValue);
|
||||
Root.Add('overall_status', DiagnosticStatusToken(State.OverallStatus));
|
||||
Actions := TJSONArray.Create;
|
||||
Action := TJSONObject.Create;
|
||||
Action.Add('id', 'file_io');
|
||||
Action.Add('status', DiagnosticStatusToken(State.FileIO.Status));
|
||||
if State.FileIO.FailureStage.HasValue then
|
||||
Action.Add('failure_stage', DiagnosticStageIdToken(State.FileIO.FailureStage.Value))
|
||||
else
|
||||
Action.Add('failure_stage', TJSONNull.Create);
|
||||
if State.FileIO.Error.Present then
|
||||
begin
|
||||
ObjectValue := TJSONObject.Create;
|
||||
ObjectValue.Add('class', OptionalStringJson(State.FileIO.Error.ClassName));
|
||||
ObjectValue.Add('message', OptionalStringJson(State.FileIO.Error.MessageText));
|
||||
Action.Add('error', ObjectValue);
|
||||
end else
|
||||
Action.Add('error', TJSONNull.Create);
|
||||
Stages := TJSONArray.Create;
|
||||
for StageId := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
|
||||
begin
|
||||
Stage := TJSONObject.Create;
|
||||
Stage.Add('id', DiagnosticStageIdToken(StageId));
|
||||
Stage.Add('status', DiagnosticStatusToken(State.FileIO.Stages[StageId]));
|
||||
Stages.Add(Stage);
|
||||
end;
|
||||
Action.Add('stages', Stages);
|
||||
Stream := TJSONObject.Create;
|
||||
Stream.Add('size', OptionalInt64Json(State.FileIO.Stream.Size));
|
||||
Stream.Add('position_after_load', OptionalInt64Json(State.FileIO.Stream.PositionAfterLoad));
|
||||
Stream.Add('read_offset', OptionalInt64Json(State.FileIO.Stream.ReadOffset));
|
||||
Stream.Add('requested_read_count', OptionalInt64Json(State.FileIO.Stream.RequestedReadCount));
|
||||
Stream.Add('first_read_count', OptionalInt64Json(State.FileIO.Stream.FirstReadCount));
|
||||
Stream.Add('position_after_first_read', OptionalInt64Json(State.FileIO.Stream.PositionAfterFirstRead));
|
||||
Stream.Add('seek_back_position', OptionalInt64Json(State.FileIO.Stream.SeekBackPosition));
|
||||
Stream.Add('second_read_count', OptionalInt64Json(State.FileIO.Stream.SecondReadCount));
|
||||
Stream.Add('position_after_second_read', OptionalInt64Json(State.FileIO.Stream.PositionAfterSecondRead));
|
||||
Stream.Add('repeat_equal', OptionalBooleanJson(State.FileIO.Stream.RepeatEqual));
|
||||
Action.Add('stream', Stream);
|
||||
Actions.Add(Action);
|
||||
Root.Add('actions', Actions);
|
||||
Result := Root.AsJSON;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -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.
|
||||
@@ -3,10 +3,14 @@ unit GameInitialize;
|
||||
{$ifndef ANDROID}{$fatal Android-only KaM Remake Mobile application; there is no desktop target}{$endif}
|
||||
interface
|
||||
implementation
|
||||
uses CastleWindow;
|
||||
var Window: TCastleWindow;
|
||||
uses CastleWindow, GameDiagnosticsView;
|
||||
var
|
||||
Window: TCastleWindow;
|
||||
DiagnosticsView: TDiagnosticsView;
|
||||
procedure Initialize;
|
||||
begin
|
||||
DiagnosticsView := TDiagnosticsView.Create(Application);
|
||||
Window.Container.View := DiagnosticsView;
|
||||
end;
|
||||
initialization
|
||||
Application.OnInitialize := @Initialize;
|
||||
|
||||
@@ -0,0 +1,22 @@
|
||||
unit GameSelectedMap;
|
||||
|
||||
{$mode objfpc}{$H+}{$codepage utf8}
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
SelectedMapRelativePath = 'Maps/CatchTheSnake/CatchTheSnake.map';
|
||||
|
||||
function SelectedMapUrl: string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
CastleUriUtils;
|
||||
|
||||
function SelectedMapUrl: string;
|
||||
begin
|
||||
Result := 'castle-data:/game/' + UrlEncode(SelectedMapRelativePath);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,45 @@
|
||||
unit KaMResourceInput;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes;
|
||||
|
||||
function KaMResourceExists(const aReference: string): Boolean;
|
||||
function KaMOpenResourceStream(const aReference: string): TStream;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
CastleUriUtils, CastleDownload;
|
||||
|
||||
function ResourceProtocol(const aReference: string): string;
|
||||
begin
|
||||
if aReference = '' then
|
||||
raise EDownloadError.Create('KaMResourceInput: empty resource reference');
|
||||
|
||||
Result := UriProtocol(aReference);
|
||||
if (Result <> '') and (Result <> 'file') and (Result <> 'castle-data') then
|
||||
raise EDownloadError.Create('KaMResourceInput: unsupported resource protocol: ' + Result);
|
||||
end;
|
||||
|
||||
function KaMResourceExists(const aReference: string): Boolean;
|
||||
begin
|
||||
ResourceProtocol(aReference);
|
||||
case UriExists(aReference) of
|
||||
ueFile: Result := True;
|
||||
ueNotExists, ueDirectory: Result := False;
|
||||
ueUnknown:
|
||||
raise EDownloadError.Create('KaMResourceInput: resource existence is unknown: ' + aReference);
|
||||
end;
|
||||
end;
|
||||
|
||||
function KaMOpenResourceStream(const aReference: string): TStream;
|
||||
begin
|
||||
if ResourceProtocol(aReference) = '' then
|
||||
Result := TFileStream.Create(aReference, fmOpenRead)
|
||||
else
|
||||
Result := Download(aReference, [soForceMemoryStream]);
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in new issue
Block a user