Complete BigTask

code/GameInitialize.pas

@@ -3,7 +3,7 @@ unit GameInitialize;
 {$ifndef ANDROID}{$fatal Android-only KaM Remake Mobile application; there is no desktop target}{$endif}
 interface
 implementation
-uses CastleWindow, GameDiagnosticsView;
+uses CastleWindow, CastleApplicationProperties, CastleGLUtils, GameDiagnosticsView, KM_GameApp_Mobile;
 var
   Window: TCastleWindow;
   DiagnosticsView: TDiagnosticsView;
@@ -11,9 +11,13 @@ procedure Initialize;
 begin
   DiagnosticsView := TDiagnosticsView.Create(Application);
   Window.Container.View := DiagnosticsView;
+  KMGameAppMobileInstallPresentation(Window.Container);
 end;
 initialization
   Application.OnInitialize := @Initialize;
+  ApplicationProperties.LimitFPS := 60;
+  TGLFeatures.RequestCapabilities := rcAutomatic;
   Window := TCastleWindow.Create(Application);
+  Window.AutoRedisplay := True;
   Application.MainWindow := Window;
 end.

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.

config/extra-paths.json

@@ -24,7 +24,8 @@
     "src/KM_Main.pas",
     "src/res/KM_Resource.pas",
     "src/common/KM_Defaults.pas",
