Complete BigTask

code/DecisionHostCallback.pas

@@ -1,22 +0,0 @@
-unit DecisionHostCallback;
-{$mode objfpc}{$H+}
-{$ifndef ANDROID}{$fatal Android-only decision host probe}{$endif}
-interface
-implementation
-uses SysUtils,fpjson,CastleWindow,ProbeReport,ProbePlatform,ProbeDecision;
-var Window:TCastleWindow;
-procedure Initialize;
-var R:TProbeReport;Dir:string;
-begin
-  R:=TProbeReport.Create;
-  try
-    Dir:=ProbeDirectory;R.Root.Add('report_directory',Dir);
-    R.Add('android.startup','PASS','Application.OnInitialize reached without a custom TCastleView');
-    R.Add('decision.host.callback','PASS','Lifecycle application callback host variant executed');
-    RunPlatformChecks(R,Dir);RunDecisionChecks(R,Dir);R.Save(Dir+'runtime.json');
-  finally R.Free;end;
-end;
-initialization
-  Application.OnInitialize:=@Initialize;
-  Window:=TCastleWindow.Create(Application);Application.MainWindow:=Window;
-end.

code/DecisionHostText.pas

@@ -1,22 +0,0 @@
-unit DecisionHostText;
-{$mode objfpc}{$H+}
-{$ifndef ANDROID}{$fatal Android-only text provider probe}{$endif}
-interface
-implementation
-uses cwstring,fpjson,CastleWindow,ProbeReport,ProbePlatform,ProbeTextProvider;
-var Window:TCastleWindow;
-procedure Initialize;
-var R:TProbeReport;Dir:string;
-begin
-  R:=TProbeReport.Create;
-  try
-    Dir:=ProbeDirectory;R.Root.Add('report_directory',Dir);
-    R.Add('android.startup','PASS','Pinned FPC text-provider host initialized');
-    R.Add('decision.text.cwstring_unit','PASS','cwstring unit linked and initialized for Android target');
-    RunTextProviderChecks(R);R.Save(Dir+'runtime.json');
-  finally R.Free;end;
-end;
-initialization
-  Application.OnInitialize:=@Initialize;
-  Window:=TCastleWindow.Create(Application);Application.MainWindow:=Window;
-end.

code/DecisionHostView.pas

@@ -1,27 +0,0 @@
-unit DecisionHostView;
-{$mode objfpc}{$H+}
-{$ifndef ANDROID}{$fatal Android-only decision host probe}{$endif}
-interface
-implementation
-uses SysUtils,fpjson,CastleWindow,CastleUIControls,ProbeReport,ProbePlatform,ProbeDecision;
-type
-  TDecisionView=class(TCastleView)
-  public procedure Start;override;end;
-var Window:TCastleWindow;
-procedure TDecisionView.Start;
-var R:TProbeReport;Dir:string;
-begin
-  inherited;R:=TProbeReport.Create;
-  try
-    Dir:=ProbeDirectory;R.Root.Add('report_directory',Dir);
-    R.Add('android.startup','PASS','Minimal TCastleView Start reached without child controls');
-    R.Add('decision.host.view','PASS','TCastleView host variant reached Start');
-    RunPlatformChecks(R,Dir);RunDecisionChecks(R,Dir);R.Save(Dir+'runtime.json');
-  finally R.Free;end;
-end;
-procedure Initialize;
-begin Window.Container.View:=TDecisionView.Create(Application);end;
-initialization
-  Application.OnInitialize:=@Initialize;
-  Window:=TCastleWindow.Create(Application);Application.MainWindow:=Window;
-end.

code/GameInitialize.pas

@@ -1,13 +1,12 @@
 unit GameInitialize;
 {$mode objfpc}{$H+}
-{$ifndef ANDROID}{$fatal Android-only architecture probe; there is no desktop target}{$endif}
+{$ifndef ANDROID}{$fatal Android-only KaM Remake Mobile application; there is no desktop target}{$endif}
 interface
 implementation
-uses CastleWindow, GameViewMain;
+uses CastleWindow;
 var Window: TCastleWindow;
 procedure Initialize;
 begin
-  Window.Container.View := TProbeView.Create(Application);
 end;
 initialization
   Application.OnInitialize := @Initialize;

code/GameViewMain.pas

