paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 19:39:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

opengl: added DebugContext, patch #28671

Browse Source 
git-svn-id: trunk@49828 -
This commit is contained in:
mattias 2015-09-15 12:47:22 +00:00
parent 63351990c2
commit a0b6593d68
2 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
components/opengl/glgtkglxcontext.pas
View File

@ -85,6 +85,7 @@ type
MajorVersion: Cardinal;
MinorVersion: Cardinal;
MultiSampling: Cardinal;
ContextFlags: Cardinal;
end;
function GTK_TYPE_GL_AREA: TGtkType;
@ -109,10 +110,10 @@ function gdk_x11_get_default_screen:gint;cdecl;external;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
procedure LOpenGLSwapBuffers(Handle: HWND);
function LOpenGLMakeCurrent(Handle: HWND): boolean;
function LOpenGLReleaseContext(Handle: HWND): boolean;
function LOpenGLReleaseContext({%H-}Handle: HWND): boolean;
function LOpenGLCreateContext(AWinControl: TWinControl;
WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
DoubleBuffered, RGBA: boolean;
DoubleBuffered, RGBA, DebugContext: boolean;
const RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion,
MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
const AParams: TCreateParams): HWND;
@ -595,7 +596,7 @@ begin
Result:=PGtkWidget(gl_area);
end;
function CustomXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
function CustomXErrorHandler({%H-}para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
begin
if para2^.error_code=8 then begin
raise Exception.Create('A BadMatch X error occured. Most likely the requested OpenGL version is invalid.');
@ -623,7 +624,7 @@ var
GLXContext: TGLXContext;
i: Integer;
{ Used with glXCreateContextAttribsARB to select 3.X and above context }
Context3X: array [0..4] of Integer;
Context3X: array [0..6] of Integer;
begin
Result:=nil;
@ -679,7 +680,9 @@ begin
Context3X[1]:=Attribs.MajorVersion;
Context3X[2]:=GLX_CONTEXT_MINOR_VERSION_ARB;
Context3X[3]:=Attribs.MinorVersion;
Context3X[4]:=None;
Context3X[4]:=GLX_CONTEXT_FLAGS_ARB;
Context3X[5]:=Attribs.ContextFlags;
Context3X[6]:=None;
if (ShareList<>nil) then begin
GLXContext:=glXCreateContextAttribsARB(XDisplay, FBConfig,
PrivateShareList^.glxcontext, true,
@ -846,7 +849,7 @@ end;
function LOpenGLCreateContextCore(AWinControl: TWinControl;
WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
DoubleBuffered, RGBA: boolean;
DoubleBuffered, RGBA, DebugContext: boolean;
const RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion,
MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
const AParams: TCreateParams): HWND;
@ -863,6 +866,12 @@ begin
BlueBits,AlphaBits,DepthBits,StencilBits,AUXBuffers);
Attribs.MajorVersion:=MajorVersion;
Attribs.MinorVersion:=MinorVersion;
// fill in context flags
Attribs.ContextFlags:=0;
if DebugContext then
Attribs.ContextFlags:=Attribs.ContextFlags or GLX_CONTEXT_DEBUG_BIT_ARB;
if MultiSampling>1 then begin
Attribs.MultiSampling:=MultiSampling;
end else begin
@ -893,7 +902,7 @@ end;
function LOpenGLCreateContext(AWinControl: TWinControl;
WSPrivate: TWSPrivateClass; SharedControl: TWinControl;
DoubleBuffered, RGBA: boolean;
DoubleBuffered, RGBA, DebugContext: boolean;
const RedBits, GreenBits, BlueBits, MajorVersion, MinorVersion,
MultiSampling, AlphaBits, DepthBits, StencilBits, AUXBuffers: Cardinal;
const AParams: TCreateParams): HWND;
@ -909,7 +918,7 @@ begin
{$ENDIF}
try
Result := LOpenGLCreateContextCore(AWinControl, WSPrivate, SharedControl,
DoubleBuffered, RGBA, RedBits, GreenBits, BlueBits, MajorVersion,
DoubleBuffered, RGBA, DebugContext, RedBits, GreenBits, BlueBits, MajorVersion,
MinorVersion, MultiSampling, AlphaBits, DepthBits, StencilBits,
AUXBuffers, AParams);
except
@ -918,14 +927,14 @@ begin
{$ENDIF}
{ retry without MultiSampling }
Result := LOpenGLCreateContextCore(AWinControl, WSPrivate, SharedControl,
DoubleBuffered, RGBA, RedBits, GreenBits, BlueBits, MajorVersion,
DoubleBuffered, RGBA, DebugContext, RedBits, GreenBits, BlueBits, MajorVersion,
MinorVersion, 1, AlphaBits, DepthBits, StencilBits, AUXBuffers, AParams);
end;
end else begin
{ no multi-sampling requested (or GLX_ARB_multisample not available),
just pass to LOpenGLCreateContextCore }
Result := LOpenGLCreateContextCore(AWinControl, WSPrivate, SharedControl,
DoubleBuffered, RGBA, RedBits, GreenBits, BlueBits, MajorVersion,
DoubleBuffered, RGBA, DebugContext, RedBits, GreenBits, BlueBits, MajorVersion,
MinorVersion, MultiSampling, AlphaBits, DepthBits, StencilBits,
AUXBuffers, AParams);
end;

14
components/opengl/openglcontext.pas
View File

@ -38,6 +38,7 @@ unit OpenGLContext;
{$DEFINE UsesModernGL}
{$DEFINE HasRGBA}
{$DEFINE HasRGBBits}
{$DEFINE HasDebugContext}
{$DEFINE OpenGLTargetDefined}
{$ENDIF}
{$ENDIF}
@ -118,6 +119,7 @@ type
private
FAutoResizeViewport: boolean;
FCanvas: TCanvas; // only valid at designtime
FDebugContext: boolean;
FDoubleBuffered: boolean;
FFrameDiffTime: integer;
FOnMakeCurrent: TOpenGlCtrlMakeCurrentEvent;
@ -135,6 +137,7 @@ type
FSharingOpenGlControls: TList;
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);
@ -179,6 +182,7 @@ type
property AutoResizeViewport: boolean read FAutoResizeViewport
write SetAutoResizeViewport default false;
property DoubleBuffered: boolean read FDoubleBuffered write SetDoubleBuffered default true;
property DebugContext: boolean read FDebugContext write SetDebugContext default false; // create context with debugging enabled. Requires OpenGLMajorVersion!
property RGBA: boolean read FRGBA write SetRGBA default true;
{$IFDEF HasRGBBits}
property RedBits: Cardinal read FRedBits write SetRedBits default 8;
@ -300,6 +304,13 @@ begin
LOpenGLViewport(0,0,Width,Height);
end;
procedure TCustomOpenGLControl.SetDebugContext(AValue: boolean);
begin
if FDebugContext=AValue then Exit;
FDebugContext:=AValue;
OpenGLAttributesChanged;
end;
procedure TCustomOpenGLControl.SetDoubleBuffered(const AValue: boolean);
begin
if FDoubleBuffered=AValue then exit;
@ -632,6 +643,9 @@ begin
{$IFDEF HasRGBA}
AttrControl.RGBA,
{$ENDIF}
{$IFDEF HasDebugContext}
AttrControl.DebugContext,
{$ENDIF}
{$IFDEF HasRGBBits}
AttrControl.RedBits,
AttrControl.GreenBits,