-    "src/res/KM_ResTypes.pas"
+    "src/res/KM_ResTypes.pas",
+    "src/utils/KromOGLUtils.pas"
   ],
   "source_paths": [
     "code/resource"

port-source/kam_remake/src/KM_GameApp.pas

@@ -6,7 +6,7 @@ uses
   {$IFDEF FPC} Controls, {$ENDIF}
   Classes,
   Dialogs, SysUtils,
-  KM_CommonTypes, KM_Defaults, KM_RenderControl, KM_Video,
+  KM_CommonTypes, KM_Defaults, KM_Video,
   KM_Campaigns, KM_Game, KM_InterfaceDefaults, KM_InterfaceMainMenu, KM_InterfaceTypes, KM_Resource,
   KM_Music, KM_Maps, KM_MapTypes, KM_CampaignClasses, KM_Networking,
   KM_GameSettings,
@@ -20,6 +20,11 @@ type
   //Methods relevant to gameplay
   TKMGameApp = class
   private
+    fGraphicsGeneration: QWord;
+    fGraphicsGenerationAccepted: Boolean;
+    fGraphicsAttemptGeneration: QWord;
+    fApplicationGraphicsReadyGeneration: QWord;
+
     fGlobalTickCount: Cardinal;
     fIsExiting: Boolean;
     fIsLoading: Boolean;
@@ -66,9 +71,14 @@ type
 
     procedure InitMainMenu(aScreenX, aScreenY: Word);
     function GetActiveInterface: TKMUserInterfaceCommon;
+    procedure GraphicsContextAvailabilityChanged(aAvailable: Boolean);
+    function IsCurrentGraphicsAttempt(aCandidateGeneration: QWord): Boolean;
+    procedure ReevaluateApplicationGraphicsReadiness(aCandidateGeneration: QWord);
+    function ApplicationGraphicsReadyForCurrentGeneration: Boolean;
+    procedure RenderPresentationFrame;
 
   public
-    constructor Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
+    constructor Create(aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
                        aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc<TKMStatusBarPanel, string>; NoMusic: Boolean = False);
     destructor Destroy; override;
     procedure AfterConstruction(aReturnToOptions: Boolean); reintroduce;
@@ -172,17 +182,22 @@ uses
   KM_GameSavePoints,
   KM_Cursor, KM_ResTexts, KM_ResKeys, KM_ResTypes,
   KM_IoGraphicUtils, KM_Settings,
-  KM_Saves, KM_CommonUtils
+  KM_Saves, KM_CommonUtils, KM_GameApp_Mobile
   {$IFDEF DBG_RNG_SPY}, KM_RandomChecks{$ENDIF};
 
 
 { TKMGameApp }
 // Creating everything needed for MainMenu, game stuff is created on StartGame
-constructor TKMGameApp.Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
+constructor TKMGameApp.Create(aScreenX, aScreenY: Word; aVSync: Boolean; aOnLoadingStep: TKMEvent;
                               aOnLoadingText: TUnicodeStringEvent; aOnStatusBarUpdate: TProc<TKMStatusBarPanel, string>; NoMusic: Boolean = False);
 begin
   inherited Create;
 
+  fGraphicsGeneration := 0;
+  fGraphicsGenerationAccepted := False;
+  fGraphicsAttemptGeneration := 0;
+  fApplicationGraphicsReadyGeneration := 0;
+
   fCampaigns := TKMCampaignsCollection.Create;
 
   fOnStatusBarUpdate := aOnStatusBarUpdate;
@@ -195,7 +210,8 @@ begin
   // it makes sense to store its settings along with the game's in the shared folder
   fServerSettings := TKMServerSettings.Create(slShared);
 
-  gRender := TKMRender.Create(aRenderControl, aScreenX, aScreenY, aVSync);
+  gRender := TKMRender.Create(aScreenX, aScreenY);
+  KMGameAppMobileAttach(GraphicsContextAvailabilityChanged);
 
   fChat := TKMChat.Create;
 
@@ -238,6 +254,7 @@ begin
 
   fOnGameStart := GameStarted;
   fOnGameEnd := GameEnded;
+  KMGameAppMobileAttachPresentation(RenderPresentationFrame, Resize);
 end;
 
 
@@ -250,12 +267,87 @@ begin
 end;
 
 
+procedure TKMGameApp.GraphicsContextAvailabilityChanged(aAvailable: Boolean);
+var
+  candidateGeneration: QWord;
+begin
+  if aAvailable then
+  begin
+    if fGraphicsGeneration = High(QWord) then
+      raise Exception.Create('Graphics generation exhausted');
+
+    Inc(fGraphicsGeneration);
+    fGraphicsAttemptGeneration := fGraphicsGeneration;
+    fGraphicsGenerationAccepted := True;
+    fApplicationGraphicsReadyGeneration := 0;
+    candidateGeneration := fGraphicsAttemptGeneration;
+
+    TKMRender.GraphicsContextChanged(True);
+    if not TKMRender.TextureBackendReady then
+      raise Exception.Create('Graphics texture backend is not ready after context restore');
+
+    if (gRes <> nil) and (gRes.DataState <> rlsNone) then
+      gRes.StartGameSpriteRecovery;
+
+    ReevaluateApplicationGraphicsReadiness(candidateGeneration);
+  end
+  else
+  begin
+    fGraphicsGenerationAccepted := False;
+    fGraphicsAttemptGeneration := 0;
+    fApplicationGraphicsReadyGeneration := 0;
+
+    TKMRender.GraphicsContextChanged(False);
+  end;
+end;
+
+
+procedure TKMGameApp.ReevaluateApplicationGraphicsReadiness(aCandidateGeneration: QWord);
+begin
+  if not IsCurrentGraphicsAttempt(aCandidateGeneration) then
+    Exit;
+
+  fApplicationGraphicsReadyGeneration := 0;
+  if not TKMRender.TextureBackendReady then
+    Exit;
+  if gGame <> nil then
+  begin
+    if gRes = nil then
+      Exit;
+    if not gRes.GameResourcesReady then
+      Exit;
+  end;
+  if IsCurrentGraphicsAttempt(aCandidateGeneration) then
+    fApplicationGraphicsReadyGeneration := aCandidateGeneration;
+end;
+
+
+function TKMGameApp.ApplicationGraphicsReadyForCurrentGeneration: Boolean;
+begin
+  Result := fGraphicsGenerationAccepted
+        and (fGraphicsGeneration <> 0)
+        and (fGraphicsAttemptGeneration = fGraphicsGeneration)
+        and (fApplicationGraphicsReadyGeneration = fGraphicsGeneration);
+end;
+
+
+function TKMGameApp.IsCurrentGraphicsAttempt(aCandidateGeneration: QWord): Boolean;
+begin
+  Result := (aCandidateGeneration <> 0)
+        and fGraphicsGenerationAccepted
+        and (aCandidateGeneration = fGraphicsGeneration)
+        and (aCandidateGeneration = fGraphicsAttemptGeneration);
+end;
+
+
 { Destroy what was created }
 destructor TKMGameApp.Destroy;
 begin
   //Freeing network sockets and OpenAL can result in events like Resize/Paint occuring (seen in crash reports)
   //Set fIsExiting so we know to skip them
   fIsExiting := True;
+  KMGameAppMobileDetachPresentation;
+  KMGameAppMobileDetach;
 
   //We might have crashed part way through .Create, so we can't assume ANYTHING exists here.
   //Doing so causes a 2nd exception which overrides 1st. Hence check <> nil on everything except Free (TObject.Free does that already)
@@ -372,6 +464,12 @@ begin
 end;
 
 
+procedure TKMGameApp.RenderPresentationFrame;
+begin
+  Render(False);
+end;
+
+
 // This event happens every ~33ms if the Key is Down and holded
 procedure TKMGameApp.KeyDown(Key: Word; Shift: TShiftState; aIsFirst: Boolean);
 var
@@ -540,6 +638,8 @@ end;
 
 
 procedure TKMGameApp.CreateGame(aGameMode: TKMGameMode);
+var
+  candidateGeneration: QWord;
 begin
   //Reset controls if MainForm exists (KMR could be run without main form)
   if gMain <> nil then
@@ -550,6 +650,8 @@ begin
                           fBaseSaveWorkerThreadHolder,
                           fAutoSaveWorkerThreadHolder,
                           fSavePointWorkerThreadHolder);
