kam-mobile/code/GameViewMain.pas

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.