kam-mobile/code/KM_GameApp_Mobile.pas

unit KM_GameApp_Mobile;

interface

uses
  CastleUIControls;

type
  TKMGraphicsContextAvailabilityEvent = procedure(aAvailable: Boolean) of object;
  TKMGamePresentationFrameEvent = procedure of object;
  TKMGamePresentationResizeEvent = procedure(aWidth, aHeight: Integer) of object;

procedure KMGameAppMobileAttach(
  const aOnGraphicsContextAvailability: TKMGraphicsContextAvailabilityEvent);
procedure KMGameAppMobileDetach;
procedure KMGameAppMobileInstallPresentation(const aContainer: TCastleContainer);
procedure KMGameAppMobileAttachPresentation(
  const aOnFrame: TKMGamePresentationFrameEvent;
  const aOnResize: TKMGamePresentationResizeEvent);
procedure KMGameAppMobileDetachPresentation;

implementation

uses
  SysUtils, CastleApplicationProperties, CastleGLVersion,
  CastleGLUtils, CastleWindow;

type
  TKMGamePresentationControl = class(TCastleUserInterface)
  public
    procedure Render; override;
    procedure Resize; override;
  end;

var
  gOnGraphicsContextAvailability: TKMGraphicsContextAvailabilityEvent;
  gRegistrationActive: Boolean;
  gDeliveryKnown: Boolean;
  gLastDelivered: Boolean;
  gPresentationControl: TKMGamePresentationControl;
  gPresentationOnFrame: TKMGamePresentationFrameEvent;
  gPresentationOnResize: TKMGamePresentationResizeEvent;


procedure TKMGamePresentationControl.Render;
begin
  if Assigned(gPresentationOnFrame) then
    gPresentationOnFrame;
end;


procedure TKMGamePresentationControl.Resize;
begin
  if not Assigned(gPresentationOnResize) then
    Exit;
  if Container = nil then
    raise Exception.Create('Mobile presentation control has no container');
  gPresentationOnResize(Container.PixelsWidth, Container.PixelsHeight);
end;


procedure KMGameAppMobileInstallPresentation(const aContainer: TCastleContainer);
var
  control: TKMGamePresentationControl;
begin
  if aContainer = nil then
    raise Exception.Create('Mobile presentation container is nil');
  if gPresentationControl <> nil then
    raise Exception.Create('Mobile presentation control is already installed');

  control := TKMGamePresentationControl.Create(aContainer);
  try
    control.FullSize := True;
    aContainer.Controls.InsertBack(control);
    gPresentationControl := control;
  except
    control.Free;
    raise;
  end;
end;


procedure KMGameAppMobileAttachPresentation(
  const aOnFrame: TKMGamePresentationFrameEvent;
  const aOnResize: TKMGamePresentationResizeEvent);
begin
  if gPresentationControl = nil then
    raise Exception.Create('Mobile presentation control is not installed');
  if not Assigned(aOnFrame) then
    raise Exception.Create('Mobile presentation frame callback is nil');
  if not Assigned(aOnResize) then
    raise Exception.Create('Mobile presentation resize callback is nil');
  if Assigned(gPresentationOnFrame) or Assigned(gPresentationOnResize) then
    raise Exception.Create('Mobile presentation already has an owner');

  gPresentationOnFrame := aOnFrame;
  gPresentationOnResize := aOnResize;
end;


procedure KMGameAppMobileDetachPresentation;
begin
  gPresentationOnFrame := nil;
  gPresentationOnResize := nil;
end;


procedure DeliverAvailability(aAvailable: Boolean);
begin
  if not Assigned(gOnGraphicsContextAvailability) then
    raise Exception.Create('Mobile graphics lifecycle has no attached owner');
  if gDeliveryKnown and (gLastDelivered = aAvailable) then
    Exit;

  gOnGraphicsContextAvailability(aAvailable);
  gLastDelivered := aAvailable;
  gDeliveryKnown := True;
end;


procedure TerminateForUnsupportedGraphics(const aMessage: string);
begin
  try
    if (Application <> nil) and (Application.MainWindow <> nil) then
      Application.MainWindow.MessageOK(aMessage, mtError);
  finally
    Halt(1);
  end;
end;


procedure AcceptOpenedContext;
begin
  if (GLVersion = nil) or (GLFeatures = nil) then
    TerminateForUnsupportedGraphics(
      'KaM Remake Mobile requires OpenGL ES 3.0 or newer.' + LineEnding +
      'Graphics capability information is unavailable.');

  if not GLFeatures.VersionES_3_0 then
    TerminateForUnsupportedGraphics(
      'KaM Remake Mobile requires OpenGL ES 3.0 or newer.' + LineEnding +
      'Detected graphics context: ' + GLVersion.VersionString + '.');

  DeliverAvailability(True);
end;


procedure CastleContextOpen;
begin
  AcceptOpenedContext;
end;


procedure CastleContextClose;
begin
  DeliverAvailability(False);
end;


procedure KMGameAppMobileAttach(
  const aOnGraphicsContextAvailability: TKMGraphicsContextAvailabilityEvent);
var
  openAdded, closeAdded: Boolean;
begin
  if not Assigned(aOnGraphicsContextAvailability) then
    raise Exception.Create('Mobile graphics lifecycle owner callback is nil');
  if Assigned(gOnGraphicsContextAvailability) then
    raise Exception.Create('Mobile graphics lifecycle already has an owner');

  gOnGraphicsContextAvailability := aOnGraphicsContextAvailability;
  openAdded := False;
  closeAdded := False;
  try
    ApplicationProperties.OnGLContextOpen.Add(@CastleContextOpen);
    openAdded := True;
    ApplicationProperties.OnGLContextClose.Add(@CastleContextClose);
    closeAdded := True;
    gRegistrationActive := True;

    if ApplicationProperties.IsGLContextOpen then
      AcceptOpenedContext;
  except
    try
      if ApplicationProperties(False) <> nil then
      begin
        if openAdded then
          try
            ApplicationProperties(False).OnGLContextOpen.Remove(@CastleContextOpen);
          except
            { Continue rolling back the other registration. }
          end;
        if closeAdded then
          try
            ApplicationProperties(False).OnGLContextClose.Remove(@CastleContextClose);
          except
            { Preserve the exception that caused attachment rollback. }
          end;
      end;
    except
      { Preserve the exception that caused attachment rollback. }
    end;
    gRegistrationActive := False;
    gOnGraphicsContextAvailability := nil;
    gDeliveryKnown := False;
    gLastDelivered := False;
    raise;
  end;
end;


procedure KMGameAppMobileDetach;
begin
  try
    if gRegistrationActive and (ApplicationProperties(False) <> nil) then
      try
        ApplicationProperties(False).OnGLContextOpen.Remove(@CastleContextOpen);
      finally
        ApplicationProperties(False).OnGLContextClose.Remove(@CastleContextClose);
      end;
  finally
    gRegistrationActive := False;
    gOnGraphicsContextAvailability := nil;
    gDeliveryKnown := False;
    gLastDelivered := False;
  end;
end;

end.