+  candidateGeneration := fGraphicsAttemptGeneration;
+  ReevaluateApplicationGraphicsReadiness(candidateGeneration);
 end;
 
 
@@ -624,6 +726,8 @@ end;
 //5. Free the game object
 //6. Switch to MainMenu
 procedure TKMGameApp.StopGame(aMsg: TKMGameResultMsg; const aTextMsg: UnicodeString = '');
+var
+  candidateGeneration: QWord;
 begin
   if gGame = nil then Exit;
 
@@ -655,6 +759,8 @@ begin
   end;
 
   FreeThenNil(gGame);
+  candidateGeneration := fGraphicsAttemptGeneration;
+  ReevaluateApplicationGraphicsReadiness(candidateGeneration);
   gLog.AddTime('Gameplay ended - ' + GetEnumName(TypeInfo(TKMGameResultMsg), Integer(aMsg)) + ' /' + aTextMsg);
 end;
 
@@ -677,6 +783,8 @@ end;
 
 
 procedure TKMGameApp.StopGameReturnToLobby;
+var
+  candidateGeneration: QWord;
 begin
   if gGame = nil then Exit;
 
@@ -692,6 +800,8 @@ begin
     fOnGameEnd(gGame.Params.Mode);
 
   FreeThenNil(gGame);
+  candidateGeneration := fGraphicsAttemptGeneration;
+  ReevaluateApplicationGraphicsReadiness(candidateGeneration);
 
   fNetworking.ReturnToLobby; //Clears gGame event pointers from Networking
   fMainMenuInterface.ReturnToLobby(RETURN_TO_LOBBY_SAVE); //Assigns Lobby event pointers to Networking and selects map
@@ -1224,7 +1334,7 @@ begin
   if Self = nil then Exit;
   if SKIP_RENDER then Exit;
   if fIsExiting then Exit;
-  if gRender.Blind then Exit;
+  if not ApplicationGraphicsReadyForCurrentGeneration then Exit;
   if fIsLoading then Exit; //Don't render while toggling locale
 
   gRender.BeginFrame;
@@ -1239,7 +1349,6 @@ begin
 
   gRender.RenderBrightness(gGameSettings.GFX.Brightness);
 
-  gRender.EndFrame;
   gRender.Query.QueriesSwapBuffers;
 
   if not aForPrintScreen
@@ -1393,12 +1502,20 @@ end;
 
 // This is our real-time "thread", use it wisely
 procedure TKMGameApp.UpdateStateIdle(aFrameTime: Cardinal);
