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.