Complete BigTask

code/KM_GameApp_Mobile.pas

@@ -0,0 +1,228 @@
+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.