4 Prefix: glc - OpenGL Core
5 Beschreibung: diese Unit enthält eine abstrakte Klassen-Kapselung für OpenGL Kontexte
8 Abstrakte Contextklasse zum Erstellen von Renderkontexten auf Windows & Linux(bzw X11/Gtk2)
9 Für aktuelle Plattform passende Klasse kann per GetPlatformClass gefunden werden.
12 //muss im GUI/Main-Thread aufgerufen werden:
13 pf := TglcContext.GetPlatformClass().MakePF();
14 fContext := TglcContext.GetPlatformClass().Create(MyTWinControl, PF);
16 //_kann_ in Background Thread abgerufen werden:
17 fContext.BuildContext();
18 [Arbeit mit dem Context]
19 fContext.CloseContext();
26 MakePF() erzeugt PixelFormatDescriptor mit Defaults
27 BuildContext() baut Kontext (kann in BackgrounThread aufgerufen werden)
28 CloseContext() gibt den Kontext frei (muss im selben Thread aufgerufen werden wie BuildContext;
29 wird der Kontext nur im MainThread genutzt, muss CloseContext nicht explizit aufgerufen
30 werden und wird beim zerstören des Kontext-Objekts ausgeführt)
31 Activate/Deactiveate Kontext aktiv schalten oder nicht
32 SwapBuffers DoubleBuffering
35 EnableDebugOutput GL-Debug via ARB_debug_output oder AMD_debug_output de/aktivieren
41 SysUtils, Controls, dglOpenGL;
44 GLC_CONTEXT_VERSION_UNKNOWN = -1;
47 TMultiSample = 1..high(byte);
48 TglcContextPixelFormatSettings = packed record
49 DoubleBuffered: boolean;
51 MultiSampling: TMultiSample;
59 TglcContextVersionSettings = packed record
62 ForwardCompatible: Boolean;
64 TSeverity = (svLow, svMedium, svHigh);
65 TLogEvent = procedure(const aSender: TObject; const aSeverity: TSeverity; const aMsg: String) of Object;
69 TglcDisplayFlags = set of TglcDisplayFlag;
71 EGLError = class(Exception);
74 TglcContextClass = class of TglcContext;
77 fControl: TWinControl;
79 fEnableVsync: Boolean;
82 function GetEnableVSync: Boolean;
83 procedure SetEnableVSync(aValue: Boolean);
84 procedure LogMsg(const aSeverity: TSeverity; const aMsg: String);
85 procedure SetDebugMode(const aEnable: Boolean);
88 fPixelFormatSettings: TglcContextPixelFormatSettings;
89 fVersionSettings: TglcContextVersionSettings;
90 procedure OpenContext; virtual;
93 property PixelFormatSettings: TglcContextPixelFormatSettings read fPixelFormatSettings;
94 property VersionSettings: TglcContextVersionSettings read fVersionSettings;
96 constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings); virtual; overload;
97 constructor Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings); virtual; overload;
98 destructor Destroy; override;
100 property ThreadID: TThreadID read fThreadID;
101 property EnableVSync: Boolean read GetEnableVSync write SetEnableVSync;
103 procedure BuildContext;
104 procedure EnableDebugOutput(const aLogEvent: TLogEvent);
105 procedure DisableDebugOutput;
106 procedure CloseContext; virtual;
107 procedure Activate; virtual; abstract;
108 procedure Deactivate; virtual; abstract;
109 function IsActive: boolean; virtual; abstract;
110 procedure SwapBuffers; virtual; abstract;
111 procedure SetSwapInterval(const aInterval: GLint); virtual; abstract;
112 function GetSwapInterval: GLint; virtual; abstract;
113 procedure Share(const aContext: TglcContext); virtual; abstract;
116 fMainContextThreadID: TThreadID;
118 class property MainContextThreadID: TThreadID read fMainContextThreadID;
119 class function MakePF(DoubleBuffered: boolean = true;
120 Stereo: boolean=false;
121 MultiSampling: TMultiSample=1;
122 ColorBits: Integer=32;
123 DepthBits: Integer=24;
124 StencilBits: Integer=0;
125 AccumBits: Integer=0;
126 AuxBuffers: Integer=0;
127 Layer: Integer=0): TglcContextPixelFormatSettings;
128 class function MakeVersion(const aMajor, aMinor: Integer; const aForwardCompatible: Boolean): TglcContextVersionSettings;
129 class function GetPlatformClass: TglcContextClass;
130 class function ChangeDisplaySettings(const aWidth, aHeight,
131 aBitPerPixel, aFreq: Integer; const aFlags: TglcDisplayFlags): Boolean; virtual; abstract;
132 class function IsAnyContextActive: boolean; virtual;
146 procedure GlDebugCallbackARB(source: GLenum; type_: GLenum; id: GLuint; severity: GLenum; {%H-}length: GLsizei; const message_: PGLchar; {%H-}userParam: PGLvoid); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
152 GL_DEBUG_SOURCE_API_ARB : src:= 'API';
153 GL_DEBUG_SOURCE_WINDOW_SYSTEM_ARB : src:= 'WINDOW';
154 GL_DEBUG_SOURCE_SHADER_COMPILER_ARB: src:= 'SHADER';
155 GL_DEBUG_SOURCE_THIRD_PARTY_ARB : src:= '3RDPARTY';
156 GL_DEBUG_SOURCE_APPLICATION_ARB : src:= 'APPLICATION';
157 GL_DEBUG_SOURCE_OTHER_ARB : src:= 'OTHER';
162 GL_DEBUG_TYPE_ERROR_ARB : typ:= 'ERROR';
163 GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR_ARB : typ:= 'DEPRECATED';
164 GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR_ARB : typ:= 'UNDEF BEHAV';
165 GL_DEBUG_TYPE_PORTABILITY_ARB : typ:= 'PORTABILITY';
166 GL_DEBUG_TYPE_PERFORMANCE_ARB : typ:= 'PERFORMANCE';
167 GL_DEBUG_TYPE_OTHER_ARB : typ:= 'OTHER';
171 GL_DEBUG_SEVERITY_LOW_ARB: sv := svLow;
172 GL_DEBUG_SEVERITY_MEDIUM_ARB: sv := svMedium;
173 GL_DEBUG_SEVERITY_HIGH_ARB: sv := svHigh;
176 TglcContext(userParam).LogMsg(sv, format('%s [%d] %s',[typ, id, message_]));
179 procedure GlDebugCallbackAMD(id: GLuint; category: GLenum; severity: GLenum; {%H-}length: GLsizei; const message_: PGLchar; {%H-}userParam: PGLvoid); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
185 GL_DEBUG_CATEGORY_API_ERROR_AMD : src:= 'API';
186 GL_DEBUG_CATEGORY_WINDOW_SYSTEM_AMD : src:= 'WINDOW';
187 GL_DEBUG_CATEGORY_DEPRECATION_AMD : src:= 'SHADER';
188 GL_DEBUG_CATEGORY_UNDEFINED_BEHAVIOR_AMD : src:= 'UNDEF BEHAV';
189 GL_DEBUG_CATEGORY_PERFORMANCE_AMD : src:= 'PERFORMANCE';
190 GL_DEBUG_CATEGORY_SHADER_COMPILER_AMD : src:= 'SHADER';
191 GL_DEBUG_CATEGORY_APPLICATION_AMD : src:= 'APPLICATION';
192 GL_DEBUG_CATEGORY_OTHER_AMD : src:= 'OTHER';
197 GL_DEBUG_SEVERITY_LOW_AMD: sv := svLow;
198 GL_DEBUG_SEVERITY_MEDIUM_AMD: sv := svMedium;
199 GL_DEBUG_SEVERITY_HIGH_AMD: sv := svHigh;
202 TglcContext(userParam).LogMsg(sv, format('[%d] %s',[id, message_]));
205 function TglcContext.GetEnableVSync: Boolean;
207 result := fEnableVsync;
210 procedure TglcContext.SetEnableVSync(aValue: Boolean);
212 fEnableVsync := aValue;
213 if IsActive then begin
221 procedure TglcContext.LogMsg(const aSeverity: TSeverity; const aMsg: String);
223 if Assigned(fLogEvent) then
224 fLogEvent(self, aSeverity, aMsg);
227 procedure TglcContext.SetDebugMode(const aEnable: Boolean);
230 if GL_ARB_debug_output then begin
231 glDebugMessageCallbackARB(@GlDebugCallbackARB, self);
232 glDebugMessageControlARB(GL_DONT_CARE, GL_DONT_CARE, GL_DONT_CARE, 0, nil, aEnable);
233 if aEnable then begin
234 glEnable(GL_DEBUG_OUTPUT_SYNCHRONOUS_ARB);
235 glDebugMessageInsertARB(GL_DEBUG_SOURCE_APPLICATION_ARB, GL_DEBUG_TYPE_OTHER_ARB, 0, GL_DEBUG_SEVERITY_LOW_ARB, -1, PGLchar('Attached ARB_debug_output'));
239 end else if GL_AMD_debug_output then begin
240 glDebugMessageCallbackAMD(@GlDebugCallbackAMD, self);
241 glDebugMessageEnableAMD(GL_DONT_CARE, GL_DONT_CARE, 0, nil, aEnable);
243 glDebugMessageInsertAMD(GL_DEBUG_CATEGORY_OTHER_AMD, GL_DEBUG_SEVERITY_LOW_ARB, 0, -1, PGLchar('Attached ARB_debug_output'));
247 procedure TglcContext.OpenContext;
249 fThreadID := GetCurrentThreadId;
250 if fMainContextThreadID = 0 then
251 fMainContextThreadID := fThreadID;
254 class function TglcContext.MakePF(DoubleBuffered: boolean; Stereo: boolean; MultiSampling: TMultiSample; ColorBits: Integer;
255 DepthBits: Integer; StencilBits: Integer; AccumBits: Integer; AuxBuffers: Integer; Layer: Integer): TglcContextPixelFormatSettings;
257 Result.DoubleBuffered:= DoubleBuffered;
258 Result.Stereo:= Stereo;
259 Result.MultiSampling:= MultiSampling;
260 Result.ColorBits:= ColorBits;
261 Result.DepthBits:= DepthBits;
262 Result.StencilBits:= StencilBits;
263 Result.AccumBits:= AccumBits;
264 Result.AuxBuffers:= AuxBuffers;
265 Result.Layer:= Layer;
268 class function TglcContext.MakeVersion(const aMajor, aMinor: Integer; const aForwardCompatible: Boolean): TglcContextVersionSettings;
270 result.Major := aMajor;
271 result.Minor := aMinor;
272 result.ForwardCompatible := aForwardCompatible;
275 class function TglcContext.GetPlatformClass: TglcContextClass;
278 Result:= TglcContextWGL;
281 Result:= TglcContextGtk2GLX;
285 class function TglcContext.IsAnyContextActive: boolean;
287 Result:= GetPlatformClass.IsAnyContextActive;
290 constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings);
293 fPixelFormatSettings := aPixelFormatSettings;
294 FControl := aControl;
296 fEnableVsync := false;
297 fUseVersion := false;
301 constructor TglcContext.Create(const aControl: TWinControl; const aPixelFormatSettings: TglcContextPixelFormatSettings; const aVersionSettings: TglcContextVersionSettings);
303 Create(aControl, aPixelFormatSettings);
304 fVersionSettings := aVersionSettings;
308 destructor TglcContext.Destroy;
310 if (GetCurrentThreadId = fMainContextThreadID) then
311 fMainContextThreadID := 0;
316 procedure TglcContext.BuildContext;
320 ReadImplementationProperties;
322 SetEnableVSync(fEnableVsync);
325 procedure TglcContext.EnableDebugOutput(const aLogEvent: TLogEvent);
327 fLogEvent := aLogEvent;
331 procedure TglcContext.DisableDebugOutput;
336 procedure TglcContext.CloseContext;
338 if fMainContextThreadID = fThreadID then
339 fMainContextThreadID := 0;
343 TglcContext.fMainContextThreadID := 0;