@@ -1,241 +0,0 @@
-unit GameViewMain;
-{$mode objfpc}{$H+}{$codepage utf8}{$pointermath on}
-interface
-uses Classes, SysUtils, CastleUIControls, CastleControls, CastleKeysMouse,
-  CastleVectors, CastleSoundEngine, ProbeReport, ProbeCamera, ProbeScheduling;
-type
-  TProbeView = class(TCastleView)
-  private
-    FStatus,FHelp:TCastleLabel;
-    FImage:TCastleImageControl;
-    FSound:TCastleSound;
-    FReport:TProbeReport;
-    FDir,FCell:string;
-    FCamera:TProbeCamera;
-    FDown:array[0..9] of Boolean;
-    FPos,FStart:array[0..9] of TVector2;
-    FMoved,FMulti,FStarted,FListeners:Boolean;
-    FTaps,FPans,FPinches,FFrames,FUpdates,FPauses,FResumes,FGLCloses,FGLOpens:Integer;
-    FElapsed:Single;
-    FSchedule:TDecisionSchedule;
-    procedure MakeImage;
-    procedure PlaceImage;
-    procedure SaveReport;
-    procedure SaveClicked(Sender:TObject);
-    procedure SoundClicked(Sender:TObject);
-    procedure Paused(Sender:TObject);
-    procedure Resumed(Sender:TObject);
-    procedure ContextOpened(Sender:TObject);
-    procedure ContextClosed(Sender:TObject);
-    function Fingers(out A,B:Integer):Integer;
-  public
-    procedure Start; override;
-    procedure Stop; override;
-    procedure Render; override;
-    procedure Update(const SecondsPassed:Single;var HandleInput:Boolean); override;
-    function Press(const Event:TInputPressRelease):Boolean; override;
-    function Release(const Event:TInputPressRelease):Boolean; override;
-    function Motion(const Event:TInputMotion):Boolean; override;
-  end;
-implementation
-uses Math, cwstring, fpjson, CastleImages, CastleUriUtils, CastleApplicationProperties,
-  CastleLog, ProbePlatform, ProbeAssets, ProbeDecision, ProbeTextProvider, ProbeImports, ProbeBuild;
-procedure TProbeView.Start;
-var B:TCastleButton; DataDir:string;
-begin
-  inherited;
-  FImage:=TCastleImageControl.Create(FreeAtStop);FImage.Stretch:=True;InsertFront(FImage);
-  FStatus:=TCastleLabel.Create(FreeAtStop);FStatus.FontSize:=16;
-  FStatus.Anchor(hpLeft,12);FStatus.Anchor(vpTop,-10);InsertFront(FStatus);
-  FHelp:=TCastleLabel.Create(FreeAtStop);FHelp.FontSize:=14;
-  FHelp.Anchor(hpLeft,12);FHelp.Anchor(vpBottom,10);InsertFront(FHelp);
-  B:=TCastleButton.Create(FreeAtStop);B.Caption:='Save report';
-  B.Anchor(hpLeft,12);B.Anchor(vpTop,-90);B.OnClick:=@SaveClicked;InsertFront(B);
-  B:=TCastleButton.Create(FreeAtStop);B.Caption:='Test sound';
-  B.Anchor(hpLeft,175);B.Anchor(vpTop,-90);B.OnClick:=@SoundClicked;InsertFront(B);
-  FSound:=TCastleSound.Create(FreeAtStop);
-  FReport:=TProbeReport.Create;
-  try
-    FDir:=ProbeDirectory;
-    FReport.Root.Add('report_directory',FDir);
-    FReport.Add('android.startup','PASS','CGE application initialized; library and unit initializers reached UI');
-    RunPlatformChecks(FReport,FDir);
-    RunDecisionChecks(FReport,FDir);
-    FReport.Add('decision.text.cwstring_unit','PASS','cwstring unit linked and initialized in the common Android runtime APK');
-    RunTextProviderChecks(FReport);
-    RunUpstreamChecks(FReport);
-    FSchedule:=TDecisionSchedule.Create(FReport);
-    try DataDir:=PrepareOptionalAssets(FReport,FDir);
-      FReport.Root.Add('native_asset_directory',DataDir);
-    except on E:Exception do FReport.Add('assets.native_adapter','FAIL',E.ClassName+': '+E.Message);end;
-    MakeImage;
-    FCamera.Reset;
-    FCamera.PixelsPerCell:=Max(4.0,Min((Container.UnscaledWidth-40)/32,
-      (Container.UnscaledHeight-180)/32));
-    FCamera.OffsetY:=40;PlaceImage;
-    FReport.Add('render.visual_correctness','NOT_RUN','Procedural checker only; inspect on device. Not KaM terrain.');
-    FReport.Add('audio.audible','NOT_RUN','Press Test sound and listen; API success does not prove audible output');
-    ApplicationProperties.OnPause.Add(@Paused);
-    ApplicationProperties.OnResume.Add(@Resumed);
-    ApplicationProperties.OnGLContextOpenObject.Add(@ContextOpened);
-    ApplicationProperties.OnGLContextCloseObject.Add(@ContextClosed);
-    FListeners:=True;
-    FReport.Add('render.context','NOT_RUN','Awaiting the first render callback');
-    FStarted:=True;
-    FStatus.Caption:='Android / '+ProbeProfile+' / '+ProbeCpu+LineEnding+
-      'Automatic smoke: '+FReport.Status+'; device observations separate'+LineEnding+
-      'Architecture probe only. No KaM world or simulation.';
-    SaveReport;
-  except on E:Exception do begin
-    FReport.Add('android.startup','FAIL',E.ClassName+': '+E.Message);
-    FStatus.Caption:='STARTUP FAILED: '+E.Message;
-    if FDir<>'' then SaveReport;
-  end;end;
-end;
-procedure TProbeView.MakeImage;
-var Image:TRGBAlphaImage;Row:PByte;X,Y:Integer;V:Byte;
-begin
-  Image:=TRGBAlphaImage.Create(256,256);
-  try
-    for Y:=0 to 255 do begin
-      Row:=PByte(Image.RowPtr(Y));
-      for X:=0 to 255 do begin
-        if ((X div 8)+(Y div 8)) mod 2=0 then V:=90 else V:=150;
-        Row[X*4]:=V;Row[X*4+1]:=V;Row[X*4+2]:=V;Row[X*4+3]:=255;
-      end;
-    end;
-    FImage.Image:=Image;Image:=nil;
-  finally Image.Free;end;
-end;
-procedure TProbeView.PlaceImage;
-begin
-  FImage.Left:=FCamera.OffsetX;FImage.Bottom:=FCamera.OffsetY;
-  FImage.Width:=32*FCamera.PixelsPerCell;FImage.Height:=32*FCamera.PixelsPerCell;
-  FHelp.Caption:=Format('Synthetic grid | tap %d | pan %d | pinch %d | cell %s',
-    [FTaps,FPans,FPinches,FCell]);
-end;
-procedure TProbeView.SaveReport;
-var J:TJSONObject;
-begin
-  if (FReport=nil) or (FDir='') then Exit;
-  try
-    FReport.Root.Delete('session');J:=TJSONObject.Create;
-    J.Add('frames',FFrames);J.Add('updates',FUpdates);
-    J.Add('taps',FTaps);J.Add('pan_events',FPans);J.Add('pinch_events',FPinches);
-    J.Add('pauses',FPauses);J.Add('resumes',FResumes);
-    J.Add('gl_open_events',FGLOpens);J.Add('gl_close_events',FGLCloses);
-    J.Add('last_cell',FCell);J.Add('width',Container.UnscaledWidth);
-    J.Add('height',Container.UnscaledHeight);
-    FReport.Root.Add('session',J);
-    if FFrames>0 then FReport.Check('render.context',ApplicationProperties.IsGLContextOpen,'CGE GL context during render/update');
-    if FFrames>=30 then FReport.Add('render.frame_callbacks','PASS','At least 30 render callbacks; visual output still requires observation');
-    FReport.Save(FDir+'runtime.json');
-    WritelnLog('KaMProbe','KAM_PROBE_REPORT '+FDir+'runtime.json');
-  except on E:Exception do begin
-    WritelnLog('KaMProbe','REPORT_SAVE_FAILED '+E.Message);
-    FStatus.Caption:='REPORT SAVE FAILED: '+E.Message;
-  end;end;
-end;
-procedure TProbeView.SaveClicked(Sender:TObject);
-begin SaveReport;FHelp.Caption:='Report: '+FDir+'runtime.json';end;
-procedure TProbeView.SoundClicked(Sender:TObject);
-begin
-  try
-    WriteTestTone(FDir+'generated-test-tone.wav');
-    FSound.Url:=FilenameToUriSafe(FDir+'generated-test-tone.wav');
-    SoundEngine.Play(FSound);
-    FReport.Add('audio.api','OBSERVED','CGE Play returned without exception; confirm audibility manually');
-  except on E:Exception do FReport.Add('audio.api','FAIL',E.ClassName+': '+E.Message);end;
-  SaveReport;
-end;
-procedure TProbeView.Paused(Sender:TObject);
-begin Inc(FPauses);if FSchedule<>nil then FSchedule.Paused;FillChar(FDown,SizeOf(FDown),0);FMoved:=True;SaveReport;end;
-procedure TProbeView.Resumed(Sender:TObject);
-begin Inc(FResumes);if FSchedule<>nil then FSchedule.Resumed;SaveReport;end;
-procedure TProbeView.ContextOpened(Sender:TObject);
-begin Inc(FGLOpens);end;
-procedure TProbeView.ContextClosed(Sender:TObject);
-begin Inc(FGLCloses);SaveReport;end;
-procedure TProbeView.Stop;
-begin
-  if FListeners then begin
-    ApplicationProperties.OnPause.Remove(@Paused);
-    ApplicationProperties.OnResume.Remove(@Resumed);
-    ApplicationProperties.OnGLContextOpenObject.Remove(@ContextOpened);
-    ApplicationProperties.OnGLContextCloseObject.Remove(@ContextClosed);
-    FListeners:=False;
-  end;
-  SaveReport;FStarted:=False;
-  FreeAndNil(FSchedule);
-  FillChar(FDown,SizeOf(FDown),0);FreeAndNil(FReport);
-  inherited;
-end;
-procedure TProbeView.Render;
-begin inherited;Inc(FFrames);end;
-procedure TProbeView.Update(const SecondsPassed:Single;var HandleInput:Boolean);
-begin
-  inherited;Inc(FUpdates);
-  if FSchedule<>nil then FSchedule.Tick;
-  FElapsed:=FElapsed+SecondsPassed;
-  if FStarted and (FElapsed>=2) then begin SaveReport;FElapsed:=0;end;
-end;
-function TProbeView.Fingers(out A,B:Integer):Integer;
-var I:Integer;
-begin
-  Result:=0;A:=-1;B:=-1;
-  for I:=0 to High(FDown) do if FDown[I] then begin
-    Inc(Result);if A<0 then A:=I else if B<0 then B:=I;
-  end;
-end;
-function TProbeView.Press(const Event:TInputPressRelease):Boolean;
-var A,B,I:Integer;
-begin
-  Result:=inherited;if Result or not FStarted then Exit;
-  if not Event.IsMouseButton(buttonLeft) then Exit;
-  I:=Event.FingerIndex;if (I<0) or (I>High(FDown)) then Exit;
-  if Fingers(A,B)=0 then begin FMoved:=False;FMulti:=False;end;
-  FDown[I]:=True;FPos[I]:=Event.Position;FStart[I]:=Event.Position;
-  if Fingers(A,B)>1 then FMulti:=True;
-  Result:=True;
-end;
-function TProbeView.Motion(const Event:TInputMotion):Boolean;
-var I,N,A,B:Integer;OldDistance,NewDistance:Single;OldMid,NewMid:TVector2;
-begin
-  Result:=inherited;
-  I:=Event.FingerIndex;if (I<0) or (I>High(FDown)) or not FDown[I] then Exit;
-  N:=Fingers(A,B);
-  if N>=2 then begin
-    OldDistance:=Sqrt(Sqr(FPos[A].X-FPos[B].X)+Sqr(FPos[A].Y-FPos[B].Y));
-    OldMid:=(FPos[A]+FPos[B])*0.5;
-  end;
-  if Sqr(Event.Position.X-FStart[I].X)+Sqr(Event.Position.Y-FStart[I].Y)>64 then FMoved:=True;
-  if N=1 then begin
-    { Do not pan before the movement threshold: a tap must not shift the grid. }
-    if FMoved then begin
-      FCamera.Pan(Event.Position.X-FPos[I].X,Event.Position.Y-FPos[I].Y);Inc(FPans);
-    end;
-  end;
-  FPos[I]:=Event.Position;
-  if N>=2 then begin
-    NewDistance:=Sqrt(Sqr(FPos[A].X-FPos[B].X)+Sqr(FPos[A].Y-FPos[B].Y));
-    NewMid:=(FPos[A]+FPos[B])*0.5;
-    if (OldDistance>1) and (NewDistance>1) then FCamera.ZoomAt(NewDistance/OldDistance,OldMid.X,OldMid.Y);
-    FCamera.Pan(NewMid.X-OldMid.X,NewMid.Y-OldMid.Y);Inc(FPinches);
-  end;
-  PlaceImage;Result:=True;
-end;
-function TProbeView.Release(const Event:TInputPressRelease):Boolean;
-var I,N,A,B,X,Y:Integer;
-begin
-  Result:=inherited;
-  if not Event.IsMouseButton(buttonLeft) then Exit;
-  I:=Event.FingerIndex;if (I<0) or (I>High(FDown)) or not FDown[I] then Exit;
-  N:=Fingers(A,B);FDown[I]:=False;
-  if (N=1) and not FMoved and not FMulti then begin
-    Inc(FTaps);
-    if FCamera.CellAt(Event.Position.X,Event.Position.Y,32,32,X,Y) then
-      FCell:=IntToStr(X)+','+IntToStr(Y) else FCell:='outside';
-  end;
-  PlaceImage;SaveReport;Result:=True;
-end;
-end.

