1384 lines
47 KiB
ObjectPascal
1384 lines
47 KiB
ObjectPascal
unit GameDiagnosticsGraphics_Mobile;
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, CastleUIControls, GameDiagnosticsReport, KM_Render, KM_RenderTypes;
|
|
|
|
type
|
|
TGraphicsDiagnosticSession = class
|
|
private
|
|
type
|
|
TGraphicsDiagnosticActionKind = (
|
|
gakNone, gakReadiness, gakTextureLifecycle, gakVisibleDraw);
|
|
TGraphicsDiagnosticExecutionState = (gesIdle, gesPending, gesActive);
|
|
TVisibleDrawPhase = (vdpNotStarted, vdpBase, vdpBrightness);
|
|
|
|
FContainer: TCastleContainer;
|
|
FRenderer: TKMRender;
|
|
FPhysicalWidth, FPhysicalHeight: Integer;
|
|
FPhysicalSizeKnown: Boolean;
|
|
FContextReportedAvailable, FRendererContextSynced: Boolean;
|
|
FPresentationAttached, FLifecycleAttached, FClosing: Boolean;
|
|
FContextTransitionErrorPresent: Boolean;
|
|
FContextTransitionErrorClass, FContextTransitionErrorMessage: string;
|
|
FActionKind: TGraphicsDiagnosticActionKind;
|
|
FExecutionState: TGraphicsDiagnosticExecutionState;
|
|
FAttachInProgress: Boolean;
|
|
FTextureTestId: Cardinal;
|
|
FVisiblePhase: TVisibleDrawPhase;
|
|
FVisiblePhaseStarted: Boolean;
|
|
FVisibleFramesCompletedInPhase: Integer;
|
|
FVisibleTextureId: Cardinal;
|
|
FOnResultPublished: TNotifyEvent;
|
|
FReadinessResult: TGraphicsReadinessDiagnosticResult;
|
|
FTextureResult: TGraphicsTextureDiagnosticResult;
|
|
FVisibleDrawResult: TGraphicsVisibleDrawDiagnosticResult;
|
|
function GetBusy: Boolean;
|
|
function AcceptGraphicsRequest(const AKind: TGraphicsDiagnosticActionKind): Boolean;
|
|
procedure HandleFrame;
|
|
procedure DispatchFrame;
|
|
procedure ObserveReadiness;
|
|
procedure ObserveTextureLifecycle;
|
|
procedure ObserveVisibleDraw;
|
|
procedure InvalidateTextureOnContextLoss;
|
|
procedure MarkInterruptedVisiblePhase;
|
|
procedure SetReadinessSnapshot;
|
|
procedure SetActionError(const AClassName, AMessage: string);
|
|
procedure FinalizeAction;
|
|
procedure HandleResize(aWidth, aHeight: Integer);
|
|
procedure HandleContextAvailability(aAvailable: Boolean);
|
|
procedure EnsureAttached;
|
|
public
|
|
constructor Create(const AContainer: TCastleContainer);
|
|
destructor Destroy; override;
|
|
function RequestReadiness: Boolean;
|
|
function RequestTextureLifecycle: Boolean;
|
|
function RequestVisibleDraw: Boolean;
|
|
property Busy: Boolean read GetBusy;
|
|
property OnResultPublished: TNotifyEvent read FOnResultPublished write FOnResultPublished;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, KM_GameApp_Mobile;
|
|
|
|
constructor TGraphicsDiagnosticSession.Create(const AContainer: TCastleContainer);
|
|
begin
|
|
inherited Create;
|
|
if AContainer = nil then
|
|
raise Exception.Create('Graphics diagnostic container is nil');
|
|
FContainer := AContainer;
|
|
FRenderer := nil;
|
|
FPhysicalWidth := 0;
|
|
FPhysicalHeight := 0;
|
|
FPhysicalSizeKnown := False;
|
|
FContextReportedAvailable := False;
|
|
FRendererContextSynced := False;
|
|
FPresentationAttached := False;
|
|
FLifecycleAttached := False;
|
|
FClosing := False;
|
|
FContextTransitionErrorPresent := False;
|
|
FContextTransitionErrorClass := '';
|
|
FContextTransitionErrorMessage := '';
|
|
FActionKind := gakNone;
|
|
FExecutionState := gesIdle;
|
|
FAttachInProgress := False;
|
|
FTextureTestId := 0;
|
|
FVisiblePhase := vdpNotStarted;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
FVisibleTextureId := 0;
|
|
FOnResultPublished := nil;
|
|
FReadinessResult := Default(TGraphicsReadinessDiagnosticResult);
|
|
FTextureResult := Default(TGraphicsTextureDiagnosticResult);
|
|
FVisibleDrawResult := Default(TGraphicsVisibleDrawDiagnosticResult);
|
|
end;
|
|
|
|
function TGraphicsDiagnosticSession.GetBusy: Boolean;
|
|
begin
|
|
Result := FExecutionState <> gesIdle;
|
|
end;
|
|
|
|
function TGraphicsDiagnosticSession.RequestReadiness: Boolean;
|
|
begin
|
|
Result := AcceptGraphicsRequest(gakReadiness);
|
|
end;
|
|
|
|
function TGraphicsDiagnosticSession.RequestTextureLifecycle: Boolean;
|
|
begin
|
|
Result := AcceptGraphicsRequest(gakTextureLifecycle);
|
|
end;
|
|
|
|
function TGraphicsDiagnosticSession.RequestVisibleDraw: Boolean;
|
|
begin
|
|
Result := AcceptGraphicsRequest(gakVisibleDraw);
|
|
end;
|
|
|
|
function TGraphicsDiagnosticSession.AcceptGraphicsRequest(
|
|
const AKind: TGraphicsDiagnosticActionKind): Boolean;
|
|
var
|
|
AttachErrorClass, AttachErrorMessage: string;
|
|
begin
|
|
if FClosing or GetBusy then
|
|
Exit(False);
|
|
|
|
case AKind of
|
|
gakReadiness: FReadinessResult := Default(TGraphicsReadinessDiagnosticResult);
|
|
gakTextureLifecycle:
|
|
begin
|
|
FTextureTestId := 0;
|
|
FTextureResult := Default(TGraphicsTextureDiagnosticResult);
|
|
end;
|
|
gakVisibleDraw:
|
|
begin
|
|
FVisibleDrawResult := Default(TGraphicsVisibleDrawDiagnosticResult);
|
|
FVisiblePhase := vdpNotStarted;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
FVisibleTextureId := 0;
|
|
end;
|
|
else
|
|
Exit(False);
|
|
end;
|
|
FActionKind := AKind;
|
|
FExecutionState := gesPending;
|
|
AttachErrorClass := '';
|
|
AttachErrorMessage := '';
|
|
FAttachInProgress := True;
|
|
try
|
|
try
|
|
EnsureAttached;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
AttachErrorClass := E.ClassName;
|
|
AttachErrorMessage := E.Message;
|
|
end;
|
|
end;
|
|
finally
|
|
FAttachInProgress := False;
|
|
end;
|
|
|
|
if AttachErrorClass <> '' then
|
|
begin
|
|
SetActionError(AttachErrorClass, AttachErrorMessage);
|
|
FinalizeAction;
|
|
Exit(True);
|
|
end;
|
|
if FContextTransitionErrorPresent or not FContextReportedAvailable or
|
|
not FRendererContextSynced then
|
|
begin
|
|
if AKind = gakReadiness then
|
|
SetReadinessSnapshot;
|
|
if FContextTransitionErrorPresent then
|
|
SetActionError(FContextTransitionErrorClass, FContextTransitionErrorMessage)
|
|
else if not FContextReportedAvailable then
|
|
SetActionError('', 'Graphics context is unavailable')
|
|
else
|
|
SetActionError('', 'Graphics renderer context is not synchronized');
|
|
FinalizeAction;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.SetActionError(
|
|
const AClassName, AMessage: string);
|
|
var
|
|
ErrorValue: TDiagnosticError;
|
|
begin
|
|
ErrorValue := Default(TDiagnosticError);
|
|
ErrorValue.Present := True;
|
|
if AClassName <> '' then
|
|
begin
|
|
ErrorValue.ClassName.HasValue := True;
|
|
ErrorValue.ClassName.Value := AClassName;
|
|
end;
|
|
ErrorValue.MessageText.HasValue := True;
|
|
ErrorValue.MessageText.Value := AMessage;
|
|
case FActionKind of
|
|
gakReadiness: begin FReadinessResult.Status := dsFail; FReadinessResult.Error := ErrorValue; end;
|
|
gakTextureLifecycle: begin FTextureResult.Status := dsFail; FTextureResult.Error := ErrorValue; end;
|
|
gakVisibleDraw: begin FVisibleDrawResult.Status := dsFail; FVisibleDrawResult.Error := ErrorValue; end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.MarkInterruptedVisiblePhase;
|
|
var
|
|
Stage: TGraphicsVisibleDrawDiagnosticStageId;
|
|
begin
|
|
if not FVisiblePhaseStarted or (FVisiblePhase = vdpNotStarted) then
|
|
Exit;
|
|
if FVisiblePhase = vdpBrightness then
|
|
Stage := gvsiBrightnessPhase
|
|
else
|
|
Stage := gvsiSampledRgbaPhase;
|
|
if FVisibleDrawResult.Stages[Stage] = dsPass then
|
|
Exit;
|
|
FVisibleDrawResult.Stages[Stage] := dsFail;
|
|
if not FVisibleDrawResult.Error.Present then
|
|
begin
|
|
FVisibleDrawResult.FailureStage.HasValue := True;
|
|
FVisibleDrawResult.FailureStage.Value := Stage;
|
|
end;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.InvalidateTextureOnContextLoss;
|
|
begin
|
|
if (FActionKind = gakVisibleDraw) and GetBusy then
|
|
begin
|
|
MarkInterruptedVisiblePhase;
|
|
FVisibleDrawResult.Evidence.ContextLost.HasValue := True;
|
|
FVisibleDrawResult.Evidence.ContextLost.Value := True;
|
|
end;
|
|
if (FActionKind = gakTextureLifecycle) and GetBusy then
|
|
begin
|
|
FTextureResult.Evidence.ContextLost.HasValue := True;
|
|
FTextureResult.Evidence.ContextLost.Value := True;
|
|
end;
|
|
if FTextureTestId <> 0 then
|
|
begin
|
|
FTextureTestId := 0;
|
|
if FActionKind = gakTextureLifecycle then
|
|
begin
|
|
FTextureResult.Evidence.CleanupBlockedByContext.HasValue := True;
|
|
FTextureResult.Evidence.CleanupBlockedByContext.Value := True;
|
|
end;
|
|
end;
|
|
if FVisibleTextureId <> 0 then
|
|
begin
|
|
FVisibleTextureId := 0;
|
|
if FActionKind = gakVisibleDraw then
|
|
begin
|
|
FVisibleDrawResult.Evidence.CleanupBlockedByContext.HasValue := True;
|
|
FVisibleDrawResult.Evidence.CleanupBlockedByContext.Value := True;
|
|
end;
|
|
end;
|
|
FVisiblePhase := vdpNotStarted;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.SetReadinessSnapshot;
|
|
begin
|
|
FReadinessResult.Evidence.ContextAvailable.HasValue := True;
|
|
FReadinessResult.Evidence.ContextAvailable.Value := FContextReportedAvailable;
|
|
FReadinessResult.Evidence.RendererContextSynced.HasValue := True;
|
|
FReadinessResult.Evidence.RendererContextSynced.Value := FRendererContextSynced;
|
|
FReadinessResult.Evidence.PhysicalSizeKnown.HasValue := True;
|
|
FReadinessResult.Evidence.PhysicalSizeKnown.Value := FPhysicalSizeKnown;
|
|
if FPhysicalSizeKnown then
|
|
begin
|
|
FReadinessResult.Evidence.PhysicalWidth.HasValue := True;
|
|
FReadinessResult.Evidence.PhysicalWidth.Value := FPhysicalWidth;
|
|
FReadinessResult.Evidence.PhysicalHeight.HasValue := True;
|
|
FReadinessResult.Evidence.PhysicalHeight.Value := FPhysicalHeight;
|
|
end;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.FinalizeAction;
|
|
var
|
|
CompletedKind: TGraphicsDiagnosticActionKind;
|
|
ReadinessValue: TGraphicsReadinessDiagnosticResult;
|
|
TextureValue: TGraphicsTextureDiagnosticResult;
|
|
VisibleDrawValue: TGraphicsVisibleDrawDiagnosticResult;
|
|
begin
|
|
if (FExecutionState = gesIdle) or (FActionKind = gakNone) then
|
|
Exit;
|
|
CompletedKind := FActionKind;
|
|
case CompletedKind of
|
|
gakReadiness:
|
|
begin
|
|
ReadinessValue := FReadinessResult;
|
|
FReadinessResult := Default(TGraphicsReadinessDiagnosticResult);
|
|
end;
|
|
gakTextureLifecycle:
|
|
begin
|
|
TextureValue := FTextureResult;
|
|
FTextureResult := Default(TGraphicsTextureDiagnosticResult);
|
|
end;
|
|
gakVisibleDraw:
|
|
begin
|
|
VisibleDrawValue := FVisibleDrawResult;
|
|
FVisibleDrawResult := Default(TGraphicsVisibleDrawDiagnosticResult);
|
|
FVisiblePhase := vdpNotStarted;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
FVisibleTextureId := 0;
|
|
end;
|
|
end;
|
|
FActionKind := gakNone;
|
|
FExecutionState := gesIdle;
|
|
try
|
|
case CompletedKind of
|
|
gakReadiness: ReplaceGraphicsReadinessDiagnosticResult(ReadinessValue);
|
|
gakTextureLifecycle: ReplaceGraphicsTextureDiagnosticResult(TextureValue);
|
|
gakVisibleDraw: ReplaceGraphicsVisibleDrawDiagnosticResult(VisibleDrawValue);
|
|
end;
|
|
except
|
|
Exit;
|
|
end;
|
|
if not FClosing and Assigned(FOnResultPublished) then
|
|
try
|
|
FOnResultPublished(Self);
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.ObserveVisibleDraw;
|
|
var
|
|
Pixels: array[0..15] of Byte;
|
|
V1, V2, V3: array[0..5] of TKMSampledVertex;
|
|
W, H: Single;
|
|
AttemptedStage: TGraphicsVisibleDrawDiagnosticStageId;
|
|
Stage: TGraphicsVisibleDrawDiagnosticStageId;
|
|
ErrorValue: TDiagnosticError;
|
|
Ready: Boolean;
|
|
AllStagesPass: Boolean;
|
|
|
|
procedure SetPrimaryError(const AClassName, AMessage: string;
|
|
const AHasStage: Boolean);
|
|
begin
|
|
if FVisibleDrawResult.Error.Present then
|
|
Exit;
|
|
ErrorValue := Default(TDiagnosticError);
|
|
ErrorValue.Present := True;
|
|
if AClassName <> '' then
|
|
begin
|
|
ErrorValue.ClassName.HasValue := True;
|
|
ErrorValue.ClassName.Value := AClassName;
|
|
end;
|
|
ErrorValue.MessageText.HasValue := True;
|
|
ErrorValue.MessageText.Value := AMessage;
|
|
FVisibleDrawResult.Status := dsFail;
|
|
FVisibleDrawResult.Error := ErrorValue;
|
|
if AHasStage then
|
|
begin
|
|
FVisibleDrawResult.FailureStage.HasValue := True;
|
|
FVisibleDrawResult.FailureStage.Value := AttemptedStage;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawRect(var AVertices: array of TKMSampledVertex;
|
|
const X0, X1: Single; const AColor: TKMColor4f);
|
|
begin
|
|
AVertices[0] := Default(TKMSampledVertex);
|
|
AVertices[0].X := X0; AVertices[0].Y := 0.30 * H; AVertices[0].U := 0; AVertices[0].V := 0;
|
|
AVertices[1] := Default(TKMSampledVertex);
|
|
AVertices[1].X := X1; AVertices[1].Y := 0.30 * H; AVertices[1].U := 1; AVertices[1].V := 0;
|
|
AVertices[2] := Default(TKMSampledVertex);
|
|
AVertices[2].X := X0; AVertices[2].Y := 0.70 * H; AVertices[2].U := 0; AVertices[2].V := 1;
|
|
AVertices[3] := AVertices[1];
|
|
AVertices[4] := Default(TKMSampledVertex);
|
|
AVertices[4].X := X1; AVertices[4].Y := 0.70 * H; AVertices[4].U := 1; AVertices[4].V := 1;
|
|
AVertices[5] := AVertices[2];
|
|
TKMRender.DrawSampledTriangles(AVertices, AColor);
|
|
end;
|
|
|
|
procedure DrawTriple;
|
|
begin
|
|
W := FRenderer.ScreenX;
|
|
H := FRenderer.ScreenY;
|
|
FRenderer.BeginFrame;
|
|
TKMRender.BindTexture(FVisibleTextureId);
|
|
DrawRect(V1, 0.08 * W, 0.32 * W, TKMColor4f.New(1, 1, 1, 1));
|
|
DrawRect(V2, 0.38 * W, 0.62 * W, TKMColor4f.New(1, 0.45, 0.45, 1));
|
|
DrawRect(V3, 0.68 * W, 0.92 * W, TKMColor4f.New(0.5, 0.8, 1, 0.65));
|
|
end;
|
|
|
|
procedure CleanupVisibleTexture;
|
|
var
|
|
CleanupError: TDiagnosticError;
|
|
begin
|
|
if FVisibleTextureId = 0 then
|
|
Exit;
|
|
Ready := (FRenderer <> nil) and FContextReportedAvailable and
|
|
FRendererContextSynced;
|
|
if Ready then
|
|
try
|
|
Ready := TKMRender.TextureBackendReady;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Ready := False;
|
|
if FVisibleDrawResult.Error.Present then
|
|
begin
|
|
CleanupError := Default(TDiagnosticError);
|
|
CleanupError.Present := True;
|
|
CleanupError.ClassName.HasValue := True;
|
|
CleanupError.ClassName.Value := E.ClassName;
|
|
CleanupError.MessageText.HasValue := True;
|
|
CleanupError.MessageText.Value := E.Message;
|
|
FVisibleDrawResult.Evidence.SecondaryCleanupError := CleanupError;
|
|
end
|
|
else
|
|
SetPrimaryError(E.ClassName, E.Message, False);
|
|
end;
|
|
end;
|
|
if not Ready then
|
|
begin
|
|
FVisibleDrawResult.Evidence.CleanupBlockedByContext.HasValue := True;
|
|
FVisibleDrawResult.Evidence.CleanupBlockedByContext.Value := True;
|
|
if not FVisibleDrawResult.Error.Present then
|
|
SetPrimaryError('', 'Visible texture cleanup is unavailable', False);
|
|
Exit;
|
|
end;
|
|
FVisibleDrawResult.Evidence.DeleteAttempted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.DeleteAttempted.Value := True;
|
|
try
|
|
TKMRender.DeleteTexture(FVisibleTextureId);
|
|
FVisibleDrawResult.Stages[gvsiTextureDelete] := dsPass;
|
|
FVisibleDrawResult.Evidence.DeleteCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.DeleteCompleted.Value := True;
|
|
FVisibleTextureId := 0;
|
|
FVisiblePhase := vdpNotStarted;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
FVisibleDrawResult.Stages[gvsiResourceCleanup] := dsPass;
|
|
FVisibleDrawResult.Evidence.CleanupCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.CleanupCompleted.Value := True;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FVisibleDrawResult.Stages[gvsiTextureDelete] := dsFail;
|
|
FVisibleDrawResult.Stages[gvsiResourceCleanup] := dsFail;
|
|
FVisibleDrawResult.Evidence.DeleteCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.DeleteCompleted.Value := False;
|
|
AttemptedStage := gvsiTextureDelete;
|
|
if FVisibleDrawResult.Error.Present then
|
|
begin
|
|
CleanupError := Default(TDiagnosticError);
|
|
CleanupError.Present := True;
|
|
CleanupError.ClassName.HasValue := True;
|
|
CleanupError.ClassName.Value := E.ClassName;
|
|
CleanupError.MessageText.HasValue := True;
|
|
CleanupError.MessageText.Value := E.Message;
|
|
FVisibleDrawResult.Evidence.SecondaryCleanupError := CleanupError;
|
|
end
|
|
else
|
|
SetPrimaryError(E.ClassName, E.Message, True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure FailCurrentStage(const AClassName, AMessage: string);
|
|
begin
|
|
if FVisibleTextureId = 0 then
|
|
AttemptedStage := gvsiPreparation
|
|
else if FVisiblePhase = vdpBrightness then
|
|
AttemptedStage := gvsiBrightnessPhase
|
|
else
|
|
AttemptedStage := gvsiSampledRgbaPhase;
|
|
FVisibleDrawResult.Stages[AttemptedStage] := dsFail;
|
|
SetPrimaryError(AClassName, AMessage, True);
|
|
if FVisibleTextureId <> 0 then
|
|
CleanupVisibleTexture;
|
|
FinalizeAction;
|
|
end;
|
|
|
|
function CheckVisiblePreflight: Boolean;
|
|
begin
|
|
if not ((FRenderer <> nil) and FPresentationAttached and FLifecycleAttached and
|
|
FContextReportedAvailable and FRendererContextSynced and not FClosing and
|
|
FPhysicalSizeKnown and (FPhysicalWidth > 0) and (FPhysicalHeight > 0)) then
|
|
begin
|
|
if FVisibleTextureId <> 0 then
|
|
begin
|
|
FailCurrentStage('', 'Visible draw preflight is unavailable');
|
|
Exit(False);
|
|
end;
|
|
AttemptedStage := gvsiPreparation;
|
|
FVisibleDrawResult.Stages[gvsiPreparation] := dsFail;
|
|
SetPrimaryError('', 'Visible draw preflight is unavailable', True);
|
|
FinalizeAction;
|
|
Exit(False);
|
|
end;
|
|
try
|
|
Ready := TKMRender.TextureBackendReady and TKMRender.SampledProgramReady;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FailCurrentStage(E.ClassName, E.Message);
|
|
Exit(False);
|
|
end;
|
|
end;
|
|
if not Ready then
|
|
begin
|
|
FailCurrentStage('', 'Visible draw texture or sampled program is not ready');
|
|
Exit(False);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function PrepareVisibleTexture: Boolean;
|
|
begin
|
|
if FVisiblePhase = vdpNotStarted then
|
|
begin
|
|
if FVisibleTextureId <> 0 then
|
|
begin
|
|
AttemptedStage := gvsiPreparation;
|
|
FVisibleDrawResult.Stages[gvsiPreparation] := dsFail;
|
|
SetPrimaryError('', 'Visible draw texture state is inconsistent', True);
|
|
FinalizeAction;
|
|
Exit(False);
|
|
end;
|
|
Pixels[0] := 255; Pixels[1] := 215; Pixels[2] := 175; Pixels[3] := 255;
|
|
Pixels[4] := 175; Pixels[5] := 255; Pixels[6] := 215; Pixels[7] := 255;
|
|
Pixels[8] := 205; Pixels[9] := 205; Pixels[10] := 255; Pixels[11] := 255;
|
|
Pixels[12] := 255; Pixels[13] := 255; Pixels[14] := 255; Pixels[15] := 255;
|
|
try
|
|
FVisibleTextureId := TKMRender.GenTexture(2, 2, @Pixels[0],
|
|
tfRGBA8, ftNearest, ftNearest);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
AttemptedStage := gvsiPreparation;
|
|
FVisibleDrawResult.Stages[gvsiPreparation] := dsFail;
|
|
SetPrimaryError(E.ClassName, E.Message, True);
|
|
FinalizeAction;
|
|
Exit(False);
|
|
end;
|
|
end;
|
|
FVisibleDrawResult.Evidence.TextureCreated.HasValue := True;
|
|
FVisibleDrawResult.Evidence.TextureCreated.Value := FVisibleTextureId <> 0;
|
|
FVisibleDrawResult.Evidence.NonZeroTextureId.HasValue := True;
|
|
FVisibleDrawResult.Evidence.NonZeroTextureId.Value := FVisibleTextureId <> 0;
|
|
FVisibleDrawResult.Evidence.TextureWidth.HasValue := True;
|
|
FVisibleDrawResult.Evidence.TextureWidth.Value := 2;
|
|
FVisibleDrawResult.Evidence.TextureHeight.HasValue := True;
|
|
FVisibleDrawResult.Evidence.TextureHeight.Value := 2;
|
|
FVisibleDrawResult.Evidence.TextureFormat.HasValue := True;
|
|
FVisibleDrawResult.Evidence.TextureFormat.Value := 'tfRGBA8';
|
|
FVisibleDrawResult.Evidence.MinFilter.HasValue := True;
|
|
FVisibleDrawResult.Evidence.MinFilter.Value := 'ftNearest';
|
|
FVisibleDrawResult.Evidence.MagFilter.HasValue := True;
|
|
FVisibleDrawResult.Evidence.MagFilter.Value := 'ftNearest';
|
|
if FVisibleTextureId = 0 then
|
|
begin
|
|
AttemptedStage := gvsiPreparation;
|
|
FVisibleDrawResult.Stages[gvsiPreparation] := dsFail;
|
|
SetPrimaryError('', 'GenTexture returned texture ID 0', True);
|
|
FinalizeAction;
|
|
Exit(False);
|
|
end;
|
|
FVisibleDrawResult.Stages[gvsiPreparation] := dsPass;
|
|
FVisiblePhase := vdpBase;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function DrawVisibleFrame: Boolean;
|
|
begin
|
|
if FVisiblePhase = vdpBase then
|
|
AttemptedStage := gvsiSampledRgbaPhase
|
|
else
|
|
AttemptedStage := gvsiBrightnessPhase;
|
|
try
|
|
FVisiblePhaseStarted := True;
|
|
DrawTriple;
|
|
if FVisiblePhase = vdpBrightness then
|
|
begin
|
|
FVisibleDrawResult.Evidence.BrightnessTripleRgbaDrawsCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.BrightnessTripleRgbaDrawsCompleted.Value := True;
|
|
FRenderer.RenderBrightness(5);
|
|
FVisibleDrawResult.Evidence.BrightnessOverlayAppliedAfterDraws.HasValue := True;
|
|
FVisibleDrawResult.Evidence.BrightnessOverlayAppliedAfterDraws.Value := True;
|
|
FVisibleDrawResult.Evidence.BrightnessAmount.HasValue := True;
|
|
FVisibleDrawResult.Evidence.BrightnessAmount.Value := 5;
|
|
end
|
|
else
|
|
begin
|
|
FVisibleDrawResult.Evidence.BaseTripleRgbaDrawsCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.BaseTripleRgbaDrawsCompleted.Value := True;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FVisibleDrawResult.Stages[AttemptedStage] := dsFail;
|
|
if AttemptedStage = gvsiSampledRgbaPhase then
|
|
begin
|
|
if not FVisibleDrawResult.Evidence.BaseTripleRgbaDrawsCompleted.HasValue then
|
|
begin
|
|
FVisibleDrawResult.Evidence.BaseTripleRgbaDrawsCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.BaseTripleRgbaDrawsCompleted.Value := False;
|
|
end;
|
|
end
|
|
else if FVisibleDrawResult.Evidence.BrightnessTripleRgbaDrawsCompleted.HasValue = False then
|
|
begin
|
|
FVisibleDrawResult.Evidence.BrightnessTripleRgbaDrawsCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.BrightnessTripleRgbaDrawsCompleted.Value := False;
|
|
end;
|
|
SetPrimaryError(E.ClassName, E.Message, True);
|
|
CleanupVisibleTexture;
|
|
FinalizeAction;
|
|
Exit(False);
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure AdvanceVisiblePhase;
|
|
begin
|
|
Inc(FVisibleFramesCompletedInPhase);
|
|
if FVisiblePhase = vdpBase then
|
|
begin
|
|
FVisibleDrawResult.Evidence.BaseFramesCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.BaseFramesCompleted.Value := FVisibleFramesCompletedInPhase;
|
|
if FVisibleFramesCompletedInPhase = 60 then
|
|
begin
|
|
FVisibleDrawResult.Stages[gvsiSampledRgbaPhase] := dsPass;
|
|
FVisiblePhase := vdpBrightness;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
FVisibleDrawResult.Evidence.BrightnessFramesCompleted.HasValue := True;
|
|
FVisibleDrawResult.Evidence.BrightnessFramesCompleted.Value := FVisibleFramesCompletedInPhase;
|
|
if FVisibleFramesCompletedInPhase = 60 then
|
|
begin
|
|
FVisibleDrawResult.Stages[gvsiBrightnessPhase] := dsPass;
|
|
CleanupVisibleTexture;
|
|
AllStagesPass := True;
|
|
for Stage := Low(TGraphicsVisibleDrawDiagnosticStageId) to
|
|
High(TGraphicsVisibleDrawDiagnosticStageId) do
|
|
if FVisibleDrawResult.Stages[Stage] <> dsPass then
|
|
AllStagesPass := False;
|
|
if FVisibleDrawResult.Error.Present or
|
|
FVisibleDrawResult.Evidence.SecondaryCleanupError.Present or
|
|
not AllStagesPass then
|
|
FVisibleDrawResult.Status := dsFail
|
|
else
|
|
FVisibleDrawResult.Status := dsPass;
|
|
FinalizeAction;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if not CheckVisiblePreflight then Exit;
|
|
if not PrepareVisibleTexture then Exit;
|
|
if not DrawVisibleFrame then Exit;
|
|
AdvanceVisiblePhase;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.ObserveReadiness;
|
|
var
|
|
AttemptedStage: TGraphicsReadinessDiagnosticStageId;
|
|
Attempted: Boolean;
|
|
BackendReady: Boolean;
|
|
RendererWidth, RendererHeight: Word;
|
|
MaxTextureSize: Cardinal;
|
|
FirstFailure: TOptionalGraphicsReadinessDiagnosticStageId;
|
|
FirstFailureMessage, ExceptionClass, ExceptionMessage: string;
|
|
HasException: Boolean;
|
|
begin
|
|
SetReadinessSnapshot;
|
|
FirstFailure := Default(TOptionalGraphicsReadinessDiagnosticStageId);
|
|
FirstFailureMessage := '';
|
|
HasException := False;
|
|
Attempted := False;
|
|
try
|
|
AttemptedStage := grsiContextReady;
|
|
Attempted := True;
|
|
if FContextReportedAvailable and FRendererContextSynced then
|
|
FReadinessResult.Stages[grsiContextReady] := dsPass
|
|
else
|
|
begin
|
|
FReadinessResult.Stages[grsiContextReady] := dsFail;
|
|
FirstFailure.HasValue := True;
|
|
FirstFailure.Value := grsiContextReady;
|
|
if not FContextReportedAvailable then
|
|
FirstFailureMessage := 'Graphics context is unavailable'
|
|
else
|
|
FirstFailureMessage := 'Graphics renderer context is not synchronized';
|
|
end;
|
|
|
|
AttemptedStage := grsiPhysicalSurface;
|
|
if FPhysicalSizeKnown and (FPhysicalWidth > 0) and (FPhysicalHeight > 0) then
|
|
FReadinessResult.Stages[grsiPhysicalSurface] := dsPass
|
|
else
|
|
begin
|
|
FReadinessResult.Stages[grsiPhysicalSurface] := dsFail;
|
|
if not FirstFailure.HasValue then
|
|
begin
|
|
FirstFailure.HasValue := True;
|
|
FirstFailure.Value := grsiPhysicalSurface;
|
|
if not FPhysicalSizeKnown then
|
|
FirstFailureMessage := 'Physical surface dimensions are unknown'
|
|
else
|
|
FirstFailureMessage := 'Physical surface dimensions must be positive';
|
|
end;
|
|
end;
|
|
|
|
AttemptedStage := grsiRendererSizeMatch;
|
|
Attempted := True;
|
|
RendererWidth := FRenderer.ScreenX;
|
|
FReadinessResult.Evidence.RendererWidth.Value := RendererWidth;
|
|
FReadinessResult.Evidence.RendererWidth.HasValue := True;
|
|
RendererHeight := FRenderer.ScreenY;
|
|
FReadinessResult.Evidence.RendererHeight.Value := RendererHeight;
|
|
FReadinessResult.Evidence.RendererHeight.HasValue := True;
|
|
if FPhysicalSizeKnown then
|
|
begin
|
|
if (RendererWidth = FPhysicalWidth) and
|
|
(RendererHeight = FPhysicalHeight) then
|
|
FReadinessResult.Stages[grsiRendererSizeMatch] := dsPass
|
|
else
|
|
begin
|
|
FReadinessResult.Stages[grsiRendererSizeMatch] := dsFail;
|
|
if not FirstFailure.HasValue then
|
|
begin
|
|
FirstFailure.HasValue := True;
|
|
FirstFailure.Value := grsiRendererSizeMatch;
|
|
FirstFailureMessage := 'Renderer size does not match the physical surface';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
AttemptedStage := grsiTextureBackend;
|
|
Attempted := True;
|
|
BackendReady := TKMRender.TextureBackendReady;
|
|
FReadinessResult.Evidence.TextureBackendReady.Value := BackendReady;
|
|
FReadinessResult.Evidence.TextureBackendReady.HasValue := True;
|
|
if BackendReady then
|
|
FReadinessResult.Stages[grsiTextureBackend] := dsPass
|
|
else
|
|
begin
|
|
FReadinessResult.Stages[grsiTextureBackend] := dsFail;
|
|
if not FirstFailure.HasValue then
|
|
begin
|
|
FirstFailure.HasValue := True;
|
|
FirstFailure.Value := grsiTextureBackend;
|
|
FirstFailureMessage := 'Texture backend is not ready';
|
|
end;
|
|
end;
|
|
|
|
AttemptedStage := grsiSampledProgram;
|
|
Attempted := True;
|
|
FReadinessResult.Evidence.SampledProgramReady.Value := TKMRender.SampledProgramReady;
|
|
FReadinessResult.Evidence.SampledProgramReady.HasValue := True;
|
|
if FReadinessResult.Evidence.SampledProgramReady.Value then
|
|
FReadinessResult.Stages[grsiSampledProgram] := dsPass
|
|
else
|
|
begin
|
|
FReadinessResult.Stages[grsiSampledProgram] := dsFail;
|
|
if not FirstFailure.HasValue then
|
|
begin
|
|
FirstFailure.HasValue := True;
|
|
FirstFailure.Value := grsiSampledProgram;
|
|
FirstFailureMessage := 'Sampled program is not ready';
|
|
end;
|
|
end;
|
|
|
|
if BackendReady then
|
|
begin
|
|
AttemptedStage := grsiMaxTextureSize;
|
|
Attempted := True;
|
|
MaxTextureSize := TKMRender.MaxTextureSize;
|
|
FReadinessResult.Evidence.MaxTextureSize.Value := MaxTextureSize;
|
|
FReadinessResult.Evidence.MaxTextureSize.HasValue := True;
|
|
if FReadinessResult.Evidence.MaxTextureSize.Value > 0 then
|
|
FReadinessResult.Stages[grsiMaxTextureSize] := dsPass
|
|
else
|
|
begin
|
|
FReadinessResult.Stages[grsiMaxTextureSize] := dsFail;
|
|
if not FirstFailure.HasValue then
|
|
begin
|
|
FirstFailure.HasValue := True;
|
|
FirstFailure.Value := grsiMaxTextureSize;
|
|
FirstFailureMessage := 'Maximum texture size is zero';
|
|
end;
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
HasException := True;
|
|
ExceptionClass := E.ClassName;
|
|
ExceptionMessage := E.Message;
|
|
if Attempted then
|
|
begin
|
|
FReadinessResult.Stages[AttemptedStage] := dsFail;
|
|
FReadinessResult.FailureStage.HasValue := True;
|
|
FReadinessResult.FailureStage.Value := AttemptedStage;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if HasException then
|
|
begin
|
|
FReadinessResult.Status := dsFail;
|
|
SetActionError(ExceptionClass, ExceptionMessage);
|
|
FReadinessResult.FailureStage.HasValue := True;
|
|
FReadinessResult.FailureStage.Value := AttemptedStage;
|
|
end
|
|
else if not FirstFailure.HasValue then
|
|
FReadinessResult.Status := dsPass
|
|
else
|
|
begin
|
|
FReadinessResult.Status := dsFail;
|
|
FReadinessResult.FailureStage := FirstFailure;
|
|
SetActionError('', FirstFailureMessage);
|
|
end;
|
|
FinalizeAction;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.ObserveTextureLifecycle;
|
|
var
|
|
InitialPixels, ReplacementPixels: array[0..15] of Byte;
|
|
Stage: TGraphicsTextureDiagnosticStageId;
|
|
Ready, ReadinessError: Boolean;
|
|
ErrorValue: TDiagnosticError;
|
|
|
|
procedure RecordFailure(const AHasStage: Boolean;
|
|
const AStage: TGraphicsTextureDiagnosticStageId;
|
|
const AClassName, AMessage: string; const ASecondary: Boolean = False);
|
|
begin
|
|
ErrorValue := Default(TDiagnosticError);
|
|
ErrorValue.Present := True;
|
|
if AClassName <> '' then
|
|
begin
|
|
ErrorValue.ClassName.HasValue := True;
|
|
ErrorValue.ClassName.Value := AClassName;
|
|
end;
|
|
ErrorValue.MessageText.HasValue := True;
|
|
ErrorValue.MessageText.Value := AMessage;
|
|
if ASecondary then
|
|
FTextureResult.Evidence.SecondaryCleanupError := ErrorValue
|
|
else if FTextureResult.Status <> dsFail then
|
|
begin
|
|
FTextureResult.Status := dsFail;
|
|
FTextureResult.Error := ErrorValue;
|
|
if AHasStage then
|
|
begin
|
|
FTextureResult.FailureStage.HasValue := True;
|
|
FTextureResult.FailureStage.Value := AStage;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GpuReady(const ACleanup: Boolean = False): Boolean;
|
|
begin
|
|
ReadinessError := False;
|
|
Result := (FRenderer <> nil) and FContextReportedAvailable and
|
|
FRendererContextSynced;
|
|
if Result then
|
|
try
|
|
Result := TKMRender.TextureBackendReady;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
ReadinessError := True;
|
|
RecordFailure(False, gtsiInitialCreate, E.ClassName, E.Message,
|
|
ACleanup and (FTextureResult.Status = dsFail));
|
|
Result := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure NeedGpuForStage(const AStage: TGraphicsTextureDiagnosticStageId);
|
|
begin
|
|
if FExecutionState = gesIdle then
|
|
Exit;
|
|
if not GpuReady then
|
|
begin
|
|
if (FTextureResult.Status <> dsFail) then
|
|
begin
|
|
RecordFailure(False, AStage, '', 'Texture operation is unavailable');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure PrepareTexturePixels;
|
|
begin
|
|
FillChar(InitialPixels, SizeOf(InitialPixels), 0);
|
|
FillChar(ReplacementPixels, SizeOf(ReplacementPixels), 0);
|
|
InitialPixels[0] := 255; InitialPixels[3] := 255;
|
|
InitialPixels[5] := 255; InitialPixels[7] := 255;
|
|
InitialPixels[10] := 255; InitialPixels[11] := 255;
|
|
InitialPixels[12] := 255; InitialPixels[13] := 255;
|
|
InitialPixels[14] := 255; InitialPixels[15] := 255;
|
|
ReplacementPixels[1] := 255; ReplacementPixels[2] := 255;
|
|
ReplacementPixels[3] := 255; ReplacementPixels[4] := 255;
|
|
ReplacementPixels[6] := 255; ReplacementPixels[7] := 255;
|
|
ReplacementPixels[8] := 255; ReplacementPixels[9] := 255;
|
|
ReplacementPixels[11] := 255; ReplacementPixels[15] := 255;
|
|
end;
|
|
|
|
function CreateTestTexture: Boolean;
|
|
begin
|
|
FTextureResult.Evidence.InitialWidth.HasValue := True;
|
|
FTextureResult.Evidence.InitialWidth.Value := 2;
|
|
FTextureResult.Evidence.InitialHeight.HasValue := True;
|
|
FTextureResult.Evidence.InitialHeight.Value := 2;
|
|
FTextureResult.Evidence.InitialFormat.HasValue := True;
|
|
FTextureResult.Evidence.InitialFormat.Value := 'tfRGBA8';
|
|
FTextureResult.Evidence.MinFilter.HasValue := True;
|
|
FTextureResult.Evidence.MinFilter.Value := 'ftNearest';
|
|
FTextureResult.Evidence.MagFilter.HasValue := True;
|
|
FTextureResult.Evidence.MagFilter.Value := 'ftNearest';
|
|
try
|
|
FTextureTestId := TKMRender.GenTexture(2, 2, @InitialPixels[0],
|
|
tfRGBA8, ftNearest, ftNearest);
|
|
FTextureResult.Stages[gtsiInitialCreate] := dsPass;
|
|
FTextureResult.Evidence.GenTextureCompleted.HasValue := True;
|
|
FTextureResult.Evidence.GenTextureCompleted.Value := True;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FTextureTestId := 0;
|
|
FTextureResult.Stages[gtsiInitialCreate] := dsFail;
|
|
FTextureResult.Evidence.GenTextureCompleted.HasValue := True;
|
|
FTextureResult.Evidence.GenTextureCompleted.Value := False;
|
|
RecordFailure(True, gtsiInitialCreate, E.ClassName, E.Message);
|
|
FinalizeAction;
|
|
Exit(False);
|
|
end;
|
|
end;
|
|
|
|
FTextureResult.Evidence.NonZeroTextureId.HasValue := True;
|
|
FTextureResult.Evidence.NonZeroTextureId.Value := FTextureTestId <> 0;
|
|
if FTextureTestId <> 0 then
|
|
FTextureResult.Stages[gtsiNonZeroTextureId] := dsPass
|
|
else
|
|
begin
|
|
FTextureResult.Stages[gtsiNonZeroTextureId] := dsFail;
|
|
RecordFailure(True, gtsiNonZeroTextureId, '', 'GenTexture returned texture ID 0');
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure ExerciseTestTexture;
|
|
begin
|
|
if FTextureTestId <> 0 then
|
|
begin
|
|
NeedGpuForStage(gtsiFirstBind);
|
|
if GetBusy and (FTextureResult.Status <> dsFail) then
|
|
try
|
|
TKMRender.BindTexture(FTextureTestId);
|
|
FTextureResult.Stages[gtsiFirstBind] := dsPass;
|
|
FTextureResult.Evidence.FirstBindCompleted.HasValue := True;
|
|
FTextureResult.Evidence.FirstBindCompleted.Value := True;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FTextureResult.Stages[gtsiFirstBind] := dsFail;
|
|
FTextureResult.Evidence.FirstBindCompleted.HasValue := True;
|
|
FTextureResult.Evidence.FirstBindCompleted.Value := False;
|
|
RecordFailure(True, gtsiFirstBind, E.ClassName, E.Message);
|
|
end;
|
|
end;
|
|
|
|
if GetBusy and (FTextureResult.Status <> dsFail) then
|
|
begin
|
|
NeedGpuForStage(gtsiReplacementUpdate);
|
|
if GetBusy and (FTextureResult.Status <> dsFail) then
|
|
begin
|
|
FTextureResult.Evidence.ReplacementWidth.HasValue := True;
|
|
FTextureResult.Evidence.ReplacementWidth.Value := 2;
|
|
FTextureResult.Evidence.ReplacementHeight.HasValue := True;
|
|
FTextureResult.Evidence.ReplacementHeight.Value := 2;
|
|
FTextureResult.Evidence.ReplacementFormat.HasValue := True;
|
|
FTextureResult.Evidence.ReplacementFormat.Value := 'tfRGBA8';
|
|
try
|
|
TKMRender.UpdateTexture(FTextureTestId, 2, 2, tfRGBA8,
|
|
@ReplacementPixels[0]);
|
|
FTextureResult.Stages[gtsiReplacementUpdate] := dsPass;
|
|
FTextureResult.Evidence.ReplacementUpdateCompleted.HasValue := True;
|
|
FTextureResult.Evidence.ReplacementUpdateCompleted.Value := True;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FTextureResult.Stages[gtsiReplacementUpdate] := dsFail;
|
|
FTextureResult.Evidence.ReplacementUpdateCompleted.HasValue := True;
|
|
FTextureResult.Evidence.ReplacementUpdateCompleted.Value := False;
|
|
RecordFailure(True, gtsiReplacementUpdate, E.ClassName, E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if GetBusy and (FTextureResult.Status <> dsFail) then
|
|
begin
|
|
NeedGpuForStage(gtsiSecondBind);
|
|
if GetBusy and (FTextureResult.Status <> dsFail) then
|
|
try
|
|
TKMRender.BindTexture(FTextureTestId);
|
|
FTextureResult.Stages[gtsiSecondBind] := dsPass;
|
|
FTextureResult.Evidence.SecondBindCompleted.HasValue := True;
|
|
FTextureResult.Evidence.SecondBindCompleted.Value := True;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FTextureResult.Stages[gtsiSecondBind] := dsFail;
|
|
FTextureResult.Evidence.SecondBindCompleted.HasValue := True;
|
|
FTextureResult.Evidence.SecondBindCompleted.Value := False;
|
|
RecordFailure(True, gtsiSecondBind, E.ClassName, E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CleanupTestTexture;
|
|
begin
|
|
if not GetBusy then
|
|
Exit;
|
|
if FTextureTestId <> 0 then
|
|
begin
|
|
Ready := GpuReady(True);
|
|
if Ready then
|
|
begin
|
|
FTextureResult.Evidence.DeleteAttempted.HasValue := True;
|
|
FTextureResult.Evidence.DeleteAttempted.Value := True;
|
|
try
|
|
TKMRender.DeleteTexture(FTextureTestId);
|
|
FTextureResult.Stages[gtsiTextureDelete] := dsPass;
|
|
FTextureResult.Evidence.DeleteCompleted.HasValue := True;
|
|
FTextureResult.Evidence.DeleteCompleted.Value := True;
|
|
FTextureTestId := 0;
|
|
FTextureResult.Stages[gtsiResourceCleanup] := dsPass;
|
|
FTextureResult.Evidence.CleanupCompleted.HasValue := True;
|
|
FTextureResult.Evidence.CleanupCompleted.Value := True;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FTextureResult.Stages[gtsiTextureDelete] := dsFail;
|
|
FTextureResult.Stages[gtsiResourceCleanup] := dsFail;
|
|
FTextureResult.Evidence.DeleteCompleted.HasValue := True;
|
|
FTextureResult.Evidence.DeleteCompleted.Value := False;
|
|
if FTextureResult.Status = dsFail then
|
|
RecordFailure(False, gtsiTextureDelete, E.ClassName, E.Message, True)
|
|
else
|
|
RecordFailure(True, gtsiTextureDelete, E.ClassName, E.Message);
|
|
FTextureTestId := 0;
|
|
end;
|
|
end;
|
|
end
|
|
else if FExecutionState <> gesIdle then
|
|
begin
|
|
if not ReadinessError then
|
|
if FTextureResult.Status = dsFail then
|
|
RecordFailure(False, gtsiTextureDelete, '',
|
|
'Texture deletion is unavailable', True)
|
|
else
|
|
RecordFailure(False, gtsiTextureDelete, '',
|
|
'Texture deletion is unavailable');
|
|
FTextureTestId := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
PrepareTexturePixels;
|
|
if not GpuReady then
|
|
begin
|
|
if FTextureResult.Status <> dsFail then
|
|
RecordFailure(False, gtsiInitialCreate, '', 'Texture backend is not ready');
|
|
FinalizeAction;
|
|
Exit;
|
|
end;
|
|
|
|
if not CreateTestTexture then Exit;
|
|
ExerciseTestTexture;
|
|
CleanupTestTexture;
|
|
if not GetBusy then
|
|
Exit;
|
|
if FTextureResult.Status <> dsFail then
|
|
begin
|
|
FTextureResult.Status := dsPass;
|
|
for Stage := Low(TGraphicsTextureDiagnosticStageId) to
|
|
High(TGraphicsTextureDiagnosticStageId) do
|
|
if FTextureResult.Stages[Stage] <> dsPass then
|
|
FTextureResult.Status := dsFail;
|
|
end;
|
|
FinalizeAction;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.DispatchFrame;
|
|
begin
|
|
if (FExecutionState = gesIdle) and (FActionKind = gakNone) then
|
|
Exit;
|
|
if FContextTransitionErrorPresent or not FContextReportedAvailable or
|
|
not FRendererContextSynced then
|
|
begin
|
|
if FActionKind = gakReadiness then
|
|
SetReadinessSnapshot;
|
|
if FActionKind = gakVisibleDraw then
|
|
begin
|
|
if FVisibleTextureId <> 0 then
|
|
begin
|
|
MarkInterruptedVisiblePhase;
|
|
if not FContextReportedAvailable then
|
|
InvalidateTextureOnContextLoss
|
|
else
|
|
begin
|
|
FVisibleDrawResult.Evidence.CleanupBlockedByContext.HasValue := True;
|
|
FVisibleDrawResult.Evidence.CleanupBlockedByContext.Value := True;
|
|
FVisibleTextureId := 0;
|
|
FVisiblePhase := vdpNotStarted;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
end;
|
|
end;
|
|
if not FVisibleDrawResult.Error.Present then
|
|
begin
|
|
if FContextTransitionErrorPresent then
|
|
SetActionError(FContextTransitionErrorClass, FContextTransitionErrorMessage)
|
|
else if not FContextReportedAvailable then
|
|
SetActionError('', 'Graphics context is unavailable')
|
|
else
|
|
SetActionError('', 'Graphics renderer context is not synchronized');
|
|
end;
|
|
end
|
|
else if FContextTransitionErrorPresent then
|
|
SetActionError(FContextTransitionErrorClass, FContextTransitionErrorMessage)
|
|
else if not FContextReportedAvailable then
|
|
SetActionError('', 'Graphics context is unavailable')
|
|
else
|
|
SetActionError('', 'Graphics renderer context is not synchronized');
|
|
FinalizeAction;
|
|
Exit;
|
|
end;
|
|
if FExecutionState = gesPending then
|
|
FExecutionState := gesActive;
|
|
try
|
|
case FActionKind of
|
|
gakReadiness: ObserveReadiness;
|
|
gakTextureLifecycle: ObserveTextureLifecycle;
|
|
gakVisibleDraw: ObserveVisibleDraw;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
if GetBusy then
|
|
begin
|
|
SetActionError(E.ClassName, E.Message);
|
|
FinalizeAction;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.EnsureAttached;
|
|
begin
|
|
if FClosing then
|
|
raise Exception.Create('Graphics diagnostic session is closing');
|
|
if FPresentationAttached and FLifecycleAttached then
|
|
Exit;
|
|
|
|
try
|
|
KMGameAppMobileAttachPresentation(@HandleFrame, @HandleResize);
|
|
FPresentationAttached := True;
|
|
FPhysicalWidth := FContainer.PixelsWidth;
|
|
FPhysicalHeight := FContainer.PixelsHeight;
|
|
FPhysicalSizeKnown := True;
|
|
KMGameAppMobileAttach(@HandleContextAvailability);
|
|
FLifecycleAttached := True;
|
|
FRenderer := TKMRender.Create(FPhysicalWidth, FPhysicalHeight);
|
|
except
|
|
if FLifecycleAttached then
|
|
try
|
|
KMGameAppMobileDetach;
|
|
except
|
|
end;
|
|
if FPresentationAttached then
|
|
try
|
|
KMGameAppMobileDetachPresentation;
|
|
except
|
|
end;
|
|
if FContextReportedAvailable then
|
|
try
|
|
TKMRender.GraphicsContextChanged(False);
|
|
except
|
|
end;
|
|
try
|
|
FreeAndNil(FRenderer);
|
|
except
|
|
end;
|
|
FPresentationAttached := False;
|
|
FLifecycleAttached := False;
|
|
FPhysicalWidth := 0;
|
|
FPhysicalHeight := 0;
|
|
FPhysicalSizeKnown := False;
|
|
FContextReportedAvailable := False;
|
|
FRendererContextSynced := False;
|
|
FContextTransitionErrorPresent := False;
|
|
FContextTransitionErrorClass := '';
|
|
FContextTransitionErrorMessage := '';
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.HandleResize(aWidth, aHeight: Integer);
|
|
begin
|
|
if FClosing then
|
|
Exit;
|
|
FPhysicalWidth := aWidth;
|
|
FPhysicalHeight := aHeight;
|
|
FPhysicalSizeKnown := True;
|
|
if FRenderer <> nil then
|
|
FRenderer.Resize(aWidth, aHeight);
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.HandleContextAvailability(aAvailable: Boolean);
|
|
begin
|
|
if FClosing then
|
|
Exit;
|
|
if aAvailable then
|
|
begin
|
|
FContextReportedAvailable := True;
|
|
FRendererContextSynced := False;
|
|
try
|
|
TKMRender.GraphicsContextChanged(True);
|
|
FRendererContextSynced := True;
|
|
FContextTransitionErrorPresent := False;
|
|
FContextTransitionErrorClass := '';
|
|
FContextTransitionErrorMessage := '';
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FContextTransitionErrorPresent := True;
|
|
FContextTransitionErrorClass := E.ClassName;
|
|
FContextTransitionErrorMessage := E.Message;
|
|
try
|
|
TKMRender.GraphicsContextChanged(False);
|
|
except
|
|
on RollbackError: Exception do
|
|
FContextTransitionErrorMessage := FContextTransitionErrorMessage + LineEnding +
|
|
RollbackError.ClassName + ': ' + RollbackError.Message;
|
|
end;
|
|
end;
|
|
end;
|
|
if FContextTransitionErrorPresent and not FAttachInProgress and GetBusy then
|
|
begin
|
|
if FActionKind = gakReadiness then
|
|
SetReadinessSnapshot;
|
|
SetActionError(FContextTransitionErrorClass, FContextTransitionErrorMessage);
|
|
FinalizeAction;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
InvalidateTextureOnContextLoss;
|
|
FContextReportedAvailable := False;
|
|
FRendererContextSynced := False;
|
|
if not FAttachInProgress and GetBusy then
|
|
begin
|
|
if FActionKind = gakReadiness then
|
|
SetReadinessSnapshot;
|
|
if FActionKind = gakTextureLifecycle then
|
|
begin
|
|
FTextureResult.Status := dsFail;
|
|
if not FTextureResult.Error.Present then
|
|
SetActionError('', 'Graphics context became unavailable');
|
|
end
|
|
else if (FActionKind <> gakVisibleDraw) or
|
|
not FVisibleDrawResult.Error.Present then
|
|
SetActionError('', 'Graphics context became unavailable');
|
|
FinalizeAction;
|
|
end;
|
|
try
|
|
TKMRender.GraphicsContextChanged(False);
|
|
FContextTransitionErrorPresent := False;
|
|
FContextTransitionErrorClass := '';
|
|
FContextTransitionErrorMessage := '';
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FContextTransitionErrorPresent := True;
|
|
FContextTransitionErrorClass := E.ClassName;
|
|
FContextTransitionErrorMessage := E.Message;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGraphicsDiagnosticSession.HandleFrame;
|
|
begin
|
|
if FClosing or not FPresentationAttached or not FLifecycleAttached or
|
|
(FRenderer = nil) then
|
|
Exit;
|
|
DispatchFrame;
|
|
end;
|
|
|
|
destructor TGraphicsDiagnosticSession.Destroy;
|
|
begin
|
|
FClosing := True;
|
|
if FPresentationAttached then
|
|
begin
|
|
try
|
|
KMGameAppMobileDetachPresentation;
|
|
except
|
|
end;
|
|
FPresentationAttached := False;
|
|
end;
|
|
if FTextureTestId <> 0 then
|
|
begin
|
|
FTextureTestId := 0;
|
|
if FActionKind = gakTextureLifecycle then
|
|
begin
|
|
FTextureResult.Evidence.CleanupBlockedByContext.HasValue := True;
|
|
FTextureResult.Evidence.CleanupBlockedByContext.Value := True;
|
|
end;
|
|
end;
|
|
if FVisibleTextureId <> 0 then
|
|
begin
|
|
MarkInterruptedVisiblePhase;
|
|
FVisibleDrawResult.Evidence.CleanupBlockedByContext.HasValue := True;
|
|
FVisibleDrawResult.Evidence.CleanupBlockedByContext.Value := True;
|
|
FVisibleTextureId := 0;
|
|
end;
|
|
FVisiblePhase := vdpNotStarted;
|
|
FVisiblePhaseStarted := False;
|
|
FVisibleFramesCompletedInPhase := 0;
|
|
if GetBusy then
|
|
begin
|
|
if FActionKind = gakReadiness then
|
|
SetReadinessSnapshot;
|
|
if FActionKind = gakVisibleDraw then
|
|
begin
|
|
if not FVisibleDrawResult.Error.Present then
|
|
SetActionError('', 'Graphics diagnostic session was closed');
|
|
end
|
|
else if (FActionKind <> gakTextureLifecycle) or not FTextureResult.Error.Present then
|
|
SetActionError('', 'Graphics diagnostic session was closed')
|
|
else
|
|
FTextureResult.Status := dsFail;
|
|
FinalizeAction;
|
|
end;
|
|
if FLifecycleAttached then
|
|
begin
|
|
try
|
|
KMGameAppMobileDetach;
|
|
except
|
|
end;
|
|
FLifecycleAttached := False;
|
|
end;
|
|
if FRendererContextSynced then
|
|
try
|
|
TKMRender.GraphicsContextChanged(False);
|
|
except
|
|
end;
|
|
try
|
|
FreeAndNil(FRenderer);
|
|
except
|
|
end;
|
|
FPhysicalWidth := 0;
|
|
FPhysicalHeight := 0;
|
|
FPhysicalSizeKnown := False;
|
|
FContextReportedAvailable := False;
|
|
FRendererContextSynced := False;
|
|
FContextTransitionErrorPresent := False;
|
|
FContextTransitionErrorClass := '';
|
|
FContextTransitionErrorMessage := '';
|
|
FContainer := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
end.
|