+var
+  candidateGeneration: QWord;
 begin
   if gGame <> nil then gGame.UpdateStateIdle(aFrameTime);
   if gMusic <> nil then gMusic.UpdateStateIdle;
   if gSoundPlayer <> nil then gSoundPlayer.UpdateStateIdle;
   if fNetworking <> nil then fNetworking.UpdateStateIdle;
-  if gRes <> nil then gRes.UpdateStateIdle;
+  candidateGeneration := fGraphicsAttemptGeneration;
+  try
+    if gRes <> nil then
+      gRes.UpdateStateIdle;
+  finally
+    ReevaluateApplicationGraphicsReadiness(candidateGeneration);
+  end;
 end;
 
 

port-source/kam_remake/src/render/KM_Render.pas

@@ -5,7 +5,7 @@ uses
   {$IFDEF WDC} Windows, {$ENDIF}
   {$IFDEF Unix} LCLIntf, LCLType, OpenGLContext, {$ENDIF}
   dglOpenGL,
-  KM_RenderControl, KM_RenderQuery, KM_RenderTypes, KM_CommonTypes;
+  KM_RenderQuery, KM_RenderTypes, KM_CommonTypes;
 
 
 const
@@ -25,17 +25,15 @@ type
     fFBO: Cardinal;
     fRenderBuf: Cardinal;
 
-    fRenderControl: TKMRenderControl;
     fOpenGL_Vendor, fOpenGL_Renderer, fOpenGL_Version: UnicodeString;
     fScreenX, fScreenY: Word;
-    fBlind: Boolean;
     fQuery: TKMRenderQuery;
 
     procedure InitFBO;
     procedure SaveBufferToFile(aUseFBOBuffer: Boolean; var aWidth, aHeight: Integer; var aPixelData: TKMCardinalArray);
     function GetMaxFBOSize: Cardinal;
   public
-    constructor Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Integer; aVSync: Boolean);
+    constructor Create(aScreenX, aScreenY: Integer);
     destructor Destroy; override;
 
     procedure SetRenderMode(aRenderMode: TKMRenderMode); //Switch between 2D and 3D perspectives
@@ -64,13 +62,10 @@ type
 
     property ScreenX: Word read fScreenX;
     property ScreenY: Word read fScreenY;
-    property Blind: Boolean read fBlind;
-
     property Query: TKMRenderQuery read fQuery;
 
     procedure BeginFrame;
     procedure RenderBrightness(aValue: Byte);
-    procedure EndFrame;
   end;
 
 var
@@ -91,22 +86,17 @@ const
   MAX_FBO_BUFFER_SIZE = CELL_SIZE_PX * (MAX_MAP_SIZE - 1); // (10200 = CELL_SIZE=40px)*255
 
 { TKMRender }
-constructor TKMRender.Create(aRenderControl: TKMRenderControl; aScreenX, aScreenY: Integer; aVSync: Boolean);
+constructor TKMRender.Create(aScreenX, aScreenY: Integer);
 begin
   inherited Create;
 
   gLog.AddTime('Init Render started');
 
   fFBOInited := False;
-  fBlind := aRenderControl = nil;
-  fRenderControl := aRenderControl;
-
   if not fBlind then
   begin
     fQuery := TKMRenderQuery.Create;
 
-    fRenderControl.CreateRenderContext;
-
     fMaxViewportDim := GetMaxViewportDim;
     gLog.AddTime('GL_MAX_VIEWPORT_DIM = ' + IntToStr(fMaxViewportDim));
 
@@ -129,10 +119,8 @@ begin
     fOpenGL_Renderer := UnicodeString(glGetString(GL_RENDERER)); gLog.AddNoTime('OpenGL Renderer: ' + fOpenGL_Renderer);
     fOpenGL_Version  := UnicodeString(glGetString(GL_VERSION));  gLog.AddNoTime('OpenGL Version: '  + fOpenGL_Version);
 
-    SetupVSync(aVSync);
-
-    Resize(aScreenX, aScreenY);
   end;
+  Resize(aScreenX, aScreenY);
   gLog.AddTime('Init Render Done');
 end;
 
@@ -141,7 +129,6 @@ destructor TKMRender.Destroy;
 begin
   if not fBlind then
   begin