code/ProbeAssets.pas

@@ -1,55 +0,0 @@
-unit ProbeAssets;
-{$mode objfpc}{$H+}
-interface
-uses ProbeReport;
-function PrepareOptionalAssets(Report:TProbeReport;const WorkDir:string):string;
-implementation
-uses Classes,SysUtils,fpjson,jsonparser,CastleDownload,CastleFilesUtils;
-function SafeRelative(const S:string):Boolean;
-var Parts:TStringList; I:Integer;
-begin
-  Result:=False;
-  if (S='') or (S[1]='/') or (Pos('\',S)>0) or (Pos(':',S)>0)
-    or (Pos(#0,S)>0) or (Pos(#10,S)>0) or (Pos(#13,S)>0) then Exit;
-  Parts:=TStringList.Create;
-  try
-    Parts.StrictDelimiter:=True;Parts.Delimiter:='/';Parts.DelimitedText:=S;
-    for I:=0 to Parts.Count-1 do
-      if (Parts[I]='') or (Parts[I]='.') or (Parts[I]='..') then Exit;
-    Result:=True;
-  finally Parts.Free;end;
-end;
-function PrepareOptionalAssets(Report:TProbeReport;const WorkDir:string):string;
-var Manifest:TJSONData; Files:TJSONArray; I:Integer; Rel,Name,Url:string;
-  Src:TStream;Dst:TFileStream;Count,Expected:Int64;
-begin
-  Result:=IncludeTrailingPathDelimiter(WorkDir)+'game/';
-  Manifest:=GetJSON(FileToString('castle-data:/assets-manifest.json'));
-  try
-    Files:=TJSONObject(Manifest).Arrays['files'];
-    if Files.Count=0 then begin
-      Report.Add('assets.native_adapter','NOT_RUN','No game resources supplied; code-only build is expected');
-      Exit;
-    end;
-    Count:=0;
-    for I:=0 to Files.Count-1 do begin
-      Rel:=Files.Objects[I].Strings['path'];
-      if not SafeRelative(Rel) then raise Exception.Create('Unsafe asset name: '+Rel);
-      Name:=Result+Rel; Url:=Files.Objects[I].Strings['url'];
-      if Pos('castle-data:/game/',Url)<>1 then raise Exception.Create('Unsupported asset URL');
-      Expected:=Files.Objects[I].Int64s['size'];
-      if not ForceDirectories(ExtractFileDir(Name)) then raise Exception.Create('Cannot create asset directory');
-      Src:=Download(Url);
-      try
-        Dst:=TFileStream.Create(Name,fmCreate);
-        try
-          Dst.CopyFrom(Src,0);
-          if Dst.Size<>Expected then raise Exception.Create('Size mismatch: '+Rel);
-          Count:=Count+Dst.Size;
-        finally Dst.Free;end;
-      finally Src.Free;end;
-    end;
-    Report.Add('assets.native_adapter','PASS',Format('%d files, %d bytes copied to native paths; formats unchanged; NOT full loader proof',[Files.Count,Count]));
-  finally Manifest.Free;end;
-end;
-end.

code/ProbeCamera.pas

@@ -1,33 +0,0 @@
-unit ProbeCamera;
-{$mode delphi}{$H+}
-{$ASSERTIONS ON}{$R+}{$Q+}{$B-}
-interface
-uses Math;
-type
- TProbeCamera = record
-  OffsetX, OffsetY, PixelsPerCell: Double;
-  procedure Reset;
-  procedure Pan(DX,DY: Double);
-  procedure ZoomAt(Factor,SX,SY: Double);
-  function CellAt(SX,SY: Double;Cols,Rows:Integer;out X,Y:Integer):Boolean;
- end;
-implementation
-procedure TProbeCamera.Reset;
-begin OffsetX:=20;OffsetY:=20;PixelsPerCell:=10;end;
-procedure TProbeCamera.Pan(DX,DY:Double);
-begin OffsetX:=OffsetX+DX;OffsetY:=OffsetY+DY;end;
-procedure TProbeCamera.ZoomAt(Factor,SX,SY:Double);
-var WX,WY,NewScale:Double;
-begin
- if (Factor<=0) or IsNan(Factor) or IsInfinite(Factor) then Exit;
- WX:=(SX-OffsetX)/PixelsPerCell;WY:=(SY-OffsetY)/PixelsPerCell;
- NewScale:=EnsureRange(PixelsPerCell*Factor,2.0,128.0);
- PixelsPerCell:=NewScale;OffsetX:=SX-WX*NewScale;OffsetY:=SY-WY*NewScale;
-end;
-function TProbeCamera.CellAt(SX,SY:Double;Cols,Rows:Integer;out X,Y:Integer):Boolean;
-begin
- X:=Floor((SX-OffsetX)/PixelsPerCell)+1;
- Y:=Rows-Floor((SY-OffsetY)/PixelsPerCell);
- Result:=(X>=1) and (X<=Cols) and (Y>=1) and (Y<=Rows);
-end;
-end.

code/ProbeDecision.pas

@@ -1,120 +0,0 @@
-unit ProbeDecision;
-{$mode objfpc}{$H+}{$codepage utf8}
-{$ifndef ANDROID}{$fatal Decision probes are Android-only}{$endif}
-interface
-uses ProbeReport;
-procedure RunDecisionChecks(Report:TProbeReport;const WorkDir:string);
-implementation
-uses Classes,SysUtils,fpjson,jsonparser,CastleDownload,CastleFilesUtils;
-procedure WriteAscii(const Name,Value:string);
-var F:TFileStream; A:AnsiString;
-begin
-  A:=AnsiString(Value);F:=TFileStream.Create(Name,fmCreate);
-  try if Length(A)>0 then F.WriteBuffer(A[1],Length(A));finally F.Free;end;
-end;
-function ReadAscii(const Name:string):string;
-var F:TFileStream; A:AnsiString;
-begin
-  Result:='';F:=TFileStream.Create(Name,fmOpenRead or fmShareDenyWrite);
-  try SetLength(A,F.Size);if Length(A)>0 then F.ReadBuffer(A[1],Length(A));Result:=string(A);finally F.Free;end;
-end;
-procedure ProbeRenameReplace(Report:TProbeReport;const WorkDir:string);
-var Target,Temp,Detail:string; Ok:Boolean;
-begin
-  Target:=WorkDir+'decision-rename-target.txt';Temp:=Target+'.tmp';
-  try
-    WriteAscii(Target,'old');WriteAscii(Temp,'new');
-    Ok:=RenameFile(Temp,Target);
-    if Ok then Ok:=(ReadAscii(Target)='new') and not FileExists(Temp);
-    Detail:='replace_existing=' + LowerCase(BoolToStr(Ok,True));
-    if (not Ok) and FileExists(Temp) then DeleteFile(Temp);
-    Report.Add('decision.persistence.rename_replace','OBSERVED',Detail);
-  except on E:Exception do
-    Report.Add('decision.persistence.rename_replace','OBSERVED','replace_existing=false; error='+E.ClassName+': '+E.Message);
-  end;
-end;
-procedure ProbeAppend(Report:TProbeReport;const WorkDir:string);
-var Name:string;F:TFileStream;A:AnsiString;Ok:Boolean;
-  procedure Append(const S:AnsiString);
-  begin
-    F:=TFileStream.Create(Name,fmOpenReadWrite or fmShareDenyNone);
-    try F.Position:=F.Size;if Length(S)>0 then F.WriteBuffer(S[1],Length(S));finally F.Free;end;
-  end;
-begin
-  Name:=WorkDir+'decision-append.log';
-  try
-    WriteAscii(Name,'A'+LineEnding);Append('B'+LineEnding);Append('C'+LineEnding);
-    A:=AnsiString(ReadAscii(Name));
-    Ok:=A=AnsiString('A'+LineEnding+'B'+LineEnding+'C'+LineEnding);
-    Report.Add('decision.persistence.append_reopen','OBSERVED',
-      'append_reopen_ordered='+LowerCase(BoolToStr(Ok,True))+'; bytes='+IntToStr(Length(A)));
-  except on E:Exception do
-    Report.Add('decision.persistence.append_reopen','OBSERVED','append_reopen_ordered=false; error='+E.ClassName+': '+E.Message);
-  end;
-end;
-function FirstAsset(out Rel,Url:string;out Expected:Int64):Boolean;
-var Manifest:TJSONData;Files:TJSONArray;
-begin
-  Result:=False;Rel:='';Url:='';Expected:=-1;
-  Manifest:=GetJSON(FileToString('castle-data:/assets-manifest.json'));
-  try
-    Files:=TJSONObject(Manifest).Arrays['files'];
-    if Files.Count=0 then Exit;
-    Rel:=Files.Objects[0].Strings['path'];
-    Url:=Files.Objects[0].Strings['url'];
-    Expected:=Files.Objects[0].Int64s['size'];
-    Result:=True;
-  finally Manifest.Free;end;
-end;
-procedure ProbeCastleStream(Report:TProbeReport);
-var S:TStream;Rel,Url:string;Expected,SizeValue:Int64;N:Integer;B:array[0..31] of Byte;SizeOk,SeekOk:Boolean;
-begin
-  if not FirstAsset(Rel,Url,Expected) then begin
-    Report.Add('decision.fixture.castle_stream','NOT_RUN','No server fixture selected; pass --assets and --asset-path');Exit;
-  end;
-  SizeOk:=False;SeekOk:=False;SizeValue:=-1;
-  try
-    S:=Download(Url);
-    try
-      try SizeValue:=S.Size;SizeOk:=SizeValue=Expected;except SizeOk:=False;end;
-      try
-        if Expected>SizeOf(B) then S.Position:=Expected div 2 else S.Position:=0;
-        N:=S.Read(B,SizeOf(B));SeekOk:=N>0;
-      except SeekOk:=False;end;
-    finally S.Free;end;
-    Report.Add('decision.fixture.castle_stream','OBSERVED',
-      Format('path=%s; expected_size=%d; size=%d; size_matches=%s; seek_read=%s',
-      [Rel,Expected,SizeValue,LowerCase(BoolToStr(SizeOk,True)),LowerCase(BoolToStr(SeekOk,True))]));
-  except on E:Exception do
-    Report.Add('decision.fixture.castle_stream','OBSERVED','path='+Rel+'; open=false; error='+E.ClassName+': '+E.Message);
-  end;
-end;
-procedure ProbeMaterialize(Report:TProbeReport;const WorkDir:string);
-var S:TStream;F:TFileStream;Rel,Url,Name:string;Expected:Int64;Ok:Boolean;
-begin
-  if not FirstAsset(Rel,Url,Expected) then begin
-    Report.Add('decision.fixture.materialized_native_path','NOT_RUN','No server fixture selected; pass --assets and --asset-path');Exit;
-  end;
-  Name:=WorkDir+'decision-materialized.dat';Ok:=False;
-  try
-    S:=Download(Url);
-    try
-      F:=TFileStream.Create(Name,fmCreate);
-      try F.CopyFrom(S,0);finally F.Free;end;
-    finally S.Free;end;
-    F:=TFileStream.Create(Name,fmOpenRead or fmShareDenyWrite);
-    try Ok:=F.Size=Expected;finally F.Free;end;
-    Report.Add('decision.fixture.materialized_native_path','OBSERVED',
-      'source='+Rel+'; supported='+LowerCase(BoolToStr(Ok,True))+'; native_path='+Name+'; bytes='+IntToStr(Expected));
-  except on E:Exception do
-    Report.Add('decision.fixture.materialized_native_path','OBSERVED','source='+Rel+'; supported=false; error='+E.ClassName+': '+E.Message);
-  end;
-end;
-procedure RunDecisionChecks(Report:TProbeReport;const WorkDir:string);
-begin
-  ProbeRenameReplace(Report,WorkDir);
-  ProbeAppend(Report,WorkDir);
-  ProbeCastleStream(Report);
-  ProbeMaterialize(Report,WorkDir);
-end;
-end.

code/ProbePlatform.pas

@@ -1,131 +0,0 @@
-unit ProbePlatform;
-{$mode objfpc}{$H+}{$codepage utf8}
-{$ifndef ANDROID}{$fatal This probe may only be compiled for Android}{$endif}
-interface
-uses Classes, SysUtils, ProbeReport;
-function ProbeDirectory: string;
-procedure RunPlatformChecks(Report: TProbeReport; const WorkDir: string);
-procedure WriteTestTone(const FileName: string);
-implementation
-uses Math, ZStream, CastleUriUtils, ProbeBuild;
-type
-  TSumThread = class(TThread)
-  public
-    Sum: Int64;
-    procedure Execute; override;
-  end;
-procedure TSumThread.Execute;
-var I: Integer;
-begin
-  Sum := 0;
-  for I := 1 to 10000 do Sum := Sum + I;
-end;
-function ProbeDirectory: string;
-begin
-  Result := UriToFilenameSafe(ResolveCastleConfigUrl('castle-config:/kam-architecture-probe/'));
-  if Result = '' then raise Exception.Create('No native path for castle-config');
-  Result := IncludeTrailingPathDelimiter(Result);
-  if not ForceDirectories(Result) then raise Exception.Create('Cannot create private probe directory');
-end;
-procedure RunPlatformChecks(Report: TProbeReport; const WorkDir: string);
-var
-  B: array[0..4095] of Byte;
-  ReadBack: array[0..4095] of Byte;
-  I: Integer; N: LongInt; LE: Cardinal;
-  Name, S: string;
-  FileStream: TFileStream;
-  Raw, Compressed: TMemoryStream;
-  C: TCompressionStream; D: TDecompressionStream;
-  W: TSumThread;
-  Counter: TStringList;
-  Launch: Integer;
-begin
-  LE := $04030201;
-  Report.Check('abi.pointer', SizeOf(Pointer) = ProbePointerBytes,
-    Format('pointer=%d integer=%d nativeint=%d extended=%d',
-      [SizeOf(Pointer),SizeOf(Integer),SizeOf(NativeInt),SizeOf(Extended)]));
-  Report.Check('abi.scalar_layout', (SizeOf(Integer)=4) and (SizeOf(Single)=4)
-    and (SizeOf(Double)=8) and (SizeOf(Int64)=8), 'Fixed-width scalar assumptions');
-  Report.Check('abi.endianness', PByte(@LE)^=1, 'Little-endian native byte order');
-  for I := 0 to High(B) do B[I] := Byte(I mod 251);
-  try
-    Name := WorkDir + 'native-I-O-тест.bin';
-    FileStream := TFileStream.Create(Name, fmCreate);
-    try FileStream.WriteBuffer(B, SizeOf(B)); finally FileStream.Free; end;
-    FillChar(ReadBack, SizeOf(ReadBack), 0);
-    FileStream := TFileStream.Create(Name, fmOpenRead or fmShareDenyWrite);
-    try
-      FileStream.Seek(1024, soBeginning);
-      FileStream.ReadBuffer(ReadBack[1024], 32);
-      Report.Check('files.seek', CompareMem(@B[1024],@ReadBack[1024],32), 'Native TFileStream seek/read');
-      FileStream.Position := 0; FileStream.ReadBuffer(ReadBack,SizeOf(ReadBack));
-      Report.Check('files.native_utf8', CompareMem(@B,@ReadBack,SizeOf(B)), 'UTF-8 path / native filename round trip');
-    finally FileStream.Free; end;
-    Name := WorkDir + 'CaseProbe.txt';
-    FileStream := TFileStream.Create(Name,fmCreate); FileStream.Free;
-    Report.Check('files.case_sensitive', not FileExists(WorkDir+'caseprobe.txt'), 'Android case-sensitive lookup; asset names must match');
-  except on E:Exception do Report.Add('files.native','FAIL',E.ClassName+': '+E.Message); end;
-  try
-    Raw := TMemoryStream.Create; Compressed := TMemoryStream.Create;
-    try
-      C := TCompressionStream.Create(clDefault, Compressed);
-      try C.WriteBuffer(B,SizeOf(B)); finally C.Free; end;
-      Compressed.Position := 0;
-      D := TDecompressionStream.Create(Compressed);
-      try
-        repeat
-          N := D.Read(ReadBack,SizeOf(ReadBack));
-          if N>0 then Raw.WriteBuffer(ReadBack,N);
-        until N=0;
-      finally D.Free; end;
-      Report.Check('fpc.zstream', (Raw.Size=SizeOf(B)) and CompareMem(Raw.Memory,@B,SizeOf(B)),
-        'Real FPC zlib stream round trip; not a KaM resource decoder test');
-    finally Raw.Free; Compressed.Free; end;
-  except on E:Exception do Report.Add('fpc.zstream','FAIL',E.ClassName+': '+E.Message); end;
-  try
-    W := TSumThread.Create(True);
-    try
-      W.FreeOnTerminate := False; W.Start; W.WaitFor;
-      Report.Check('fpc.thread',W.Sum=50005000,'Native worker thread joined; no GUI/simulation callbacks');
-    finally W.Free; end;
-  except on E:Exception do Report.Add('fpc.thread','FAIL',E.ClassName+': '+E.Message); end;
-  try
-    Counter := TStringList.Create;
-    try
-      Name := WorkDir + 'launch-counter.txt'; Launch := 1;
-      if FileExists(Name) then begin
-        Counter.LoadFromFile(Name);
-        Launch := StrToInt(Trim(Counter.Text))+1;
-      end;
-      Counter.Text := IntToStr(Launch); Counter.SaveToFile(Name);
-      S := 'launch_count='+IntToStr(Launch)+'; compare after force-stop/relaunch';
-      if Launch>1 then Report.Add('files.persisted_counter','OBSERVED',S)
-      else Report.Add('files.persisted_counter','NOT_RUN',S);
-    finally Counter.Free; end;
-  except on E:Exception do Report.Add('files.persisted_counter','FAIL',E.ClassName+': '+E.Message); end;
-end;
-procedure WriteTestTone(const FileName: string);
-const SampleRate=22050; Samples=5512;
-var F:TFileStream; I:Integer; V:SmallInt;
-  procedure U16(Value:Word);
-  var B:array[0..1] of Byte;
-  begin B[0]:=Value and 255; B[1]:=Value shr 8; F.WriteBuffer(B,2); end;
-  procedure U32(Value:Cardinal);
-  var B:array[0..3] of Byte;
-  begin B[0]:=Value and 255; B[1]:=(Value shr 8) and 255;
-    B[2]:=(Value shr 16) and 255; B[3]:=Value shr 24; F.WriteBuffer(B,4); end;
-  procedure FourCC(const S:AnsiString);
-  begin F.WriteBuffer(S[1],4); end;
-begin
-  F:=TFileStream.Create(FileName,fmCreate);
-  try
-    FourCC('RIFF');U32(36+Samples*2);FourCC('WAVE');FourCC('fmt ');
-    U32(16);U16(1);U16(1);U32(SampleRate);U32(SampleRate*2);U16(2);U16(16);
-    FourCC('data');U32(Samples*2);
-    for I:=0 to Samples-1 do begin
-      V:=Round(3000*Sin(2*Pi*440*I/SampleRate));
-      U16(Word(Integer(V) and $FFFF));
-    end;
-  finally F.Free; end;
-end;
-end.

code/ProbeReport.pas

@@ -1,78 +0,0 @@
-unit ProbeReport;
-{$mode objfpc}{$H+}{$codepage utf8}
-interface
-uses SysUtils, fpjson;
-type
-  TProbeReport = class
-  private
-    FRoot: TJSONObject;
-    FTests: TJSONArray;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    procedure Add(const Id, Status, Detail: string);
-    procedure Check(const Id: string; const Ok: Boolean; const Detail: string);
-    procedure Save(const FileName: string);
-    function Status: string;
-    property Root: TJSONObject read FRoot;
-  end;
-implementation
-uses Classes, CastleLog, ProbeBuild;
-constructor TProbeReport.Create;
-begin
-  inherited;
-  FRoot := TJSONObject.Create;
-  FRoot.Add('schema', 'kam-android-runtime/1');
-  FRoot.Add('build_id', ProbeBuildId);
-  FRoot.Add('profile', ProbeProfile);
-  FRoot.Add('cpu_expected', ProbeCpu);
-  FRoot.Add('upstream_commit', ProbeUpstreamCommit);
-  FRoot.Add('scope', 'Android architecture smoke, not a running KaM world');
-  FRoot.Add('world_simulation', 'NOT_RUN');
-  FTests := TJSONArray.Create;
-  FRoot.Add('tests', FTests);
-end;
-destructor TProbeReport.Destroy;
-begin
-  FRoot.Free;
-  inherited;
-end;
-procedure TProbeReport.Add(const Id, Status, Detail: string);
-var J: TJSONObject; I: Integer;
-begin
-  for I := FTests.Count - 1 downto 0 do
-    if FTests.Objects[I].Get('id', '') = Id then FTests.Delete(I);
-  J := TJSONObject.Create;
-  J.Add('id', Id); J.Add('status', Status); J.Add('detail', Detail);
-  FTests.Add(J);
-  WritelnLog('KaMProbe', Id + ': ' + Status + ' ' + Detail);
-end;
-procedure TProbeReport.Check(const Id: string; const Ok: Boolean; const Detail: string);
-begin
-  if Ok then Add(Id, 'PASS', Detail) else Add(Id, 'FAIL', Detail);
-end;
-function TProbeReport.Status: string;
-var I: Integer;
-begin
-  Result := 'PASS';
-  for I := 0 to FTests.Count - 1 do
-    if FTests.Objects[I].Get('status','') = 'FAIL' then Exit('FAIL');
-  { Optional NOT_RUN / OBSERVED rows do not make the automatic smoke fail.
-    They remain visible; PASS applies only to executed automatic checks. }
-end;
-procedure TProbeReport.Save(const FileName: string);
-var S: TStringList;
-begin
-  FRoot.Delete('automatic_smoke_status');
-  FRoot.Add('automatic_smoke_status', Status);
-  if not ForceDirectories(ExtractFileDir(FileName)) then
-    raise Exception.Create('Cannot create report directory');
-  S := TStringList.Create;
-  try
-    S.Text := FRoot.FormatJSON;
-    { Evidence must not depend on the filesystem behaviour measured separately
-      by decision.persistence.rename_replace. }
-    S.SaveToFile(FileName);
-  finally S.Free; end;
-end;
-end.

code/ProbeScheduling.pas

@@ -1,89 +0,0 @@
-unit ProbeScheduling;
-{$mode objfpc}{$H+}
-{$ifndef ANDROID}{$fatal Decision scheduling probe is Android-only}{$endif}
-interface
-uses Classes,ProbeReport;
-type
-  TDecisionSchedule=class
-  private
-    FReport:TProbeReport;
-    FWorker:TThread;
-    FCallbackSteps:Integer;
-    FCallbackReported,FWorkerReported:Boolean;
-    FPauses,FResumes:Integer;
-  public
-    constructor Create(AReport:TProbeReport);
-    destructor Destroy;override;
-    procedure Tick;
-    procedure Paused;
-    procedure Resumed;
-    procedure ObserveInstanceCount;
-  end;
-implementation
-uses SysUtils;
-type
-  TDecisionWorker=class(TThread)
-  public
-    Executions:Integer;
-    Sum:Int64;
-    Done:Boolean;
-    procedure Execute;override;
-  end;
-var GScheduleInstances:Integer=0;
-procedure TDecisionWorker.Execute;
-var I:Integer;
-begin
-  Inc(Executions);Sum:=0;
-  try
-    for I:=1 to 40 do begin
-      if Terminated then Exit;
-      Sum:=Sum+I;Sleep(100);
-    end;
-  finally Done:=True;end;
-end;
-constructor TDecisionSchedule.Create(AReport:TProbeReport);
-begin
-  inherited Create;FReport:=AReport;Inc(GScheduleInstances);
-  FWorker:=TDecisionWorker.Create(True);FWorker.FreeOnTerminate:=False;FWorker.Start;
-  ObserveInstanceCount;
-end;
-destructor TDecisionSchedule.Destroy;
-begin
-  if FWorker<>nil then begin
-    FWorker.Terminate;FWorker.WaitFor;FWorker.Free;
-  end;
-  inherited;
-end;
-procedure TDecisionSchedule.ObserveInstanceCount;
-begin
-  FReport.Add('decision.schedule.host_instance_count','OBSERVED','instances_in_process='+IntToStr(GScheduleInstances));
-end;
-procedure TDecisionSchedule.Tick;
-var W:TDecisionWorker;
-begin
-  if not FCallbackReported then begin
-    Inc(FCallbackSteps);
-    if FCallbackSteps>=120 then begin
-      FCallbackReported:=True;
-      FReport.Add('decision.schedule.callback_progress','OBSERVED',
-        'completed=true; steps='+IntToStr(FCallbackSteps)+'; pauses='+IntToStr(FPauses)+'; resumes='+IntToStr(FResumes));
-    end;
-  end;
-  if not FWorkerReported then begin
-    W:=TDecisionWorker(FWorker);
-    if W.Done then begin
-      W.WaitFor;FWorkerReported:=True;
-      FReport.Add('decision.schedule.worker_progress','OBSERVED',
-        'completed='+LowerCase(BoolToStr((W.Executions=1) and (W.Sum=820),True))+
-        '; executions='+IntToStr(W.Executions)+'; sum='+IntToStr(W.Sum)+
-        '; pauses='+IntToStr(FPauses)+'; resumes='+IntToStr(FResumes));
-    end;
-  end;
-end;
-procedure TDecisionSchedule.Paused;
-begin Inc(FPauses);FReport.Add('decision.schedule.lifecycle','OBSERVED',
-  'event=pause; pauses='+IntToStr(FPauses)+'; resumes='+IntToStr(FResumes));end;
-procedure TDecisionSchedule.Resumed;
-begin Inc(FResumes);ObserveInstanceCount;FReport.Add('decision.schedule.lifecycle','OBSERVED',
-  'event=resume; pauses='+IntToStr(FPauses)+'; resumes='+IntToStr(FResumes));end;
-end.

code/ProbeTextProvider.pas

@@ -1,34 +0,0 @@
-unit ProbeTextProvider;
-{$mode objfpc}{$H+}
-interface
-uses ProbeReport;
-procedure RunTextProviderChecks(Report:TProbeReport);
-implementation
-uses SysUtils;
-function ByteEqual(const S:RawByteString;const B:array of Byte):Boolean;
-var I:Integer;
-begin
-  Result:=Length(S)=Length(B);if not Result then Exit;
-  for I:=0 to High(B) do if Byte(S[I+1])<>B[I] then Exit(False);
-end;
-procedure RunTextProviderChecks(Report:TProbeReport);
-const CP1251Bytes:array[0..5] of Byte=($CF,$F0,$E8,$E2,$E5,$F2);
-var A,Back:RawByteString;U:UnicodeString;I:Integer;OkDecode,OkEncode:Boolean;
-begin
-  try
-    SetLength(A,Length(CP1251Bytes));for I:=0 to High(CP1251Bytes) do A[I+1]:=AnsiChar(CP1251Bytes[I]);
-    SetCodePage(A,1251,False);U:=UnicodeString(A);
-    OkDecode:=(Length(U)=6) and (Ord(U[1])=$041F) and (Ord(U[2])=$0440) and
-      (Ord(U[3])=$0438) and (Ord(U[4])=$0432) and (Ord(U[5])=$0435) and (Ord(U[6])=$0442);
-    Report.Add('decision.text.cp1251_decode','OBSERVED',
-      'supported='+LowerCase(BoolToStr(OkDecode,True))+'; source_codepage='+IntToStr(StringCodePage(A)));
-    Back:=UTF8Encode(U);SetCodePage(Back,1251,True);OkEncode:=ByteEqual(Back,CP1251Bytes);
-    Report.Add('decision.text.cp1251_encode','OBSERVED',
-      'supported='+LowerCase(BoolToStr(OkEncode,True))+'; result_codepage='+IntToStr(StringCodePage(Back)));
-  except on E:Exception do begin
-    Report.Add('decision.text.cp1251_decode','OBSERVED','supported=false; error='+E.ClassName+': '+E.Message);
-    Report.Add('decision.text.cp1251_encode','OBSERVED','supported=false; error='+E.ClassName+': '+E.Message);
-  end;
-end;
-end;
-end.