opengl: Adds support to Option ocoMacRetinaMode, to support higher quality in retina displays

git-svn-id: trunk@55354 -

components/opengl/glcarbonaglcontext.pas

@@ -21,7 +21,7 @@ uses
   WSLCLClasses, CarbonUtils,
   Controls;
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 procedure LOpenGLSwapBuffers(Handle: HWND);
 function LOpenGLMakeCurrent(Handle: HWND): boolean;
 function LOpenGLReleaseContext(Handle: HWND): boolean;
@@ -57,7 +57,7 @@ function GetAGLContext(Control: ControlRef): TAGLContext;
 
 implementation
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 begin
   glViewport(Left,Top,Width,Height);
 end;

components/opengl/glcocoanscontext.pas

@@ -27,14 +27,16 @@ uses
   Classes, SysUtils, types, CocoaWSCommon, CocoaPrivate, CocoaUtils, LCLType,
   Controls, LazLoggerBase, WSLCLClasses, gl, MacOSAll, CocoaAll;
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+function LBackingScaleFactor(Handle: HWND): single;
+procedure LSetWantsBestResolutionOpenGLSurface(const AValue: boolean; Handle: HWND);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 procedure LOpenGLSwapBuffers(Handle: HWND);
 function LOpenGLMakeCurrent(Handle: HWND): boolean;
 function LOpenGLReleaseContext(Handle: HWND): boolean;
 procedure LOpenGLClip(Handle: HWND);
 function LOpenGLCreateContext(AWinControl: TWinControl;
               {%H-}WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
-              DoubleBuffered: boolean;
+              DoubleBuffered, AMacRetinaMode: boolean;
               MajorVersion, MinorVersion: Cardinal;
               MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
               const {%H-}AParams: TCreateParams): HWND;
@@ -52,6 +54,12 @@ const
   NSOpenGLProfileVersion4_1Core = $4100; //requires OSX SDK 10.10 or later, https://github.com/google/gxui/issues/98
 
 type
+  NSOpenGLViewFix = objccategory external (NSOpenGLView)
+    procedure setWantsBestResolutionOpenGLSurface(bool: NSInteger); message 'setWantsBestResolutionOpenGLSurface:';
+  end;
+  NSScreenFix = objccategory external (NSScreen)
+     function backingScaleFactor: CGFloat ; message 'backingScaleFactor';
+  end;
   TDummyNoWarnObjCNotUsed = objc.BOOL;
   TDummyNoWarnObjCBaseNotUsed = objcbase.NSInteger;
 
@@ -62,6 +70,7 @@ type
     Owner: TWinControl;
     //nsGL: NSOpenGLContext;
     callback: TLCLCommonCallback;
+    backingScaleFactor: Single;
     function acceptsFirstResponder: Boolean; override;
     function becomeFirstResponder: Boolean; override;
     function resignFirstResponder: Boolean; override;
@@ -102,9 +111,42 @@ function IsCGLPixelFormatAvailable(Attribs: PInteger): boolean;*)
 
 implementation
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+//value > 1 if screen is scaled, e.g. default for MOST retina displays is 2
+function LBackingScaleFactor(Handle: HWND): single;
 begin
-  glViewport(Left,Top,Width,Height);
+  result := TCocoaOpenGLView(Handle).backingScaleFactor;
+end;
+
+procedure LSetWantsBestResolutionOpenGLSurface(const AValue: boolean; Handle: HWND);
+var
+  View: TCocoaOpenGLView;
+begin
+  if Handle=0 then exit;
+  View:=TCocoaOpenGLView(Handle);
+  if not View.respondsToSelector(objcselector('setWantsBestResolutionOpenGLSurface:')) then exit;
+  if AValue then
+    View.setWantsBestResolutionOpenGLSurface(1)
+  else
+    View.setWantsBestResolutionOpenGLSurface(0);
+  if (AValue) and (NSScreen.mainScreen.respondsToSelector(objcselector('backingScaleFactor'))) then //MacOS >=10.7
+    View.backingScaleFactor := NSScreen.mainScreen.backingScaleFactor
+  else
+    View.backingScaleFactor := 1;
+end;
+
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
+var
+  View: NSOpenGLView absolute Handle;
+  lFinalWidth, lFinalHeight: Integer;
+begin
+  lFinalWidth := Width;
+  lFinalHeight := Height;
+  if View <> nil then
+  begin
+    lFinalWidth := Round(Width * LBackingScaleFactor(Handle));
+    lFinalHeight := Round(Height * LBackingScaleFactor(Handle));
+  end;
+  glViewport(Left,Top,lFinalWidth,lFinalHeight);
 end;
 
 procedure LOpenGLSwapBuffers(Handle: HWND);