-    fRenderControl.DestroyRenderContext;
     fQuery.Free;
 
     if fFBOInited then
@@ -189,11 +176,8 @@ end;
 
 procedure TKMRender.Resize(aWidth, aHeight: Integer);
 begin
-  if fBlind then Exit;
-
   fScreenX := max(aWidth, 1);
   fScreenY := max(aHeight, 1);
-  glViewport(0, 0, fScreenX, fScreenY);
 end;
 
 
@@ -383,13 +367,4 @@ begin
 end;
 
 
-procedure TKMRender.EndFrame;
-begin
-  if fBlind then Exit;
-
-  glFinish;
-  fRenderControl.SwapBuffers;
-end;
-
-
 end.

port-source/kam_remake/src/utils/KromOGLUtils.pas

@@ -0,0 +1,275 @@
+unit KromOGLUtils;
+{$I KaM_Remake.inc}
+interface
+uses
+  dglOpenGL,
+  {$IFDEF FPC} GL, LCLIntf, {$ENDIF}
+  {$IFDEF MSWindows} Windows {$ENDIF}
+  {$IFDEF Unix} LCLType, glx, x, xlib, xutil {$ENDIF}
+  ;
+
+{$IFDEF Unix}
+type HGLRC = Integer;
+type PFD_DRAW_TO_WINDOW = Integer;
+type PFD_SUPPORT_OPENGL = Integer;
+type PFD_DOUBLEBUFFER = Integer;
+type PFD_TYPE_RGBA = Integer;
+type PFD_MAIN_PLANE = Integer;
+{$ENDIF}
+
+type
+  TColor4 = Cardinal;
+  TTexture = record Tex: Cardinal; U, V: Single; end;
+
+  procedure SetRenderFrame(RenderFrame: HWND; out h_DC: HDC; out h_RC: HGLRC);
+  procedure SetRenderFrameAA(DummyFrame, RenderFrame: HWND; AntiAliasing: Byte; out h_DC: HDC; out h_RC: HGLRC);
+
+  procedure BuildFont(h_DC: HDC; FontSize: Integer; FontWeight: Word = FW_NORMAL);
+  procedure glPrint(const text: AnsiString);
+  procedure glkScale(x: Single);
+  procedure glkQuad(Ax, Ay, Bx, By, Cx, Cy, Dx, Dy: Single);
+  procedure glkRect(Ax, Ay, Bx, By: Single);
+
+
+implementation
+
+
+function SetDCPixelFormat(h_DC: HDC; PixelFormat: Integer): Boolean;
+var
+  nPixelFormat: Integer;
+  PixelDepth: Integer;
+  {$IFDEF MSWINDOWS}
+  pfd: TPixelFormatDescriptor;
+  {$ENDIF}
+begin
+  PixelDepth := 32; //32bpp is common
+  {$IFDEF MSWINDOWS}
+  with pfd do begin
+    nSize           := SizeOf(TPIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
+    nVersion        := 1;                    // The version of this data structure
+    dwFlags         := PFD_DRAW_TO_WINDOW    // Buffer supports drawing to window
+                       or PFD_SUPPORT_OPENGL // Buffer supports OpenGL drawing
+                       or PFD_DOUBLEBUFFER;  // Supports double buffering
+    iPixelType      := PFD_TYPE_RGBA;        // RGBA color format
+    cColorBits      := PixelDepth;           // OpenGL color depth
+    cRedBits        := 0;                    // Number of red bitplanes
+    cRedShift       := 0;                    // Shift count for red bitplanes
+    cGreenBits      := 0;                    // Number of green bitplanes
+    cGreenShift     := 0;                    // Shift count for green bitplanes
+    cBlueBits       := 0;                    // Number of blue bitplanes
+    cBlueShift      := 0;                    // Shift count for blue bitplanes
+    cAlphaBits      := 0;                    // Not supported
+    cAlphaShift     := 0;                    // Not supported
+    cAccumBits      := 0;                    // No accumulation buffer
+    cAccumRedBits   := 0;                    // Number of red bits in a-buffer
+    cAccumGreenBits := 0;                    // Number of green bits in a-buffer
+    cAccumBlueBits  := 0;                    // Number of blue bits in a-buffer
+    cAccumAlphaBits := 0;                    // Number of alpha bits in a-buffer
+    cDepthBits      := 16;                   // Specifies the depth of the depth buffer
+    cStencilBits    := 8;                    // Turn off stencil buffer
+    cAuxBuffers     := 0;                    // Not supported
+    iLayerType      := PFD_MAIN_PLANE;       // Ignored
+    bReserved       := 0;                    // Number of overlay and underlay planes
+    dwLayerMask     := 0;                    // Ignored
+    dwVisibleMask   := 0;                    // Transparent color of underlay plane
+    dwDamageMask    := 0;                    // Ignored
+  end;
+
+  if PixelFormat = 0 then
+    nPixelFormat := ChoosePixelFormat(h_DC, @pfd)
+  else
+    nPixelFormat := PixelFormat;
+
+  if nPixelFormat = 0 then begin
+    MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
+    Result := False;
+    Exit;
+  end;
+
+  //Even with known pixel format we still need to supply some PFD structure
+  if not SetPixelFormat(h_DC, nPixelFormat, @pfd) then begin
+    MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
+    Result := False;
+    Exit;
+  end;
+
+  Result := True;
+  {$ENDIF}
+  //glXChooseVisual() should be on Uni insted of ChoosePixelFormatx
+end;
+
+
+function GetMultisamplePixelFormat(h_DC: HDC; AntiAliasing: Byte): Integer;
+var
+  pixelFormat: Integer;
+  ValidFormat: Boolean;
+  NumFormats: GLUint;
+  iAttributes: array of GLint;
+begin
+  Result := 0;
+  {$IFDEF MSWINDOWS}
+  if not WGL_ARB_multisample or not Assigned(wglChoosePixelFormatARB) then
+    Exit;
+ {$ENDIF}
+  SetLength(iAttributes,21);
+  iAttributes[0] := WGL_DRAW_TO_WINDOW_ARB;
+  iAttributes[1] := 1;
+  iAttributes[2] := WGL_SUPPORT_OPENGL_ARB;
+  iAttributes[3] := 1;
+  iAttributes[4] := WGL_ACCELERATION_ARB;
+  iAttributes[5] := WGL_FULL_ACCELERATION_ARB;
+  iAttributes[6] := WGL_COLOR_BITS_ARB;
+  iAttributes[7] := 24;
+  iAttributes[8] := WGL_ALPHA_BITS_ARB;
+  iAttributes[9] := 8;
+  iAttributes[10] := WGL_DEPTH_BITS_ARB;
+  iAttributes[11] := 16;
+  iAttributes[12] := WGL_STENCIL_BITS_ARB;
+  iAttributes[13] := 0;
+  iAttributes[14] := WGL_DOUBLE_BUFFER_ARB;
+  iAttributes[15] := 1;
+  iAttributes[16] := WGL_SAMPLE_BUFFERS_ARB;
+  iAttributes[17] := 1;
+  iAttributes[18] := WGL_SAMPLES_ARB;
+  iAttributes[19] := AntiAliasing;
+  iAttributes[20] := 0;
+
+  //Try to find mode with slightly worse AA before giving up
+  repeat
+    iAttributes[19] := AntiAliasing;
+    {$IFDEF MSWINDOWS}
+    ValidFormat := wglChoosePixelFormatARB(h_dc, @iAttributes[0], nil, 1, @pixelFormat, @NumFormats);
+    {$ENDIF}
+    if ValidFormat and (NumFormats >= 1) then
+    begin
+      Result := pixelFormat;
+      Exit;
+    end;
+    AntiAliasing := AntiAliasing div 2;
+  until(AntiAliasing < 2);
+end;
+
+
+procedure SetContexts(RenderFrame: HWND; PixelFormat: Integer; out h_DC: HDC; out h_RC: HGLRC);
+begin
+  {$IFDEF MSWINDOWS}
+  h_DC := GetDC(RenderFrame);
+
+  if h_DC = 0 then
+  begin
+    MessageBox(HWND(nil), 'Unable to get a device context', 'Error', MB_OK or MB_ICONERROR);
+    Exit;
+  end;
+
+  if not SetDCPixelFormat(h_DC, PixelFormat) then
+    Exit;
+
+  h_RC := wglCreateContext(h_DC);
+  if h_RC = 0 then
+  begin
+    MessageBox(HWND(nil), 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
+    Exit;
+  end;
+
+  if not wglMakeCurrent(h_DC, h_RC) then
+
+  begin
+    MessageBox(HWND(nil), 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
+    Exit;
+  end;
+  {$ENDIF}
+end;
+
+
+procedure SetRenderFrame(RenderFrame: HWND; out h_DC: HDC; out h_RC: HGLRC);
+begin
+  InitOpenGL;
+  SetContexts(RenderFrame, 0, h_DC, h_RC);
+  ReadExtensions;
+  ReadImplementationProperties;
+end;
+
+
+{The key problem is this: the function we use to get WGL extensions is, itself, an OpenGL extension.
+Thus like any OpenGL function, it requires an OpenGL context to call it. So in order to get the
+functions we need to create a context, we have to... create a context.
+
+Fortunately, this context does not need to be our final context. All we need to do is create a dummy
+context to get function pointers, then use those functions directly. Unfortunately, Windows does not
+allow recreation of a rendering context within a single HWND. We must destroy previous HWND context
+and create final HWND context after we are finished with the dummy context.}
+procedure SetRenderFrameAA(DummyFrame, RenderFrame: HWND; AntiAliasing: Byte; out h_DC: HDC; out h_RC: HGLRC);
+var
+  PixelFormat: Integer;
+begin
+  InitOpenGL;
+  SetContexts(DummyFrame, 0, h_DC, h_RC);
+  ReadExtensions;
+  ReadImplementationProperties;
+
+  PixelFormat := GetMultisamplePixelFormat(h_DC, AntiAliasing);
+  {$IFDEF MSWINDOWS}
+  wglMakeCurrent(h_DC, 0);
+  wglDeleteContext(h_RC);
+  {$ENDIF}
+  SetContexts(RenderFrame, PixelFormat, h_DC, h_RC);
+  ReadExtensions;
+  ReadImplementationProperties;
+end;
+
+
+procedure BuildFont(h_DC: HDC; FontSize: Integer; FontWeight: Word = FW_NORMAL);
+var
+  Font: HFONT;
+begin
+//New parameter FontSize=16
+  font:=CreateFont(-abs(FontSize),0,0,0,FontWeight,0,0,0,ANSI_CHARSET,
+    OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,
+    ANTIALIASED_QUALITY,FF_DONTCARE or DEFAULT_PITCH,
+    'Terminal');
+  SelectObject(h_dc,font);
+  {$IFDEF MSWindows}
+  wglUseFontBitmaps(h_dc,0,128,20000);
+  {$ENDIF}
+  {$IFDEF Unix}
+  // Emulate these functions (with freetype we should be able to code a multi platform solution)
+  {$ENDIF}
+end;
+
+
+procedure glPrint(const text: AnsiString);
+begin
+  if text = '' then Exit;
+  glPushAttrib(GL_LIST_BIT);
+  glListBase(20000);
+  glCallLists(length(text),GL_UNSIGNED_BYTE,Pchar(@text[1]));
+  glPopAttrib;
+end;
+
+
+procedure glkScale(x: Single);
+begin
+  glScalef(x, x, x);
+end;
+
+
+procedure glkQuad(Ax, Ay, Bx, By, Cx, Cy, Dx, Dy: Single);
+begin
+  glvertex2f(Ax, Ay);
+  glvertex2f(Bx, By);
+  glvertex2f(Cx, Cy);
+  glvertex2f(Dx, Dy);
+end;
+
+
+//Same as glkQuad, but requires on TopLeft and BottomRight coords
+procedure glkRect(Ax, Ay, Bx, By: Single);
+begin
+  glvertex2f(Ax, Ay);
+  glvertex2f(Bx, Ay);
+  glvertex2f(Bx, By);
+  glvertex2f(Ax, By);
+end;
+
+
+end.