@@ -140,7 +182,8 @@ begin
 end;
 
 function LOpenGLCreateContext(AWinControl: TWinControl;
-  WSPrivate: TWSPrivateClass; SharedControl: TWinControl; DoubleBuffered: boolean;
+  WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
+  DoubleBuffered, AMacRetinaMode: boolean;
   MajorVersion, MinorVersion: Cardinal;
   MultiSampling, AlphaBits, DepthBits, StencilBits,
   AUXBuffers: Cardinal; const AParams: TCreateParams): HWND;
@@ -180,6 +223,7 @@ begin
   View.Owner:=AWinControl;
   //View.nsGL := aNSOpenGLContext;
   View.callback:=TLCLCommonCallback.Create(View, AWinControl);
+  LSetWantsBestResolutionOpenGLSurface(AMacRetinaMode, HWND(View));
   //View.setPixelFormat(PixFmt);
   Result:=TLCLIntfHandle(View);
 end;
@@ -268,6 +312,7 @@ begin
   if OpenGLControlHandle=0 then exit;
   View:=TCocoaOpenGLView(OpenGLControlHandle);
   Result:=CGLContextObj(View.openGLContext.CGLContextObj);
+  NSScreen.mainScreen.colorSpace;
 end;
 
 (*

components/opengl/glgtkglxcontext.pas

@@ -107,7 +107,7 @@ function gdk_x11_get_default_xdisplay:PDisplay;cdecl;external;
 function gdk_x11_get_default_screen:gint;cdecl;external;
 {$ENDIF}
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 procedure LOpenGLSwapBuffers(Handle: HWND);
 function LOpenGLMakeCurrent(Handle: HWND): boolean;
 function LOpenGLReleaseContext({%H-}Handle: HWND): boolean;
@@ -768,7 +768,7 @@ begin
   gdk_gl_swap_buffers(GTK_WIDGET(gl_area)^.window);
 end;
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 begin
   glViewport(Left,Top,Width,Height);
 end;

components/opengl/glqtcontext.pas

@@ -59,7 +59,7 @@ const
 type
   TGLXContext = pointer;
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 procedure LOpenGLSwapBuffers(Handle: HWND);
 function LOpenGLMakeCurrent(Handle: HWND): boolean;
 function LOpenGLReleaseContext(Handle: HWND): boolean;
@@ -123,7 +123,7 @@ begin
   result:=QWidget_winID(Widget);
 end;
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 begin
   glViewport(Left,Top,Width,Height);
 end;

components/opengl/glwin32wglcontext.pas

@@ -17,7 +17,7 @@ uses
   Classes, SysUtils, LMessages, Windows, LCLProc, LCLType, gl, Forms, Controls, 
   Win32Int, WSLCLClasses, WSControls, Win32WSControls, Win32Proc, LCLMessageGlue;
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 procedure LOpenGLSwapBuffers(Handle: HWND);
 function LOpenGLMakeCurrent(Handle: HWND): boolean;
 function LOpenGLReleaseContext(Handle: HWND): boolean;
@@ -230,7 +230,7 @@ begin
   Result := wglGetProcAddress(ProcName);
 end;
 
-procedure LOpenGLViewport(Left, Top, Width, Height: integer);
+procedure LOpenGLViewport(Handle: HWND; Left, Top, Width, Height: integer);
 begin
   glViewport(Left,Top,Width,Height);
 end;

components/opengl/openglcontext.pas

@@ -52,6 +52,7 @@ unit OpenGLContext;
   {$DEFINE UseCocoaNS}
   {$DEFINE UsesModernGL}
   {$DEFINE OpenGLTargetDefined}
+  {$DEFINE HasMacRetinaMode}
 {$ENDIF}
 {$IFDEF LCLWin32}
   {$DEFINE UseWin32WGL}
@@ -102,6 +103,9 @@ type
   TOpenGlCtrlMakeCurrentEvent = procedure(Sender: TObject;
                                           var Allow: boolean) of object;
 
+  TOpenGLControlOption = (ocoMacRetinaMode);
+  TOpenGLControlOptions = set of TOpenGLControlOption;
+
   { TCustomOpenGLControl }
   { Sharing:
     You can share opengl contexts. For example:
@@ -136,12 +140,14 @@ type
     FMultiSampling, FAlphaBits, FDepthBits, FStencilBits, FAUXBuffers: Cardinal;
     FSharedOpenGLControl: TCustomOpenGLControl;
     FSharingOpenGlControls: TList;
+    FOptions: TOpenGLControlOptions;
     function GetSharingControls(Index: integer): TCustomOpenGLControl;
     procedure SetAutoResizeViewport(const AValue: boolean);
     procedure SetDebugContext(AValue: boolean);
     procedure SetDoubleBuffered(const AValue: boolean);
     procedure SetOpenGLMajorVersion(AValue: Cardinal);
     procedure SetOpenGLMinorVersion(AValue: Cardinal);
+    procedure SetOptions(AValue: TOpenGLControlOptions);
     procedure SetRGBA(const AValue: boolean);
     {$IFDEF HasRGBBits}
     procedure SetRedBits(const AValue: Cardinal);
@@ -209,6 +215,7 @@ type
     property DepthBits: Cardinal read FDepthBits write SetDepthBits default DefaultDepthBits;
     property StencilBits: Cardinal read FStencilBits write SetStencilBits default 0;
     property AUXBuffers: Cardinal read FAUXBuffers write SetAUXBuffers default 0;
+    property Options: TOpenGLControlOptions read FOptions write SetOptions;
   end;
 
   { TOpenGLControl }
@@ -302,7 +309,7 @@ begin
   and ([csLoading,csDestroying]*ComponentState=[])
   and IsVisible and HandleAllocated
   and MakeCurrent then
-    LOpenGLViewport(0,0,Width,Height);
+    LOpenGLViewport(Handle,0,0,Width,Height);
 end;
 
 procedure TCustomOpenGLControl.SetDebugContext(AValue: boolean);
@@ -331,6 +338,13 @@ begin
   fOpenGLMinorVersion:=AValue;
 end;
 
+procedure TCustomOpenGLControl.SetOptions(AValue: TOpenGLControlOptions);
+begin
+  if FOptions=AValue then Exit;
+  FOptions:=AValue;
+  OpenGLAttributesChanged();
+end;
+
 procedure TCustomOpenGLControl.SetRGBA(const AValue: boolean);
 begin
   if FRGBA=AValue then exit;
@@ -520,14 +534,14 @@ begin
   inherited Destroy;
 end;
 
-Procedure TCustomOpenGLControl.Paint;
+procedure TCustomOpenGLControl.Paint;
 begin
   if IsVisible and HandleAllocated then begin
     UpdateFrameTimeDiff;
     if ([csDesigning,csDestroying]*ComponentState=[]) then begin
       if not MakeCurrent then exit;
       if AutoResizeViewport then
-        LOpenGLViewport(0,0,Width,Height);
+        LOpenGLViewport(Handle,0,0,Width,Height);
     end;
     //LOpenGLClip(Handle);
     DoOnPaint;
@@ -540,7 +554,7 @@ begin
   and ([csDesigning,csDestroying]*ComponentState=[])
   and AutoResizeViewport then begin
     if MakeCurrent then
-      LOpenGLViewport(0,0,Width,Height);
+      LOpenGLViewport(Handle,0,0,Width,Height);
   end;
   inherited RealizeBounds;
 end;
@@ -643,6 +657,9 @@ begin
     Result:=LOpenGLCreateContext(OpenGlControl,WSPrivate,
                                  OpenGlControl.SharedControl,
                                  AttrControl.DoubleBuffered,
+                                 {$IFDEF HasMacRetinaMode}
+                                 ocoMacRetinaMode in OpenGlControl.Options,
+                                 {$ENDIF}
                                  {$IFDEF HasRGBA}
                                  AttrControl.RGBA,
                                  {$ENDIF}