2
// This unit is part of the GLScene Engine https://github.com/glscene
5
Prototypes and base implementation of TGLContext.
8
01/06/11 - Yar - Now number of rendering contexts is unlimited (by Gabriel Corneanu)
9
13/05/11 - Yar - Made indexing for context's handles to improve speed of operations
10
24/03/11 - Yar - Added preparation arrangement to TGLContext, TGLContextHandle
11
24/11/10 - Yar - Added TGLBooleanOcclusionQueryHandle
12
14/10/10 - Yar - Added ServiceContext in separate thread, procedure AddTaskForServiceContext
13
16/09/10 - YP - Fixes param assertion to display missing attrib, uniform or varying by name
14
23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
15
Added to TGLContext property PipelineTransformation
16
Added feature of debug context creating
17
Improved TGLContextHandle destroying
18
Added TGLARBVertexProgramHandle, TGLARBFragmentProgramHandle, TGLARBGeometryProgramHandle
19
02/08/10 - DaStr - Bugfixed TGLContextHandle.DestroyHandle()
20
18/07/10 - Yar - Added TGLTessControlShaderHandle, TGLTessEvaluationShaderHandle, TGLSamplerHandle
21
17/06/10 - Yar - Added IsDataNeedUpdate, NotifyDataUpdated, NotifyChangesOfData to TGLContextHandle
22
02/05/10 - Yar - Fixes for Linux x64. Make outputDevice HWND type.
23
02/05/10 - Yar - Handles are universal for contexts.
24
You can use one handle in different contexts, regardless of the compatibility of contexts.
25
01/05/10 - Yar - Added buffer objects state cashing
26
22/04/10 - Yar - Fixes after GLState revision
27
18/03/10 - Yar - Added MapBufferRange, Flush to TGLBufferObjectHandle
28
06/03/10 - Yar - Added to TGLProgramHandle BindFragDataLocation, GetUniformOffset, GetUniformBlockIndex
29
05/03/10 - DanB - More state added to TGLStateCache
30
22/02/10 - DanB - Added TGLContext.GLStates, to be used to cache
31
global per-context state. Removed BindedGLSLProgram
32
since it should be per-context state.
33
21/02/10 - Yar - Added function BindedGLSLProgram
34
08/01/10 - DaStr - Added TGLFramebufferHandle.AttachLayer()
35
Added more AntiAliasing modes (thanks YarUndeoaker)
36
13/12/09 - DaStr - Modified for multithread support (thanks Controller)
37
30/08/09 - DanB - renamed vIgnoreContextActivationFailures to vContextActivationFailureOccurred
38
+ re-enabled it's original behaviour (fixes major memory leak).
39
30/08/09 - DanB - Added TGLTransformFeedbackBufferHandle, TGLTextureBufferHandle,
40
TGLUniformBufferHandle, TGLVertexArrayHandle,
41
TGLFramebufferHandle, TGLRenderbufferHandle
42
24/08/09 - DaStr - Added TGLProgramHandle.GetVaryingLocation(),
43
AddActiveVarying() (thanks YarUnderoaker)
44
21/08/09 - DanB - TGLQueryHandle.GetTarget no longer a class function,
45
for earlier Delphi compatibility
46
13/08/09 - DanB - Added timer & primitive queries. Occlusion queries now
47
use OpenGL 1.5+ queries, instead of GL_NV_occlusion_query extension
48
10/06/09 - DanB - removed OpenGL error handling code, it already exists in OpenGL1x.pas
49
16/03/08 - DanB - moved MRT_BUFFERS into unit from opengl1x.pas rewrite,
50
and added some experimental geometry shader code
51
15/03/08 - DaStr - Fixups for vIgnoreContextActivationFailures mode
52
(BugTracker ID = 1914782)
53
06/11/07 - LC - moved vIgnoreContextActivationFailures to "Interface" section
54
24/06/06 - LC - Refactored TGLVBOHandle, introduced TGLBufferObjectHandle
55
and TGLPackPBOHandle/TGLUnpackPBOHandle
56
15/02/07 - DaStr - Added more parameters to TGLProgramHandle
57
TGLProgramHandle.Name is now a property
58
15/02/07 - DaStr - Integer -> Cardinal because $R- was removed in GLScene.pas
59
15/09/06 - NC - TGLContextHandle.handle as Integer -> Cardinal
60
11/09/06 - NC - Added TGLProgramHandle.Name, TGLProgramHandle.Uniform2f,
61
SetUniform*, support for Multiple-Render-Target
62
25/04/04 - EG - Added TGLOcclusionQueryHandle.Active
63
25/09/03 - EG - Added TGLVBOHandle
64
20/09/03 - EG - Added TGLOcclusionQueryHandle
65
30/01/02 - EG - Added TGLVirtualHandle
66
29/01/02 - EG - Improved recovery for context creation failures
67
28/01/02 - EG - Activation failures always ignored
68
21/01/02 - EG - Activation failures now ignored if application is
69
terminating (workaround for some weird ICDs)
70
15/12/01 - EG - Added support for AlphaBits
71
30/11/01 - EG - Added TGLContextAcceleration
72
06/09/01 - EG - Win32Context moved to new GLWin32Context unit
73
04/09/01 - EG - Added ChangeIAttrib, support for 16bits depth buffer
74
25/08/01 - EG - Added pbuffer support and CreateMemoryContext interface
75
24/08/01 - EG - Fixed PropagateSharedContext
76
12/08/01 - EG - Handles management completed
77
22/07/01 - EG - Creation (glcontext.omm)
90
Classes, SysUtils, Types, Forms, Controls,
95
{$IFDEF GLS_SERVICE_CONTEXT}99
GLCrossPlatform, OpenGLTokens, OpenGLAdapter, GLVectorGeometry, GLStrings,
100
GLVectorTypes, GLState, GLPipelineTransformation, GLTextureFormat;
102
// Buffer ID's for Multiple-Render-Targets (using GL_ATI_draw_buffers)
104
MRT_BUFFERS: array[0..3] of GLenum = (GL_FRONT_LEFT, GL_AUX0, GL_AUX1, GL_AUX2);
110
TGLRCOption = (rcoDoubleBuffered, rcoStereo, rcoDebug, rcoOGL_ES);
111
TGLRCOptions = set of TGLRCOption;
113
TGLContextLayer = (clUnderlay2, clUnderlay1, clMainPlane, clOverlay1, clOverlay2);
115
TFinishTaskEvent = class(TEvent)
117
constructor Create; reintroduce;
120
TTaskProcedure = procedure of object; stdcall;
121
TServiceContextTask = record
122
Task: TTaskProcedure;
123
Event: TFinishTaskEvent;
126
{$IFDEF GLS_SERVICE_CONTEXT}127
TServiceContextTaskList = {$IFDEF GLS_GENERIC_PREFIX} specialize {$ENDIF}128
GThreadList < TServiceContextTask > ;
129
{$ENDIF GLS_SERVICE_CONTEXT}132
TGLContextManager = class;
134
TAbstractMultitextureCoordinator = class(TObject)
138
constructor Create(AOwner: TGLContext); virtual;
141
TAbstractMultitextureCoordinatorClass = class of TAbstractMultitextureCoordinator;
143
// TGLContextAcceleration
145
TGLContextAcceleration = (chaUnknown, chaHardware, chaSoftware);
149
TGLAntiAliasing = (// Multisample Antialiasing
150
aaDefault, aaNone, aa2x, aa2xHQ, aa4x, aa4xHQ,
152
// Coverage Sampling Antialiasing
153
csa8x, csa8xHQ, csa16x, csa16xHQ);
157
TVSyncMode = (vsmSync, vsmNoSync);
161
{ Wrapper around an OpenGL rendering context.162
The aim of this class is to offer platform-independant
163
initialization, activation and management of OpenGL
164
rendering context. The class also offers notifications
165
event and error/problems detection.
166
This is a virtual abstract a class, and platform-specific
167
subclasses must be used.
168
All rendering context share the same lists. }
172
FColorBits, FAlphaBits: Integer;
174
FStencilBits: Integer;
176
FAuxBuffers: Integer;
177
FAntiAliasing: TGLAntiAliasing;
178
FOptions: TGLRCOptions;
179
FOnDestroyContext: TNotifyEvent;
180
FManager: TGLContextManager;
181
FActivationCount: Integer;
182
FOwnedHandlesCount: Integer;
183
FIsPraparationNeed: Boolean;
184
procedure SetColorBits(const aColorBits: Integer);
185
procedure SetAlphaBits(const aAlphaBits: Integer);
186
procedure SetDepthBits(const val: Integer);
187
procedure SetStencilBits(const aStencilBits: Integer);
188
procedure SetAccumBits(const aAccumBits: Integer);
189
procedure SetAuxBuffers(const aAuxBuffers: Integer);
190
procedure SetOptions(const aOptions: TGLRCOptions);
191
procedure SetAntiAliasing(const val: TGLAntiAliasing);
192
procedure SetAcceleration(const val: TGLContextAcceleration);
193
function GetActive: Boolean;
194
procedure SetActive(const aActive: Boolean);
195
procedure SetLayer(const Value: TGLContextLayer);
198
FGL: TGLExtensionsAndEntryPoints;
199
FXGL: TAbstractMultitextureCoordinator;
200
FGLStates: TGLStateCache;
201
FTransformation: TGLTransformation;
202
FAcceleration: TGLContextAcceleration;
203
FLayer: TGLContextLayer;
204
{$IFNDEF GLS_MULTITHREAD}205
FSharedContexts: TList;
207
FSharedContexts: TThreadList;
208
FLock: TCriticalSection;
210
procedure PropagateSharedContext;
212
procedure DoCreateContext(ADeviceHandle: HDC); virtual; abstract;
213
procedure DoCreateMemoryContext(outputDevice: HWND; width, height:
214
Integer; BufferCount: integer = 1); virtual; abstract;
215
function DoShareLists(aContext: TGLContext): Boolean; virtual; abstract;
216
procedure DoDestroyContext; virtual; abstract;
217
procedure DoActivate; virtual; abstract;
218
procedure DoDeactivate; virtual; abstract;
219
class function ServiceContext: TGLContext;
220
procedure MakeGLCurrent;
221
function GetXGL: TAbstractMultitextureCoordinator;
224
constructor Create; virtual;
225
destructor Destroy; override;
227
{ An application-side cache of global per-context OpenGL states229
property GLStates: TGLStateCache read FGLStates;
231
property PipelineTransformation: TGLTransformation read FTransformation;
233
// Context manager reference
234
property Manager: TGLContextManager read FManager;
236
{ Color bits for the rendering context }237
property ColorBits: Integer read FColorBits write SetColorBits;
238
{ Alpha bits for the rendering context }239
property AlphaBits: Integer read FAlphaBits write SetAlphaBits;
240
{ Depth bits for the rendering context }241
property DepthBits: Integer read FDepthBits write SetDepthBits;
242
{ Stencil bits for the rendering context }243
property StencilBits: Integer read FStencilBits write SetStencilBits;
244
{ Accumulation buffer bits for the rendering context }245
property AccumBits: Integer read FAccumBits write SetAccumBits;
246
{ Auxiliary buffers bits for the rendering context }247
property AuxBuffers: Integer read FAuxBuffers write SetAuxBuffers;
248
{ AntiAliasing option.249
Ignored if not hardware supported, currently based on ARB_multisample. }
250
property AntiAliasing: TGLAntiAliasing read FAntiAliasing write
252
{ Specifies the layer plane that the rendering context is bound to. }253
property Layer: TGLContextLayer read FLayer write SetLayer;
254
{ Rendering context options. }255
property Options: TGLRCOptions read FOptions write SetOptions;
256
{ Allows reading and defining the activity for the context.257
The methods of this property are just wrappers around calls
258
to Activate and Deactivate. }
259
property Active: Boolean read GetActive write SetActive;
260
{ Indicates if the context is hardware-accelerated. }261
property Acceleration: TGLContextAcceleration read FAcceleration write SetAcceleration;
262
{ Triggered whenever the context is destroyed.263
This events happens *before* the context has been
264
actually destroyed, OpenGL resource cleanup can
266
property OnDestroyContext: TNotifyEvent read FOnDestroyContext write
269
{ Creates the context.270
This method must be invoked before the context can be used. }
271
procedure CreateContext(ADeviceHandle: HDC); overload;
272
{ Creates an in-memory context.273
The function should fail if no hardware-accelerated memory context
274
can be created (the CreateContext method can handle software OpenGL
276
procedure CreateMemoryContext(outputDevice: HWND; width, height:
277
Integer; BufferCount: integer = 1);
278
{ Setup display list sharing between two rendering contexts.279
Both contexts must have the same pixel format. }
280
procedure ShareLists(aContext: TGLContext);
281
{ Destroy the context.282
Will fail if no context has been created.
283
The method will first invoke the OnDestroyContext
284
event, then attempts to deactivate the context
285
(if it is active) before destroying it. }
286
procedure DestroyContext;
287
{ Activates the context.288
A context can be activated multiple times (and must be
289
deactivated the same number of times), but this function
290
will fail if another context is already active. }
292
{ Deactivates the context.293
Will fail if the context is not active or another
294
context has been activated. }
295
procedure Deactivate;
296
{ Call OnPrepare for all handles. }297
procedure PrepareHandlesData;
298
{ Returns true if the context is valid.299
A context is valid from the time it has been successfully
300
created to the time of its destruction. }
301
function IsValid: Boolean; virtual; abstract;
302
{ Request to swap front and back buffers if they were defined. }303
procedure SwapBuffers; virtual; abstract;
305
{ Returns the first compatible context that isn't self in the shares. }306
function FindCompatibleContext: TGLContext;
307
procedure DestroyAllHandles;
309
function RenderOutputDevice: Pointer; virtual; abstract;
310
{ Access to OpenGL command and extension. }311
property GL: TGLExtensionsAndEntryPoints read FGL;
312
property MultitextureCoordinator: TAbstractMultitextureCoordinator read GetXGL;
313
property IsPraparationNeed: Boolean read FIsPraparationNeed;
316
TGLContextClass = class of TGLContext;
318
// TGLScreenControlingContext
320
{ A TGLContext with screen control property and methods.321
This variety of contexts is for drivers that access windows and OpenGL
322
through an intermediate opaque cross-platform API.
323
TGLSceneViewer won't use them, TGLMemoryViewer may be able to use them,
324
but most of the time they will be accessed through a specific viewer
326
TGLScreenControlingContext = class(TGLContext)
329
FWidth, FHeight: Integer;
330
FFullScreen: Boolean;
337
property Width: Integer read FWidth write FWidth;
338
property Height: Integer read FHeight write FHeight;
339
property FullScreen: Boolean read FFullScreen write FFullScreen;
342
PGLRCHandle = ^TGLRCHandle;
344
FRenderingContext: TGLContext;
349
TOnPrepareHandleData = procedure(AContext: TGLContext) of object;
353
{ Wrapper around an OpenGL context handle.354
This wrapper also takes care of context registrations and data releases
355
related to context releases an cleanups. This is an abstract class,
356
use the TGLListHandle and TGLTextureHandle subclasses. }
357
TGLContextHandle = class
361
FLastHandle : PGLRCHandle;
362
FOnPrepare: TOnPrepareHandleData;
363
function GetHandle: TGLuint;
364
function GetContext: TGLContext;
365
function SearchRC(AContext: TGLContext): PGLRCHandle;
366
function RCItem(AIndex: integer): PGLRCHandle; {$IFDEF GLS_INLINE}inline;{$ENDIF}367
procedure CheckCurrentRC;
370
// Invoked by when there is no compatible context left for relocation
371
procedure ContextDestroying;
373
// Specifies if the handle can be transfered across shared contexts
374
class function Transferable: Boolean; virtual;
375
class function IsValid(const ID: GLuint): Boolean; virtual;
377
function DoAllocateHandle: Cardinal; virtual; abstract;
378
procedure DoDestroyHandle(var AHandle: TGLuint); virtual; abstract;
382
constructor Create; virtual;
383
constructor CreateAndAllocate(failIfAllocationFailed: Boolean = True);
384
destructor Destroy; override;
386
{ Return OpenGL identifier in current context. }387
property Handle: TGLuint read GetHandle;
388
{ Return current rendering context if handle is allocated in it389
or first context where handle is allocated. }
390
property RenderingContext: TGLContext read GetContext;
391
{ Return True is data need update in current context. }392
function IsDataNeedUpdate: Boolean;
393
{ Return True if data updated in all contexts. }394
function IsDataComplitelyUpdated: Boolean;
395
{ Notify the data was updated in current context. }396
procedure NotifyDataUpdated;
397
{ Notify the data was changed through all context. }398
procedure NotifyChangesOfData;
400
// Checks if required extensions / OpenGL version are met
401
class function IsSupported: Boolean; virtual;
402
function IsAllocatedForContext(AContext: TGLContext = nil): Boolean;
403
function IsShared: Boolean;
405
function AllocateHandle: TGLuint;
406
procedure DestroyHandle;
408
property OnPrapare: TOnPrepareHandleData read FOnPrepare write FOnPrepare;
411
TGLVirtualHandle = class;
412
TGLVirtualHandleEvent = procedure(Sender: TGLVirtualHandle; var handle:
417
{ A context handle with event-based handle allocation and destruction. }418
TGLVirtualHandle = class(TGLContextHandle)
421
FOnAllocate, FOnDestroy: TGLVirtualHandleEvent;
425
function DoAllocateHandle: Cardinal; override;
426
procedure DoDestroyHandle(var AHandle: TGLuint); override;
427
class function Transferable: Boolean; override;
430
property OnAllocate: TGLVirtualHandleEvent read FOnAllocate write
432
property OnDestroy: TGLVirtualHandleEvent read FOnDestroy write FOnDestroy;
434
property Tag: Integer read FTag write FTag;
437
// TGLVirtualHandleTransf
439
{ Transferable virtual handle. }440
TGLVirtualHandleTransf = class(TGLVirtualHandle)
442
class function Transferable: Boolean; override;
447
{ Manages a handle to a display list. }448
TGLListHandle = class(TGLContextHandle)
454
function DoAllocateHandle: Cardinal; override;
455
procedure DoDestroyHandle(var AHandle: TGLuint); override;
456
class function IsValid(const ID: GLuint): Boolean; override;
459
procedure NewList(mode: Cardinal);
466
{ Manages a handle to a texture. }467
TGLTextureHandle = class(TGLContextHandle)
469
FTarget: TGLTextureTarget;
470
procedure SetTarget(ATarget: TGLTextureTarget);
473
function DoAllocateHandle: Cardinal; override;
474
procedure DoDestroyHandle(var AHandle: TGLuint); override;
475
class function IsValid(const ID: GLuint): Boolean; override;
478
property Target: TGLTextureTarget read FTarget write SetTarget;
483
{ Manages a handle to a sampler. }484
TGLSamplerHandle = class(TGLContextHandle)
487
function DoAllocateHandle: Cardinal; override;
488
procedure DoDestroyHandle(var AHandle: TGLuint); override;
489
class function IsValid(const ID: GLuint): Boolean; override;
492
class function IsSupported: Boolean; override;
497
{ Manages a handle to a query. 498
Do not use this class directly, use one of its subclasses instead. }
499
TGLQueryHandle = class(TGLContextHandle)
505
class function Transferable: Boolean; override;
506
function DoAllocateHandle: Cardinal; override;
507
procedure DoDestroyHandle(var AHandle: TGLuint); override;
508
function GetTarget: TGLuint; virtual; abstract;
509
function GetQueryType: TQueryType; virtual; abstract;
510
class function IsValid(const ID: GLuint): Boolean; override;
513
procedure BeginQuery;
516
// Check if result is available from the query. Result may not be available
517
// immediately after ending the query
518
function IsResultAvailable: boolean;
519
// Number of bits used to store the query result. eg. 32/64 bit
520
function CounterBits: integer;
521
// Retrieve query result, may cause a stall if the result is not available yet
522
function QueryResultInt: TGLInt;
523
function QueryResultUInt: TGLUInt;
524
function QueryResultInt64: TGLint64EXT;
525
function QueryResultUInt64: TGLuint64EXT;
526
function QueryResultBool: TGLboolean;
528
property Target: TGLuint read GetTarget;
529
property QueryType: TQueryType read GetQueryType;
531
{ True if within a Begin/EndQuery. }532
property Active: Boolean read FActive;
535
// TGLOcclusionQueryHandle
537
{ Manages a handle to an occlusion query. 539
Does *NOT* check for extension availability, this is assumed to have been
540
checked by the user. }
541
TGLOcclusionQueryHandle = class(TGLQueryHandle)
543
function GetTarget: TGLuint; override;
544
function GetQueryType: TQueryType; override;
546
class function IsSupported: Boolean; override;
547
// Number of samples (pixels) drawn during the query, some pixels may
548
// be drawn to several times in the same query
549
function PixelCount: Integer;
552
TGLBooleanOcclusionQueryHandle = class(TGLQueryHandle)
554
function GetTarget: TGLuint; override;
555
function GetQueryType: TQueryType; override;
557
class function IsSupported: Boolean; override;
560
// TGLTimerQueryHandle
562
{ Manages a handle to a timer query. 563
Requires GL_EXT_timer_query extension.
564
Does *NOT* check for extension availability, this is assumed to have been
565
checked by the user. }
566
TGLTimerQueryHandle = class(TGLQueryHandle)
568
function GetTarget: TGLuint; override;
569
function GetQueryType: TQueryType; override;
571
class function IsSupported: Boolean; override;
572
// Time, in nanoseconds (1 ns = 10^-9 s) between starting + ending the query.
573
// with 32 bit integer can measure up to approximately 4 seconds, use
574
// QueryResultUInt64 if you may need longer
575
function Time: Integer;
578
// TGLPrimitiveQueryHandle
580
{ Manages a handle to a primitive query. 582
Does *NOT* check for extension availability, this is assumed to have been
583
checked by the user. }
584
TGLPrimitiveQueryHandle = class(TGLQueryHandle)
586
function GetTarget: TGLuint; override;
587
function GetQueryType: TQueryType; override;
589
class function IsSupported: Boolean; override;
590
// Number of primitives (eg. Points, Triangles etc.) drawn whilst the
592
function PrimitivesGenerated: Integer;
595
// TGLBufferObjectHandle
597
{ Manages a handle to a Buffer Object. 598
Does *NOT* check for extension availability, this is assumed to have been
599
checked by the user. }
600
TGLBufferObjectHandle = class(TGLContextHandle)
606
function DoAllocateHandle: Cardinal; override;
607
procedure DoDestroyHandle(var AHandle: TGLuint); override;
609
function GetTarget: TGLuint; virtual; abstract;
610
class function IsValid(const ID: GLuint): Boolean; override;
613
{ Creates the buffer object buffer and initializes it. }614
constructor CreateFromData(p: Pointer; size: Integer; bufferUsage: TGLuint);
616
procedure Bind; virtual; abstract;
617
{ Note that it is not necessary to UnBind before Binding another buffer. }618
procedure UnBind; virtual; abstract;
620
{ Bind a buffer object to an indexed target, used by transform feedback621
buffer objects and uniform buffer objects. (OpenGL 3.0+) }
622
procedure BindRange(index: TGLuint; offset: TGLintptr; size: TGLsizeiptr);
624
{ Equivalent to calling BindRange with offset = 0, and size = the size of buffer.}625
procedure BindBase(index: TGLuint); virtual;
626
procedure UnBindBase(index: TGLuint); virtual;
628
{ Specifies buffer content.629
Common bufferUsage values are GL_STATIC_DRAW_ARB for data that will
630
change rarely, but be used often, GL_STREAM_DRAW_ARB for data specified
631
once but used only a few times, and GL_DYNAMIC_DRAW_ARB for data
632
that is re-specified very often.
633
Valid only if the buffer has been bound. }
634
procedure BufferData(p: Pointer; size: Integer; bufferUsage: TGLuint);
635
// Invokes Bind then BufferData
636
procedure BindBufferData(p: Pointer; size: Integer; bufferUsage: TGLuint);
637
{ Updates part of an already existing buffer.638
offset and size indicate which part of the data in the buffer is
639
to bo modified and p where the data should be taken from. }
640
procedure BufferSubData(offset, size: Integer; p: Pointer);
641
{ Map buffer content to memory.642
Values for access are GL_READ_ONLY_ARB, GL_WRITE_ONLY_ARB and
644
Valid only if the buffer has been bound, must be followed by
645
an UnmapBuffer, only one buffer may be mapped at a time. }
646
function MapBuffer(access: TGLuint): Pointer;
647
function MapBufferRange(offset: TGLint; len: TGLsizei; access: TGLbitfield):
649
procedure Flush(offset: TGLint; len: TGLsizei);
650
{ Unmap buffer content from memory.651
Must follow a MapBuffer, and happen before the buffer is unbound. }
652
function UnmapBuffer: Boolean;
654
class function IsSupported: Boolean; override;
656
property Target: TGLuint read GetTarget;
657
property BufferSize: Integer read FSize;
662
{ Manages a handle to an Vertex Buffer Object. 663
Does *NOT* check for extension availability, this is assumed to have been
665
Do not use this class directly, use one of its subclasses instead. }
666
TGLVBOHandle = class(TGLBufferObjectHandle)
670
function GetVBOTarget: TGLuint;
673
property VBOTarget: TGLuint read GetVBOTarget;
676
// TGLVBOArrayBufferHandle
678
{ Manages a handle to VBO Array Buffer.679
Typically used to store vertices, normals, texcoords, etc. }
680
TGLVBOArrayBufferHandle = class(TGLVBOHandle)
682
function GetTarget: TGLuint; override;
684
procedure Bind; override;
685
procedure UnBind; override;
688
// TGLVBOElementArrayHandle
690
{ Manages a handle to VBO Element Array Buffer.691
Typically used to store vertex indices. }
692
TGLVBOElementArrayHandle = class(TGLVBOHandle)
694
function GetTarget: TGLuint; override;
696
procedure Bind; override;
697
procedure UnBind; override;
702
{ Manages a handle to PBO Pixel Pack Buffer.703
When bound, commands such as ReadPixels write
704
their data into a buffer object. }
705
TGLPackPBOHandle = class(TGLBufferObjectHandle)
707
function GetTarget: TGLuint; override;
709
procedure Bind; override;
710
procedure UnBind; override;
711
class function IsSupported: Boolean; override;
714
// TGLUnpackPBOHandle
716
{ Manages a handle to PBO Pixel Unpack Buffer.717
When bound, commands such as DrawPixels read
718
their data from a buffer object. }
719
TGLUnpackPBOHandle = class(TGLBufferObjectHandle)
721
function GetTarget: TGLuint; override;
723
procedure Bind; override;
724
procedure UnBind; override;
725
class function IsSupported: Boolean; override;
728
// TGLTransformFeedbackBufferHandle
730
{ Manages a handle to a Transform Feedback Buffer Object.731
Transform feedback buffers can be used to capture vertex data from the
732
vertex or geometry shader stage to perform further processing without
733
going on to the fragment shader stage. }
734
TGLTransformFeedbackBufferHandle = class(TGLBufferObjectHandle)
735
// FTransformFeedbackBufferBuffer: array[0..15] of TGLuint; // (0, 0, 0, ...)
736
// FTransformFeedbackBufferStart: array[0..15] of TGLuint64; // (0, 0, 0, ...)
737
// FTransformFeedbackBufferSize: array[0..15] of TGLuint64; // (0, 0, 0, ...)
739
function GetTarget: TGLuint; override;
741
procedure Bind; override;
742
procedure UnBind; override;
743
procedure BeginTransformFeedback(primitiveMode: TGLenum);
744
procedure EndTransformFeedback();
745
procedure BindRange(index: TGLuint; offset: TGLintptr; size: TGLsizeiptr); override;
746
procedure BindBase(index: TGLuint); override;
747
procedure UnBindBase(index: TGLuint); override;
749
class function IsSupported: Boolean; override;
752
// TGLTextureBufferHandle
754
{ Manages a handle to a Buffer Texture. (TBO) }755
TGLTextureBufferHandle = class(TGLBufferObjectHandle)
757
function GetTarget: TGLuint; override;
759
procedure Bind; override;
760
procedure UnBind; override;
761
class function IsSupported: Boolean; override;
764
// TGLUniformBufferHandle
766
{ Manages a handle to a Uniform Buffer Object (UBO).767
Uniform buffer objects store "uniform blocks"; groups of uniforms
768
that can be passed as a group into a GLSL program. }
769
TGLUniformBufferHandle = class(TGLBufferObjectHandle)
770
// FUniformBufferBuffer: array[0..15] of TGLuint; // (0, 0, 0, ...)
771
// FUniformBufferStart: array[0..15] of TGLuint64; // (0, 0, 0, ...)
772
// FUniformBufferSize: array[0..15] of TGLuint64; // (0, 0, 0, ...)
774
function GetTarget: TGLuint; override;
776
procedure Bind; override;
777
procedure UnBind; override;
778
procedure BindRange(index: TGLuint; offset: TGLintptr; size: TGLsizeiptr); override;
779
procedure BindBase(index: TGLuint); override;
780
procedure UnBindBase(index: TGLuint); override;
781
class function IsSupported: Boolean; override;
784
// TGLVertexArrayHandle
786
{ Manages a handle to a Vertex Array Object (VAO).787
Vertex array objects are used to rapidly switch between large sets
789
TGLVertexArrayHandle = class(TGLContextHandle)
791
class function Transferable: Boolean; override;
792
function DoAllocateHandle: Cardinal; override;
793
procedure DoDestroyHandle(var AHandle: TGLuint); override;
794
class function IsValid(const ID: GLuint): Boolean; override;
798
class function IsSupported: Boolean; override;
801
TGLFramebufferStatus = (fsComplete, fsIncompleteAttachment,
802
fsIncompleteMissingAttachment,
803
fsIncompleteDuplicateAttachment, fsIncompleteDimensions,
805
fsIncompleteDrawBuffer, fsIncompleteReadBuffer, fsUnsupported,
806
fsIncompleteMultisample,
809
// TGLFramebufferHandle
811
{ Manages a handle to a Framebuffer Object (FBO).812
Framebuffer objects provide a way of drawing to rendering
813
destinations other than the buffers provided to the GL by the
814
window-system. One or more "framebuffer-attachable images" can be attached
815
to a Framebuffer for uses such as: offscreen rendering, "render to texture" +
816
"multiple render targets" (MRT).
817
There are several types of framebuffer-attachable images:
818
- The image of a renderbuffer object, which is always 2D.
819
- A single level of a 1D texture, which is treated as a 2D image with a height of one.
820
- A single level of a 2D or rectangle texture.
821
- A single face of a cube map texture level, which is treated as a 2D image.
822
- A single layer of a 1D or 2D array texture or 3D texture, which is treated as a 2D image.
823
Additionally, an entire level of a 3D texture, cube map texture,
824
or 1D or 2D array texture can be attached to an attachment point.
825
Such attachments are treated as an array of 2D images, arranged in
826
layers, and the corresponding attachment point is considered to be layered. }
827
TGLFramebufferHandle = class(TGLContextHandle)
829
class function Transferable: Boolean; override;
830
function DoAllocateHandle: Cardinal; override;
831
procedure DoDestroyHandle(var AHandle: TGLuint); override;
832
class function IsValid(const ID: GLuint): Boolean; override;
834
// Bind framebuffer for both drawing + reading
836
// Bind framebuffer for drawing
837
procedure BindForDrawing;
838
// Bind framebuffer for reading
839
procedure BindForReading;
840
{ Note that it is not necessary to unbind before binding another framebuffer. }842
procedure UnBindForDrawing;
843
procedure UnBindForReading;
844
// target = GL_DRAW_FRAMEBUFFER, GL_READ_FRAMEBUFFER, GL_FRAMEBUFFER (attach to both READ + DRAW)
845
// attachment = COLOR_ATTACHMENTi, DEPTH_ATTACHMENT, STENCIL_ATTACHMENT, DEPTH_STENCIL_ATTACHMENT
846
procedure Attach1DTexture(target: TGLenum; attachment: TGLenum; textarget:
847
TGLenum; texture: TGLuint; level: TGLint);
848
procedure Attach2DTexture(target: TGLenum; attachment: TGLenum; textarget:
849
TGLenum; texture: TGLuint; level: TGLint);
850
procedure Attach3DTexture(target: TGLenum; attachment: TGLenum; textarget:
851
TGLenum; texture: TGLuint; level: TGLint; layer: TGLint);
852
procedure AttachLayer(target: TGLenum; attachment: TGLenum; texture:
853
TGLuint; level: TGLint; layer: TGLint);
854
procedure AttachRenderBuffer(target: TGLenum; attachment: TGLenum;
855
renderbuffertarget: TGLenum; renderbuffer: TGLuint);
857
// If texture is the name of a three-dimensional texture, cube map texture, one-or
858
// two-dimensional array texture, or two-dimensional multisample array texture, the
859
// texture level attached to the framebuffer attachment point is an array of images,
860
// and the framebuffer attachment is considered layered.
861
procedure AttachTexture(target: TGLenum; attachment: TGLenum; texture:
862
TGLuint; level: TGLint);
864
procedure AttachTextureLayer(target: TGLenum; attachment: TGLenum; texture:
865
TGLuint; level: TGLint; layer: TGLint);
867
// copy rect from bound read framebuffer to bound draw framebuffer
868
procedure Blit(srcX0: TGLint; srcY0: TGLint; srcX1: TGLint; srcY1: TGLint;
869
dstX0: TGLint; dstY0: TGLint; dstX1: TGLint; dstY1: TGLint;
870
mask: TGLbitfield; filter: TGLenum);
871
// target = GL_DRAW_FRAMEBUFFER, GL_READ_FRAMEBUFFER, GL_FRAMEBUFFER (equivalent to GL_DRAW_FRAMEBUFFER)
872
// If default framebuffer (0) is bound:
873
// attachment = GL_FRONT_LEFT, GL_FRONT_RIGHT, GL_BACK_LEFT, or GL_BACK_RIGHT, GL_DEPTH, GL_STENCIL
874
// if a framebuffer object is bound:
875
// attachment = GL_COLOR_ATTACHMENTi, GL_DEPTH_ATTACHMENT, GL_STENCIL_ATTACHMENT, GL_DEPTH_STENCIL_ATTACHMENT
876
// param = GL_FRAMEBUFFER_ATTACHMENT_(OBJECT_TYPE, OBJECT_NAME,
877
// RED_SIZE, GREEN_SIZE, BLUE_SIZE, ALPHA_SIZE, DEPTH_SIZE, STENCIL_SIZE,
878
// COMPONENT_TYPE, COLOR_ENCODING, TEXTURE_LEVEL, LAYERED, TEXTURE_CUBE_MAP_FACE, TEXTURE_LAYER
879
function GetAttachmentParameter(target: TGLenum; attachment: TGLenum; pname:
881
// Returns the type of object bound to attachment point:
882
// GL_NONE, GL_FRAMEBUFFER_DEFAULT, GL_TEXTURE, or GL_RENDERBUFFER
883
function GetAttachmentObjectType(target: TGLenum; attachment: TGLenum):
885
// Returns the name (ID) of the texture or renderbuffer attached to attachment point
886
function GetAttachmentObjectName(target: TGLenum; attachment: TGLenum):
889
function GetStatus: TGLFramebufferStatus;
890
function GetStringStatus(out clarification: string): TGLFramebufferStatus;
892
class function IsSupported: Boolean; override;
895
// TGLRenderbufferHandle
897
{ Manages a handle to a Renderbuffer Object.898
A Renderbuffer is a "framebuffer-attachable image" for generalized offscreen
899
rendering and it also provides a means to support rendering to GL logical
900
buffer types which have no corresponding texture format (stencil, accum, etc). }
901
TGLRenderbufferHandle = class(TGLContextHandle)
903
function DoAllocateHandle: Cardinal; override;
904
procedure DoDestroyHandle(var AHandle: TGLuint); override;
905
class function IsValid(const ID: GLuint): Boolean; override;
909
procedure SetStorage(internalformat: TGLenum; width, height: TGLsizei);
910
procedure SetStorageMultisample(internalformat: TGLenum; samples: TGLsizei;
911
width, height: TGLsizei);
912
class function IsSupported: Boolean; override;
915
TGLARBProgramHandle = class(TGLContextHandle)
922
function DoAllocateHandle: Cardinal; override;
923
procedure DoDestroyHandle(var AHandle: TGLuint); override;
924
class function IsValid(const ID: GLuint): Boolean; override;
925
class function GetTarget: TGLenum; virtual; abstract;
928
procedure LoadARBProgram(AText: string);
932
property Ready: Boolean read FReady;
933
property InfoLog: string read FInfoLog;
936
TGLARBVertexProgramHandle = class(TGLARBProgramHandle)
939
class function GetTarget: TGLenum; override;
942
class function IsSupported: Boolean; override;
945
TGLARBFragmentProgramHandle = class(TGLARBProgramHandle)
948
class function GetTarget: TGLenum; override;
951
class function IsSupported: Boolean; override;
954
TGLARBGeometryProgramHandle = class(TGLARBProgramHandle)
957
class function GetTarget: TGLenum; override;
960
class function IsSupported: Boolean; override;
965
{ Base class for GLSL handles (programs and shaders).966
Do not use this class directly, use one of its subclasses instead. }
967
TGLSLHandle = class(TGLContextHandle)
973
procedure DoDestroyHandle(var AHandle: TGLuint); override;
977
function InfoLog: string;
978
class function IsSupported: Boolean; override;
983
{ Manages a handle to a Shader Object. 984
Does *NOT* check for extension availability, this is assumed to have been
986
Do not use this class directly, use one of its subclasses instead. }
987
TGLShaderHandle = class(TGLSLHandle)
990
FShaderType: Cardinal;
994
function DoAllocateHandle: Cardinal; override;
995
class function IsValid(const ID: GLuint): Boolean; override;
998
procedure ShaderSource(const source: AnsiString); overload;
999
// Returns True if compilation sucessful
1000
function CompileShader: Boolean;
1002
property ShaderType: Cardinal read FShaderType;
1005
TGLShaderHandleClass = class of TGLShaderHandle;
1007
// TGLVertexShaderHandle
1009
{ Manages a handle to a Vertex Shader Object. }1010
TGLVertexShaderHandle = class(TGLShaderHandle)
1013
constructor Create; override;
1014
class function IsSupported: Boolean; override;
1017
// TGLGeometryShaderHandle
1019
{ Manages a handle to a Geometry Shader Object. }1020
TGLGeometryShaderHandle = class(TGLShaderHandle)
1023
constructor Create; override;
1024
class function IsSupported: Boolean; override;
1027
// TGLFragmentShaderHandle
1029
{ Manages a handle to a Fragment Shader Object. }1030
TGLFragmentShaderHandle = class(TGLShaderHandle)
1033
constructor Create; override;
1034
class function IsSupported: Boolean; override;
1037
// TGLTessControlShaderHandle
1039
{ Manages a handle to a Tessellation Control Shader Object. }1040
TGLTessControlShaderHandle = class(TGLShaderHandle)
1043
constructor Create; override;
1044
class function IsSupported: Boolean; override;
1047
// TGLTessEvaluationShaderHandle
1049
{ Manages a handle to a Tessellation Evaluation Shader Object. }1050
TGLTessEvaluationShaderHandle = class(TGLShaderHandle)
1053
constructor Create; override;
1054
class function IsSupported: Boolean; override;
1059
{ Manages a GLSL Program Object. 1060
Does *NOT* check for extension availability, this is assumed to have been
1061
checked by the user. }
1062
TGLProgramHandle = class(TGLSLHandle)
1064
class function IsValid(const ID: GLuint): Boolean; override;
1068
function GetUniform1i(const index: string): Integer;
1069
procedure SetUniform1i(const index: string; val: Integer);
1070
function GetUniform2i(const index: string): TVector2i;
1071
procedure SetUniform2i(const index: string; const Value: TVector2i);
1072
function GetUniform3i(const index: string): TVector3i;
1073
procedure SetUniform3i(const index: string; const Value: TVector3i);
1074
function GetUniform4i(const index: string): TVector4i;
1075
procedure SetUniform4i(const index: string; const Value: TVector4i);
1077
function GetUniform1f(const index: string): Single;
1078
procedure SetUniform1f(const index: string; val: Single);
1079
function GetUniform2f(const index: string): TVector2f;
1080
procedure SetUniform2f(const index: string; const val: TVector2f);
1081
function GetUniform3f(const index: string): TAffineVector;
1082
procedure SetUniform3f(const index: string; const val: TAffineVector);
1083
function GetUniform4f(const index: string): TVector;
1084
procedure SetUniform4f(const index: string; const val: TVector);
1086
function GetUniformMatrix2fv(const index: string): TMatrix2f;
1087
procedure SetUniformMatrix2fv(const index: string; const val: TMatrix2f);
1088
function GetUniformMatrix3fv(const index: string): TMatrix3f;
1089
procedure SetUniformMatrix3fv(const index: string; const val: TMatrix3f);
1090
function GetUniformMatrix4fv(const index: string): TMatrix;
1091
procedure SetUniformMatrix4fv(const index: string; const val: TMatrix);
1093
function GetUniformTextureHandle(const index: string;
1094
const TextureIndex: Integer; const TextureTarget: TGLTextureTarget):
1096
procedure SetUniformTextureHandle(const index: string;
1097
const TextureIndex: Integer; const TextureTarget: TGLTextureTarget;
1098
const Value: Cardinal);
1099
procedure SetUniformBuffer(const index: string;
1100
Value: TGLUniformBufferHandle);
1103
function DoAllocateHandle: cardinal; override;
1107
property Name: string read FName write FName;
1109
constructor Create; override;
1111
{ Compile and attach a new shader.1112
Raises an EGLShader exception in case of failure. }
1113
procedure AddShader(shaderType: TGLShaderHandleClass; const shaderSource:
1115
treatWarningsAsErrors: Boolean = False);
1117
procedure AttachObject(shader: TGLShaderHandle);
1118
procedure DetachAllObject;
1119
procedure BindAttribLocation(index: Integer; const aName: string);
1120
procedure BindFragDataLocation(index: Integer; const aName: string);
1121
function LinkProgram: Boolean;
1122
function ValidateProgram: Boolean;
1123
function GetAttribLocation(const aName: string): Integer;
1124
function GetUniformLocation(const aName: string): Integer;
1125
function GetUniformOffset(const aName: string): PGLInt;
1126
function GetUniformBlockIndex(const aName: string): Integer;
1128
function GetVaryingLocation(const aName: string): Integer;
1129
// Currently, NVidia-specific.
1130
procedure AddActiveVarying(const aName: string);
1131
// Currently, NVidia-specific.
1133
function GetUniformBufferSize(const aName: string): Integer;
1135
procedure UseProgramObject;
1136
procedure EndUseProgramObject;
1138
procedure SetUniformi(const index: string; const val: integer); overload;
1139
procedure SetUniformi(const index: string; const val: TVector2i); overload;
1140
procedure SetUniformi(const index: string; const val: TVector3i); overload;
1141
procedure SetUniformi(const index: string; const val: TVector4i); overload;
1143
procedure SetUniformf(const index: string; const val: single); overload;
1144
procedure SetUniformf(const index: string; const val: TVector2f); overload;
1145
procedure SetUniformf(const index: string; const val: TVector3f); overload;
1146
procedure SetUniformf(const index: string; const val: TVector4f); overload;
1148
{ Shader parameters. }1149
property Uniform1i[const index: string]: Integer read GetUniform1i write
1151
property Uniform2i[const index: string]: TVector2i read GetUniform2i write
1153
property Uniform3i[const index: string]: TVector3i read GetUniform3i write
1155
property Uniform4i[const index: string]: TVector4i read GetUniform4i write
1158
property Uniform1f[const index: string]: Single read GetUniform1f write
1160
property Uniform2f[const index: string]: TVector2f read GetUniform2f write
1162
property Uniform3f[const index: string]: TAffineVector read GetUniform3f
1164
property Uniform4f[const index: string]: TVector read GetUniform4f write
1167
property UniformMatrix2fv[const index: string]: TMatrix2f read
1168
GetUniformMatrix2fv write SetUniformMatrix2fv;
1169
property UniformMatrix3fv[const index: string]: TMatrix3f read
1170
GetUniformMatrix3fv write SetUniformMatrix3fv;
1171
property UniformMatrix4fv[const index: string]: TMatrix read
1172
GetUniformMatrix4fv write SetUniformMatrix4fv;
1174
property UniformTextureHandle[const index: string; const TextureIndex:
1175
Integer; const TextureTarget: TGLTextureTarget]: Cardinal read
1176
GetUniformTextureHandle write SetUniformTextureHandle;
1177
property UniformBuffer[const index: string]: TGLUniformBufferHandle write
1181
// TGLContextNotification
1183
TGLContextNotification = record
1185
event: TNotifyEvent;
1188
// TGLContextManager
1190
{ Stores and manages all the TGLContext objects. }1191
TGLContextManager = class
1195
FTerminated: Boolean;
1196
FNotifications: array of TGLContextNotification;
1197
FCreatedRCCount: Integer;
1199
{$IFNDEF GLS_MULTITHREAD}1202
FHandles: TThreadList;
1203
{$ENDIF GLS_MULTITHREAD}1205
{$IFDEF GLS_SERVICE_CONTEXT}1207
FServiceStarter: TEvent;
1208
FThreadTask: TServiceContextTaskList;
1210
FServiceContext: TGLContext;
1216
procedure RegisterContext(aContext: TGLContext);
1217
procedure UnRegisterContext(aContext: TGLContext);
1219
procedure ContextCreatedBy(aContext: TGLContext);
1220
procedure DestroyingContextBy(aContext: TGLContext);
1222
{$IFDEF GLS_SERVICE_CONTEXT}1223
{ Create a special service and resource-keeper context. }1224
procedure CreateServiceContext;
1225
procedure QueueTaskDepleted; register;
1226
property ServiceStarter: TEvent read FServiceStarter;
1228
property ServiceContext: TGLContext read FServiceContext;
1232
destructor Destroy; override;
1234
{: Returns an appropriate, ready-to use context.1235
The returned context should be freed by caller. }
1236
function CreateContext(AClass: TGLContextClass = nil): TGLContext;
1238
{: Returns the number of TGLContext object.1239
This is *not* the number of OpenGL rendering contexts! }
1240
function ContextCount: Integer;
1241
{ Registers a new object to notify when the last context is destroyed.1242
When the last rendering context is destroyed, the 'anEvent' will
1243
be invoked with 'anObject' as parameter.
1244
Note that the registration is kept until the notification is triggered
1245
or a RemoveNotification on 'anObject' is issued. }
1246
procedure LastContextDestroyNotification(anObject: TObject; anEvent:
1248
{ Unregisters an object from the notification lists. }1249
procedure RemoveNotification(anObject: TObject);
1251
// Marks the context manager for termination
1252
procedure Terminate;
1254
{ Request all contexts to destroy all their handles. }1255
procedure DestroyAllHandles;
1257
{ Notify all contexts about necessity of handles preparation. }1258
procedure NotifyPreparationNeed;
1261
EGLContext = class(Exception);
1263
EPBuffer = class(Exception);
1265
EGLShader = class(EGLContext);
1267
{ Drivers should register themselves via this function. }1268
procedure RegisterGLContextClass(aGLContextClass: TGLContextClass);
1269
{ The TGLContext that is the currently active context, if any.1270
Returns nil if no context is active. }
1271
function CurrentGLContext: TGLContext;
1272
function SafeCurrentGLContext: TGLContext;
1273
function GL: TGLExtensionsAndEntryPoints;
1274
function IsMainThread: Boolean;
1275
function IsServiceContextAvaible: Boolean;
1276
function GetServiceWindow: TForm;
1277
{$IFDEF GLS_SERVICE_CONTEXT}1278
procedure AddTaskForServiceContext(ATask: TTaskProcedure; FinishEvent: TFinishTaskEvent = nil);
1282
cIncompatibleContexts = 'Incompatible contexts';
1283
cDeleteContextFailed = 'Delete context failed';
1284
cContextActivationFailed = 'Context activation failed: %X, %s';
1285
cContextDeactivationFailed = 'Context deactivation failed';
1286
cUnableToCreateLegacyContext = 'Unable to create legacy context';
1287
cNoActiveRC = 'No active rendering context';
1288
glsFailedToShare = 'DoCreateContext - Failed to share contexts';
1291
GLContextManager: TGLContextManager;
1292
vIgnoreOpenGLErrors: Boolean = False;
1293
vContextActivationFailureOccurred: Boolean = false;
1294
vMultitextureCoordinatorClass: TAbstractMultitextureCoordinatorClass;
1296
// ------------------------------------------------------------------
1297
// ------------------------------------------------------------------
1298
// ------------------------------------------------------------------
1300
// ------------------------------------------------------------------
1301
// ------------------------------------------------------------------
1302
// ------------------------------------------------------------------
1305
cCannotAlterAnActiveContext = 'Cannot alter an active context';
1306
cInvalidContextRegistration = 'Invalid context registration';
1307
cInvalidNotificationRemoval = 'Invalid notification removal';
1308
cContextAlreadyCreated = 'Context already created';
1309
cContextNotCreated = 'Context not created';
1310
cUnbalancedContexActivations = 'Unbalanced context activations';
1312
{$IFDEF GLS_SERVICE_CONTEXT}1314
// TServiceContextThread
1316
TServiceContextThread = class(TThread)
1320
FLastTaskStartTime: Double;
1323
procedure Execute; override;
1324
procedure DoCreateServiceContext; stdcall;
1327
destructor Destroy; override;
1332
vContextClasses: TList;
1333
GLwithoutContext: TGLExtensionsAndEntryPoints;
1334
vServiceWindow: TForm;
1335
{$IFDEF GLS_SERVICE_CONTEXT}1336
OldInitProc: Pointer;
1339
{$IFNDEF GLS_MULTITHREAD}1344
vGL: TGLExtensionsAndEntryPoints;
1345
vCurrentGLContext: TGLContext;
1346
vMainThread: Boolean;
1351
function CurrentGLContext: TGLContext;
1353
Result := vCurrentGLContext;
1356
function SafeCurrentGLContext: TGLContext;
1358
Result := CurrentGLContext;
1359
if not Assigned(Result) then
1361
{$IFDEF GLS_LOGGING}1362
GLSLogger.LogError(cNoActiveRC);
1368
function GL: TGLExtensionsAndEntryPoints;
1373
function IsMainThread: Boolean;
1375
Result := vMainThread;
1378
function IsServiceContextAvaible: Boolean;
1380
Result := GLContextManager.ServiceContext <> nil;
1383
function GetServiceWindow: TForm;
1385
Result := vServiceWindow;
1389
// RegisterGLContextClass
1392
procedure RegisterGLContextClass(aGLContextClass: TGLContextClass);
1394
if not Assigned(vContextClasses) then
1395
vContextClasses := TList.Create;
1396
vContextClasses.Add(aGLContextClass);
1399
constructor TAbstractMultitextureCoordinator.Create(AOwner: TGLContext);
1404
// ------------------
1405
// ------------------ TGLContext ------------------
1406
// ------------------
1411
constructor TGLContext.Create;
1414
{$IFDEF GLS_MULTITHREAD}1415
FLock := TCriticalSection.Create;
1421
FLayer := clMainPlane;
1423
{$IFNDEF GLS_MULTITHREAD}1424
FSharedContexts := TList.Create;
1426
FSharedContexts := TThreadList.Create;
1428
FSharedContexts.Add(Self);
1429
FAcceleration := chaUnknown;
1430
FGLStates := TGLStateCache.Create;
1431
FGL := TGLExtensionsAndEntryPoints.Create;
1432
FTransformation := TGLTransformation.Create;
1433
FTransformation.LoadMatricesEnabled := True;
1434
GLContextManager.RegisterContext(Self);
1435
FIsPraparationNeed := True;
1441
destructor TGLContext.Destroy;
1445
GLContextManager.UnRegisterContext(Self);
1449
FTransformation.Free;
1450
FSharedContexts.Free;
1451
{$IFDEF GLS_MULTITHREAD}1460
procedure TGLContext.SetColorBits(const aColorBits: Integer);
1463
raise EGLContext.Create(cCannotAlterAnActiveContext)
1465
FColorBits := aColorBits;
1471
procedure TGLContext.SetAlphaBits(const aAlphaBits: Integer);
1474
raise EGLContext.Create(cCannotAlterAnActiveContext)
1476
FAlphaBits := aAlphaBits;
1482
procedure TGLContext.SetDepthBits(const val: Integer);
1485
raise EGLContext.Create(cCannotAlterAnActiveContext)
1490
procedure TGLContext.SetLayer(const Value: TGLContextLayer);
1493
raise EGLContext.Create(cCannotAlterAnActiveContext)
1501
procedure TGLContext.SetStencilBits(const aStencilBits: Integer);
1504
raise EGLContext.Create(cCannotAlterAnActiveContext)
1506
FStencilBits := aStencilBits;
1512
procedure TGLContext.SetAccumBits(const aAccumBits: Integer);
1515
raise EGLContext.Create(cCannotAlterAnActiveContext)
1517
FAccumBits := aAccumBits;
1523
procedure TGLContext.SetAuxBuffers(const aAuxBuffers: Integer);
1526
raise EGLContext.Create(cCannotAlterAnActiveContext)
1528
FAuxBuffers := aAuxBuffers;
1534
procedure TGLContext.SetOptions(const aOptions: TGLRCOptions);
1537
raise EGLContext.Create(cCannotAlterAnActiveContext)
1539
FOptions := aOptions;
1545
procedure TGLContext.SetAntiAliasing(const val: TGLAntiAliasing);
1548
raise EGLContext.Create(cCannotAlterAnActiveContext)
1550
FAntiAliasing := val;
1556
procedure TGLContext.SetAcceleration(const val: TGLContextAcceleration);
1559
raise EGLContext.Create(cCannotAlterAnActiveContext)
1561
FAcceleration := val;
1567
function TGLContext.GetActive: Boolean;
1569
Result := (FActivationCount > 0);
1575
procedure TGLContext.SetActive(const aActive: Boolean);
1577
// activation/deactivation can be nested...
1578
while aActive <> Active do
1590
procedure TGLContext.CreateContext(ADeviceHandle: HDC);
1593
raise EGLContext.Create(cContextAlreadyCreated);
1594
DoCreateContext(ADeviceHandle);
1595
Manager.ContextCreatedBy(Self);
1598
// CreateMemoryContext
1601
procedure TGLContext.CreateMemoryContext(outputDevice: HWND;
1602
width, height: Integer; BufferCount: integer);
1605
raise EGLContext.Create(cContextAlreadyCreated);
1606
DoCreateMemoryContext(outputDevice, width, height, BufferCount);
1607
Manager.ContextCreatedBy(Self);
1610
// PrepareHandlesData
1613
procedure TGLContext.PrepareHandlesData;
1616
LHandle: TGLContextHandle;
1618
if vCurrentGLContext = Self then
1620
{$IFNDEF GLS_MULTITHREAD}1621
for i := Manager.FHandles.Count - 1 downto 0 do
1623
LHandle := TGLContextHandle(Manager.FHandles[i]);
1624
if Assigned(LHandle.FOnPrepare) then
1625
LHandle.FOnPrepare(Self);
1628
with Manager.FHandles.LockList do
1630
for i := Count - 1 downto 0 do
1632
LHandle := TGLContextHandle(Items[i]);
1633
if Assigned(LHandle.FOnPrepare) then
1634
LHandle.FOnPrepare(Self);
1637
Manager.FHandles.UnlockList;
1640
FIsPraparationNeed := False;
1644
// PropagateSharedContext
1647
procedure TGLContext.PropagateSharedContext;
1650
otherContext: TGLContext;
1653
{$IFNDEF GLS_MULTITHREAD}1654
with FSharedContexts do
1656
for i := 1 to Count - 1 do
1658
otherContext := TGLContext(Items[i]);
1659
otherList := otherContext.FSharedContexts;
1660
for J := 0 to otherList.Count - 1 do
1661
if IndexOf(otherList[J]) < 0 then
1664
for i := 1 to Count - 1 do
1666
otherContext := TGLContext(Items[i]);
1667
otherList := otherContext.FSharedContexts;
1668
if otherList.IndexOf(Self) < 0 then
1669
otherList.Add(Self);
1673
with FSharedContexts.LockList do
1675
for i := 1 to Count - 1 do
1677
otherContext := TGLContext(Items[i]);
1678
otherList := otherContext.FSharedContexts.LockList;
1679
for J := 0 to otherList.Count - 1 do
1680
if IndexOf(otherList[J]) < 0 then
1682
otherContext.FSharedContexts.UnlockList;
1684
for i := 1 to Count - 1 do
1686
otherContext := TGLContext(Items[i]);
1687
otherList := otherContext.FSharedContexts.LockList;
1688
if otherList.IndexOf(Self) < 0 then
1689
otherList.Add(Self);
1690
otherContext.FSharedContexts.UnlockList;
1693
FSharedContexts.UnlockList;
1701
procedure TGLContext.ShareLists(aContext: TGLContext);
1703
{$IFNDEF GLS_MULTITHREAD}1704
if FSharedContexts.IndexOf(aContext) < 0 then
1706
if DoShareLists(aContext) then
1708
FSharedContexts.Add(aContext);
1709
PropagateSharedContext;
1713
with FSharedContexts.LockList do
1715
if IndexOf(aContext) < 0 then
1717
if DoShareLists(aContext) then
1720
PropagateSharedContext;
1724
FSharedContexts.UnlockList;
1732
procedure TGLContext.DestroyAllHandles;
1738
{$IFNDEF GLS_MULTITHREAD}1739
for i := Manager.FHandles.Count - 1 downto 0 do
1740
TGLContextHandle(Manager.FHandles[i]).ContextDestroying;
1742
with Manager.FHandles.LockList do
1744
for i := Count - 1 downto 0 do
1745
TGLContextHandle(Items[i]).ContextDestroying;
1747
Manager.FHandles.UnlockList;
1758
procedure TGLContext.DestroyContext;
1761
oldContext, otherContext: TGLContext;
1762
contextHandle: TGLContextHandle;
1766
if vCurrentGLContext <> Self then
1768
oldContext := vCurrentGLContext;
1769
if Assigned(oldContext) then
1770
oldContext.Deactivate;
1777
{$IFNDEF GLS_MULTITHREAD}1778
for i := Manager.FHandles.Count - 1 downto 0 do
1780
contextHandle := TGLContextHandle(Manager.FHandles[i]);
1781
contextHandle.ContextDestroying;
1784
aList := Manager.FHandles.LockList;
1786
for i := aList.Count - 1 downto 0 do
1788
contextHandle := TGLContextHandle(aList[i]);
1789
contextHandle.ContextDestroying;
1792
Manager.FHandles.UnlockList;
1795
Manager.DestroyingContextBy(Self);
1797
{$IFDEF GLS_MULTITHREAD}1798
aList := FSharedContexts.LockList;
1800
aList := FSharedContexts;
1802
for I := 1 to aList.Count - 1 do
1804
otherContext := TGLContext(aList[I]);
1805
otherContext.FSharedContexts.Remove(Self);
1807
FSharedContexts.Clear;
1808
FSharedContexts.Add(Self);
1809
{$IFDEF GLS_MULTITHREAD}1810
FSharedContexts.UnlockList;
1815
if Assigned(oldContext) then
1816
oldContext.Activate;
1818
FAcceleration := chaUnknown;
1825
procedure TGLContext.Activate;
1827
{$IFDEF GLS_MULTITHREAD}1830
if FActivationCount = 0 then
1833
raise EGLContext.Create(cContextNotCreated);
1835
vContextActivationFailureOccurred := False;
1839
vContextActivationFailureOccurred := True;
1842
vCurrentGLContext := Self;
1845
Assert(vCurrentGLContext = Self, 'vCurrentGLContext <> Self');
1846
Inc(FActivationCount);
1852
procedure TGLContext.Deactivate;
1854
Assert(vCurrentGLContext = Self);
1855
Dec(FActivationCount);
1856
if FActivationCount = 0 then
1859
raise EGLContext.Create(cContextNotCreated);
1860
if not vContextActivationFailureOccurred then
1862
vCurrentGLContext := nil;
1863
vGL := GLwithoutContext;
1865
else if FActivationCount < 0 then
1866
raise EGLContext.Create(cUnbalancedContexActivations);
1867
{$IFDEF GLS_MULTITHREAD}1872
// FindCompatibleContext
1875
function TGLContext.FindCompatibleContext: TGLContext;
1880
{$IFNDEF GLS_MULTITHREAD}1881
for i := 0 to FSharedContexts.Count - 1 do
1882
if TGLContext(FSharedContexts[i]) <> Self then
1884
Result := TGLContext(FSharedContexts[i]);
1888
with FSharedContexts.LockList do
1890
for i := 0 to Count - 1 do
1891
if TGLContext(Items[i]) <> Self then
1893
Result := TGLContext(Items[i]);
1897
FSharedContexts.UnlockList;
1902
class function TGLContext.ServiceContext: TGLContext;
1904
Result := GLContextManager.FServiceContext;
1907
procedure TGLContext.MakeGLCurrent;
1912
function TGLContext.GetXGL: TAbstractMultitextureCoordinator;
1915
FXGL := vMultitextureCoordinatorClass.Create(Self);
1919
// ------------------
1920
// ------------------ TGLContextHandle ------------------
1921
// ------------------
1926
constructor TGLContextHandle.Create;
1929
FHandles := TList.Create;
1930
//first is a dummy record
1932
FillChar(FLastHandle^, sizeof(FLastHandle^), 0);
1933
FHandles.Add(FLastHandle);
1934
GLContextManager.FHandles.Add(Self);
1940
constructor TGLContextHandle.CreateAndAllocate(failIfAllocationFailed: Boolean =
1945
if failIfAllocationFailed and (Handle = 0) then
1946
raise EGLContext.Create('Auto-allocation failed');1952
destructor TGLContextHandle.Destroy;
1957
for i := 0 to FHandles.Count-1 do
1960
if Assigned(GLContextManager) then
1961
GLContextManager.FHandles.Remove(Self);
1968
function TGLContextHandle.AllocateHandle: TGLuint;
1976
// if handle aready allocated in current context
1977
Result := GetHandle;
1981
if vCurrentGLContext = nil then
1983
GLSLogger.LogError('Failed to allocate OpenGL identifier - no active rendering context!');1989
FillChar(FLastHandle^, sizeof(FLastHandle^), 0);
1990
FHandles.Add(FLastHandle);
1991
FLastHandle.FRenderingContext := vCurrentGLContext;
1994
if Transferable then
1996
{$IFNDEF GLS_MULTITHREAD}1997
aList := vCurrentGLContext.FSharedContexts;
1999
aList := vCurrentGLContext.FSharedContexts.LockList;
2002
for I := aList.Count - 1 downto 0 do
2004
P := SearchRC(aList[I]);
2005
if (P.FHandle > 0) then
2007
// Copy shared handle
2008
//FLastHandle.FRenderingContext := vCurrentGLContext;
2009
FLastHandle.FHandle := P.FHandle;
2010
FLastHandle.FChanged := P.FChanged;
2011
Inc(vCurrentGLContext.FOwnedHandlesCount);
2016
{$IFNDEF GLS_MULTITHREAD}2019
vCurrentGLContext.FSharedContexts.UnlockList;
2026
// Allocate handle in current context
2027
FLastHandle.FHandle := DoAllocateHandle;
2028
bSucces := FLastHandle.FHandle <> 0;
2029
FLastHandle.FChanged := bSucces;
2031
Inc(vCurrentGLContext.FOwnedHandlesCount);
2034
Result := FLastHandle.FHandle;
2036
GLSLogger.LogError(cNoActiveRC)
2037
else if Assigned(FOnPrepare) then
2038
GLContextManager.NotifyPreparationNeed;
2041
function TGLContextHandle.IsAllocatedForContext(AContext: TGLContext = nil): Boolean;
2043
Result := SearchRC(AContext).FHandle > 0;
2046
function TGLContextHandle.SearchRC(AContext: TGLContext): PGLRCHandle;
2050
if AContext = nil then
2051
AContext := vCurrentGLContext;
2053
if AContext = FLastHandle.FRenderingContext then
2055
Result := FLastHandle;
2059
for i := 1 to FHandles.Count-1 do
2060
if RCItem(i).FRenderingContext = AContext then
2062
Result := RCItem(i);
2066
//first handle is always a dummy
2067
Result := FHandles[0];
2070
procedure TGLContextHandle.CheckCurrentRC;
2072
if vCurrentGLContext <> FLastHandle.FRenderingContext then
2073
FLastHandle := SearchRC(vCurrentGLContext);
2076
function TGLContextHandle.GetHandle: TGLuint;
2079
//inline doesn't always work... so optimize it here
2080
if vCurrentGLContext <> FLastHandle.FRenderingContext then
2081
FLastHandle := SearchRC(vCurrentGLContext);
2083
Result := FLastHandle.FHandle;
2089
procedure TGLContextHandle.DestroyHandle;
2091
oldContext: TGLContext;
2095
oldContext := vCurrentGLContext;
2096
if Assigned(oldContext) then
2097
oldContext.Deactivate;
2099
for I := FHandles.Count-1 downto 1 do
2102
if P.FHandle > 0 then
2104
P.FRenderingContext.Activate;
2105
if IsValid(P.FHandle) then
2106
DoDestroyHandle(P.FHandle);
2107
Dec(P.FRenderingContext.FOwnedHandlesCount);
2108
P.FRenderingContext.Deactivate;
2109
P.FRenderingContext := nil;
2115
FHandles.Count := 1; //delete all in 1 step
2116
FLastHandle := FHandles[0];
2118
if Assigned(vCurrentGLContext) then
2119
vCurrentGLContext.Deactivate;
2120
if Assigned(oldContext) then
2121
oldContext.Activate;
2128
procedure TGLContextHandle.ContextDestroying;
2135
if Assigned(vCurrentGLContext) then
2138
if Transferable then
2140
{$IFNDEF GLS_MULTITHREAD}2141
aList := vCurrentGLContext.FSharedContexts;
2143
aList := vCurrentGLContext.FSharedContexts.LockList;
2145
{$ENDIF GLS_MULTITHREAD}2146
for I := FHandles.Count-1 downto 1 do
2149
if (P.FRenderingContext <> vCurrentGLContext)
2150
and (P.FHandle <> 0)
2151
and (aList.IndexOf(P.FRenderingContext) > -1) then
2157
{$IFDEF GLS_MULTITHREAD}2159
vCurrentGLContext.FSharedContexts.UnLockList;
2161
{$ENDIF GLS_MULTITHREAD}2164
for I := FHandles.Count-1 downto 1 do
2167
if (P.FRenderingContext = vCurrentGLContext) and (P.FHandle <> 0) then
2170
if IsValid(P.FHandle) then
2171
DoDestroyHandle(P.FHandle);
2172
Dec(P.FRenderingContext.FOwnedHandlesCount);
2174
P.FRenderingContext := nil;
2178
if FLastHandle = P then
2179
FLastHandle := FHandles[0];
2186
function TGLContextHandle.GetContext: TGLContext;
2192
// Return first context where handle is allocated
2193
for I := FHandles.Count-1 downto 1 do
2196
if (P.FRenderingContext <> nil) and (P.FHandle <> 0) then
2198
Result := P.FRenderingContext;
2199
// If handle allocated in active context - return it
2200
if (Result = vCurrentGLContext) then
2206
function TGLContextHandle.IsDataNeedUpdate: Boolean;
2208
if GetHandle = 0 then
2210
Result := (FLastHandle.FHandle = 0) or FLastHandle.FChanged;
2213
function TGLContextHandle.IsDataComplitelyUpdated: Boolean;
2218
for I := FHandles.Count-1 downto 1 do
2221
if (FRenderingContext <> nil) and (FHandle <> 0) and FChanged then exit;
2226
procedure TGLContextHandle.NotifyDataUpdated;
2231
if Assigned(vCurrentGLContext) then
2233
if not Transferable then
2236
if FLastHandle.FHandle <> 0 then
2238
FLastHandle.FChanged := False;
2244
{$IFNDEF GLS_MULTITHREAD}2245
aList := vCurrentGLContext.FSharedContexts;
2247
aList := vCurrentGLContext.FSharedContexts.LockList;
2250
for I := 0 to aList.Count - 1 do
2252
with SearchRC(aList[I])^ do
2253
if (FHandle <> 0) then
2256
{$IFDEF GLS_MULTITHREAD}2258
vCurrentGLContext.FSharedContexts.UnlockList;
2264
GLSLogger.LogError(cNoActiveRC);
2267
function TGLContextHandle.RCItem(AIndex: integer): PGLRCHandle;
2269
Result := FHandles[AIndex];
2272
procedure TGLContextHandle.NotifyChangesOfData;
2276
for I := FHandles.Count-1 downto 1 do
2277
RCItem(I).FChanged := True;
2278
if Assigned(FOnPrepare) then
2279
GLContextManager.NotifyPreparationNeed;
2282
function TGLContextHandle.IsShared: Boolean;
2285
vContext: TGLContext;
2289
// untransferable handles can't be shared
2290
if not Transferable then
2293
{$IFNDEF GLS_MULTITHREAD}2294
aList := vCurrentGLContext.FSharedContexts;
2296
aList := vCurrentGLContext.FSharedContexts.LockList;
2299
for I := 0 to aList.Count - 1 do
2301
vContext := aList[I];
2302
if (vContext <> vCurrentGLContext) and
2303
// at least one context is friendly
2304
(SearchRC(vContext).FHandle <> 0) then
2307
{$IFDEF GLS_MULTITHREAD}2309
vCurrentGLContext.FSharedContexts.UnlockList;
2318
class function TGLContextHandle.Transferable: Boolean;
2323
class function TGLContextHandle.IsValid(const ID: GLuint): Boolean;
2330
class function TGLContextHandle.IsSupported: Boolean;
2335
// ------------------
2336
// ------------------ TGLVirtualHandle ------------------
2337
// ------------------
2342
function TGLVirtualHandle.DoAllocateHandle: Cardinal;
2345
if Assigned(FOnAllocate) then
2346
FOnAllocate(Self, Result);
2352
procedure TGLVirtualHandle.DoDestroyHandle(var AHandle: TGLuint);
2354
if not vContextActivationFailureOccurred then
2357
// reset error status
2360
if Assigned(FOnDestroy) then
2361
FOnDestroy(Self, AHandle);
2367
class function TGLVirtualHandle.Transferable: Boolean;
2372
{ TGLVirtualHandleTransf }2374
class function TGLVirtualHandleTransf.Transferable: Boolean;
2379
// ------------------
2380
// ------------------ TGLListHandle ------------------
2381
// ------------------
2386
function TGLListHandle.DoAllocateHandle: Cardinal;
2388
Result := GL.GenLists(1);
2394
procedure TGLListHandle.DoDestroyHandle(var AHandle: TGLuint);
2396
if not vContextActivationFailureOccurred then
2399
// reset error status
2402
DeleteLists(AHandle, 1);
2411
class function TGLListHandle.IsValid(const ID: GLuint): Boolean;
2413
Result := GL.IsList(ID);
2419
procedure TGLListHandle.NewList(mode: Cardinal);
2421
vCurrentGLContext.GLStates.NewList(GetHandle, mode);
2427
procedure TGLListHandle.EndList;
2429
vCurrentGLContext.GLStates.EndList;
2435
procedure TGLListHandle.CallList;
2437
vCurrentGLContext.GLStates.CallList(GetHandle);
2440
// ------------------
2441
// ------------------ TGLTextureHandle ------------------
2442
// ------------------
2447
function TGLTextureHandle.DoAllocateHandle: Cardinal;
2450
GL.GenTextures(1, @Result);
2451
FTarget := ttNoShape;
2457
procedure TGLTextureHandle.DoDestroyHandle(var AHandle: TGLuint);
2460
t: TGLTextureTarget;
2462
if not vContextActivationFailureOccurred then
2465
// reset error status
2467
{ Unbind identifier from all image selectors. }2468
if ARB_multitexture then
2470
with GetContext.GLStates do
2472
for a := 0 to MaxTextureImageUnits - 1 do
2473
for t := Low(TGLTextureTarget) to High(TGLTextureTarget) do
2474
if TextureBinding[a, t] = AHandle then
2475
TextureBinding[a, t] := 0;
2479
with GetContext.GLStates do
2480
for t := Low(TGLTextureTarget) to High(TGLTextureTarget) do
2481
if TextureBinding[0, t] = AHandle then
2482
TextureBinding[0, t] := 0;
2484
DeleteTextures(1, @AHandle);
2493
class function TGLTextureHandle.IsValid(const ID: GLuint): Boolean;
2495
Result := GL.IsTexture(ID);
2498
procedure TGLTextureHandle.SetTarget(ATarget: TGLTextureTarget);
2500
if FTarget = ttNoShape then
2504
// ------------------
2505
// ------------------ TGLSamplerHandle ------------------
2506
// ------------------
2511
function TGLSamplerHandle.DoAllocateHandle: Cardinal;
2514
GL.GenSamplers(1, @Result);
2520
procedure TGLSamplerHandle.DoDestroyHandle(var AHandle: TGLuint);
2522
if not vContextActivationFailureOccurred then
2525
// reset error status
2528
DeleteSamplers(1, @AHandle);
2537
class function TGLSamplerHandle.IsSupported: Boolean;
2539
Result := GL.ARB_sampler_objects;
2545
class function TGLSamplerHandle.IsValid(const ID: GLuint): Boolean;
2547
Result := GL.IsSampler(ID);
2550
// ------------------
2551
// ------------------ TGLQueryHandle ------------------
2552
// ------------------
2557
procedure TGLQueryHandle.BeginQuery;
2559
if vCurrentGLContext.GLStates.CurrentQuery[QueryType] = 0 then
2560
vCurrentGLContext.GLStates.BeginQuery(QueryType, GetHandle);
2567
function TGLQueryHandle.CounterBits: integer;
2569
GL.GetQueryiv(Target, GL_QUERY_COUNTER_BITS, @Result);
2575
function TGLQueryHandle.DoAllocateHandle: Cardinal;
2578
GL.GenQueries(1, @Result);
2584
procedure TGLQueryHandle.DoDestroyHandle(var AHandle: TGLuint);
2586
if not vContextActivationFailureOccurred then
2589
// reset error status
2592
DeleteQueries(1, @AHandle);
2601
class function TGLQueryHandle.IsValid(const ID: GLuint): Boolean;
2603
Result := GL.IsQuery(ID);
2609
procedure TGLQueryHandle.EndQuery;
2611
Assert(FActive = true, 'Cannot end a query before it begins');
2613
Assert(Handle <> 0);
2614
//glEndQuery(Target);
2615
vCurrentGLContext.GLStates.EndQuery(QueryType);
2621
function TGLQueryHandle.IsResultAvailable: boolean;
2623
GL.GetQueryObjectiv(Handle, GL_QUERY_RESULT_AVAILABLE, @Result);
2629
function TGLQueryHandle.QueryResultInt: TGLInt;
2631
GL.GetQueryObjectiv(Handle, GL_QUERY_RESULT, @Result);
2637
function TGLQueryHandle.QueryResultInt64: TGLint64EXT;
2639
GL.GetQueryObjecti64v(Handle, GL_QUERY_RESULT, @Result);
2645
function TGLQueryHandle.QueryResultUInt: TGLUInt;
2647
GL.GetQueryObjectuiv(Handle, GL_QUERY_RESULT, @Result);
2653
function TGLQueryHandle.QueryResultUInt64: TGLuint64EXT;
2655
GL.GetQueryObjectui64v(Handle, GL_QUERY_RESULT, @Result);
2658
function TGLQueryHandle.QueryResultBool: TGLboolean;
2662
GL.GetQueryObjectuiv(Handle, GL_QUERY_RESULT, @I);
2669
class function TGLQueryHandle.Transferable: Boolean;
2674
// ------------------
2675
// ------------------ TGLOcclusionQueryHandle ------------------
2676
// ------------------
2681
function TGLOcclusionQueryHandle.GetQueryType: TQueryType;
2683
Result := qrySamplesPassed;
2689
function TGLOcclusionQueryHandle.GetTarget: TGLuint;
2691
Result := GL_SAMPLES_PASSED;
2697
class function TGLOcclusionQueryHandle.IsSupported: Boolean;
2699
Result := GL.VERSION_1_5;
2705
function TGLOcclusionQueryHandle.PixelCount: Integer;
2707
Result := QueryResultUInt;
2710
// ------------------
2711
// ------------------ TGLBooleanOcclusionQueryHandle ------------------
2712
// ------------------
2717
function TGLBooleanOcclusionQueryHandle.GetQueryType: TQueryType;
2719
Result := qryAnySamplesPassed;
2725
function TGLBooleanOcclusionQueryHandle.GetTarget: TGLuint;
2727
Result := GL_ANY_SAMPLES_PASSED;
2733
class function TGLBooleanOcclusionQueryHandle.IsSupported: Boolean;
2735
Result := GL.ARB_occlusion_query2;
2738
// ------------------
2739
// ------------------ TGLTimerQueryHandle ------------------
2740
// ------------------
2745
function TGLTimerQueryHandle.GetQueryType: TQueryType;
2747
Result := qryTimeElapsed;
2750
function TGLTimerQueryHandle.GetTarget: TGLuint;
2752
Result := GL_TIME_ELAPSED;
2758
class function TGLTimerQueryHandle.IsSupported: Boolean;
2760
Result := GL.EXT_timer_query or GL.ARB_timer_query;
2766
function TGLTimerQueryHandle.Time: Integer;
2768
Result := QueryResultUInt;
2771
// ------------------
2772
// ------------------ TGLPrimitiveQueryHandle ------------------
2773
// ------------------
2778
function TGLPrimitiveQueryHandle.GetQueryType: TQueryType;
2780
Result := qryPrimitivesGenerated;
2786
function TGLPrimitiveQueryHandle.GetTarget: TGLuint;
2788
Result := GL_PRIMITIVES_GENERATED;
2794
class function TGLPrimitiveQueryHandle.IsSupported: Boolean;
2796
Result := GL.VERSION_3_0;
2799
// PrimitivesGenerated
2802
function TGLPrimitiveQueryHandle.PrimitivesGenerated: Integer;
2804
Result := QueryResultUInt;
2807
// ------------------
2808
// ------------------ TGLBufferObjectHandle ------------------
2809
// ------------------
2814
constructor TGLBufferObjectHandle.CreateFromData(p: Pointer; size: Integer;
2815
bufferUsage: TGLuint);
2820
BufferData(p, size, bufferUsage);
2827
function TGLBufferObjectHandle.DoAllocateHandle: Cardinal;
2830
GL.GenBuffers(1, @Result);
2836
procedure TGLBufferObjectHandle.DoDestroyHandle(var AHandle: TGLuint);
2838
if not vContextActivationFailureOccurred then
2841
// reset error status
2845
DeleteBuffers(1, @AHandle);
2854
class function TGLBufferObjectHandle.IsValid(const ID: GLuint): Boolean;
2856
Result := GL.IsBuffer(ID);
2862
class function TGLBufferObjectHandle.IsSupported: Boolean;
2864
Result := GL.ARB_vertex_buffer_object;
2870
procedure TGLBufferObjectHandle.BindRange(index: TGLuint; offset: TGLintptr;
2873
Assert(False, 'BindRange only XBO and UBO');
2879
procedure TGLBufferObjectHandle.BindBase(index: TGLuint);
2881
Assert(False, 'BindRange only XBO and UBO');
2887
procedure TGLBufferObjectHandle.UnBindBase(index: TGLuint);
2889
Assert(False, 'BindRange only XBO and UBO');
2895
procedure TGLBufferObjectHandle.BufferData(p: Pointer; size: Integer;
2896
bufferUsage: TGLuint);
2899
GL.BufferData(Target, size, p, bufferUsage);
2905
procedure TGLBufferObjectHandle.BindBufferData(p: Pointer; size: Integer;
2906
bufferUsage: TGLuint);
2910
GL.BufferData(Target, size, p, bufferUsage);
2916
procedure TGLBufferObjectHandle.BufferSubData(offset, size: Integer; p:
2919
Assert(offset + size <= FSize);
2920
GL.BufferSubData(Target, offset, size, p);
2926
function TGLBufferObjectHandle.MapBuffer(access: TGLuint): Pointer;
2928
Result := GL.MapBuffer(Target, access);
2934
function TGLBufferObjectHandle.MapBufferRange(offset: TGLint; len: TGLsizei;
2935
access: TGLbitfield): Pointer;
2937
Result := GL.MapBufferRange(Target, offset, len, access);
2943
procedure TGLBufferObjectHandle.Flush(offset: TGLint; len: TGLsizei);
2945
GL.FlushMappedBufferRange(Target, offset, len);
2951
function TGLBufferObjectHandle.UnmapBuffer: Boolean;
2953
Result := GL.UnmapBuffer(Target);
2956
// ------------------
2957
// ------------------ TGLVBOHandle ------------------
2958
// ------------------
2963
function TGLVBOHandle.GetVBOTarget: TGLuint;
2968
// ------------------
2969
// ------------------ TGLVBOArrayBufferHandle ------------------
2970
// ------------------
2972
procedure TGLVBOArrayBufferHandle.Bind;
2974
vCurrentGLContext.GLStates.ArrayBufferBinding := Handle;
2977
procedure TGLVBOArrayBufferHandle.UnBind;
2979
vCurrentGLContext.GLStates.ArrayBufferBinding := 0;
2985
function TGLVBOArrayBufferHandle.GetTarget: TGLuint;
2987
Result := GL_ARRAY_BUFFER;
2990
// ------------------
2991
// ------------------ TGLVBOElementArrayHandle ------------------
2992
// ------------------
2994
procedure TGLVBOElementArrayHandle.Bind;
2996
vCurrentGLContext.GLStates.ElementBufferBinding := Handle;
2999
procedure TGLVBOElementArrayHandle.UnBind;
3001
vCurrentGLContext.GLStates.ElementBufferBinding := 0;
3007
function TGLVBOElementArrayHandle.GetTarget: TGLuint;
3009
Result := GL_ELEMENT_ARRAY_BUFFER;
3012
// ------------------
3013
// ------------------ TGLPackPBOHandle ------------------
3014
// ------------------
3016
procedure TGLPackPBOHandle.Bind;
3018
vCurrentGLContext.GLStates.PixelPackBufferBinding := Handle;
3021
procedure TGLPackPBOHandle.UnBind;
3023
vCurrentGLContext.GLStates.PixelPackBufferBinding := 0;
3029
function TGLPackPBOHandle.GetTarget: TGLuint;
3031
Result := GL_PIXEL_PACK_BUFFER;
3037
class function TGLPackPBOHandle.IsSupported: Boolean;
3039
Result := GL.ARB_pixel_buffer_object;
3042
// ------------------
3043
// ------------------ TGLUnpackPBOHandle ------------------
3044
// ------------------
3046
procedure TGLUnpackPBOHandle.Bind;
3048
vCurrentGLContext.GLStates.PixelUnpackBufferBinding := Handle;
3051
procedure TGLUnpackPBOHandle.UnBind;
3053
vCurrentGLContext.GLStates.PixelUnpackBufferBinding := 0;
3059
function TGLUnpackPBOHandle.GetTarget: TGLuint;
3061
Result := GL_PIXEL_UNPACK_BUFFER;
3067
class function TGLUnpackPBOHandle.IsSupported: Boolean;
3069
Result := GL.ARB_pixel_buffer_object;
3072
// ------------------
3073
// ------------------ TGLTransformFeedbackBufferHandle ------------------
3074
// ------------------
3079
procedure TGLTransformFeedbackBufferHandle.Bind;
3081
vCurrentGLContext.GLStates.TransformFeedbackBufferBinding := Handle;
3084
procedure TGLTransformFeedbackBufferHandle.UnBind;
3086
vCurrentGLContext.GLStates.TransformFeedbackBufferBinding := 0;
3089
function TGLTransformFeedbackBufferHandle.GetTarget: TGLuint;
3091
Result := GL_TRANSFORM_FEEDBACK_BUFFER;
3094
// BeginTransformFeedback
3097
procedure TGLTransformFeedbackBufferHandle.BeginTransformFeedback(primitiveMode:
3100
GL.BeginTransformFeedback(primitiveMode);
3103
// EndTransformFeedback
3106
procedure TGLTransformFeedbackBufferHandle.EndTransformFeedback();
3108
GL.EndTransformFeedback();
3111
procedure TGLTransformFeedbackBufferHandle.BindRange(index: TGLuint; offset: TGLintptr;
3114
vCurrentGLContext.GLStates.SetBufferIndexedBinding(Handle, bbtTransformFeedBack,
3115
index, offset, size);
3118
procedure TGLTransformFeedbackBufferHandle.BindBase(index: TGLuint);
3120
vCurrentGLContext.GLStates.SetBufferIndexedBinding(Handle, bbtTransformFeedBack,
3124
procedure TGLTransformFeedbackBufferHandle.UnBindBase(index: TGLuint);
3126
vCurrentGLContext.GLStates.SetBufferIndexedBinding(0, bbtTransformFeedBack,
3133
class function TGLTransformFeedbackBufferHandle.IsSupported: Boolean;
3135
Result := GL.EXT_transform_feedback or GL.VERSION_3_0;
3138
// ------------------
3139
// ------------------ TGLTextureBufferHandle ------------------
3140
// ------------------
3142
procedure TGLTextureBufferHandle.Bind;
3144
vCurrentGLContext.GLStates.TextureBufferBinding := Handle;
3147
procedure TGLTextureBufferHandle.UnBind;
3149
vCurrentGLContext.GLStates.TextureBufferBinding := 0;
3155
function TGLTextureBufferHandle.GetTarget: TGLuint;
3157
Result := GL_TEXTURE_BUFFER;
3163
class function TGLTextureBufferHandle.IsSupported: Boolean;
3165
Result := GL.EXT_texture_buffer_object or GL.ARB_texture_buffer_object or
3169
// ------------------
3170
// ------------------ TGLUniformBufferHandle ------------------
3171
// ------------------
3173
procedure TGLUniformBufferHandle.Bind;
3175
vCurrentGLContext.GLStates.UniformBufferBinding := Handle;
3178
procedure TGLUniformBufferHandle.UnBind;
3180
vCurrentGLContext.GLStates.UniformBufferBinding := 0;
3183
procedure TGLUniformBufferHandle.BindRange(index: TGLuint; offset: TGLintptr;
3186
vCurrentGLContext.GLStates.SetBufferIndexedBinding(Handle, bbtUniform,
3187
index, offset, size);
3190
procedure TGLUniformBufferHandle.BindBase(index: TGLuint);
3192
vCurrentGLContext.GLStates.SetBufferIndexedBinding(Handle, bbtUniform,
3196
procedure TGLUniformBufferHandle.UnBindBase(index: TGLuint);
3198
vCurrentGLContext.GLStates.SetBufferIndexedBinding(0, bbtUniform,
3205
function TGLUniformBufferHandle.GetTarget: TGLuint;
3207
Result := GL_UNIFORM_BUFFER;
3213
class function TGLUniformBufferHandle.IsSupported: Boolean;
3215
Result := GL.ARB_uniform_buffer_object;
3218
// ------------------
3219
// ------------------ TGLVertexArrayHandle ------------------
3220
// ------------------
3225
function TGLVertexArrayHandle.DoAllocateHandle: Cardinal;
3228
GL.GenVertexArrays(1, @Result);
3234
procedure TGLVertexArrayHandle.DoDestroyHandle(var AHandle: TGLuint);
3236
if not vContextActivationFailureOccurred then
3239
// reset error status
3242
DeleteVertexArrays(1, @AHandle);
3251
class function TGLVertexArrayHandle.IsValid(const ID: GLuint): Boolean;
3253
Result := GL.IsVertexArray(ID);
3259
procedure TGLVertexArrayHandle.Bind;
3261
Assert(vCurrentGLContext <> nil);
3262
vCurrentGLContext.GLStates.VertexArrayBinding := Handle;
3268
procedure TGLVertexArrayHandle.UnBind;
3270
Assert(vCurrentGLContext <> nil);
3271
vCurrentGLContext.GLStates.VertexArrayBinding := 0;
3277
class function TGLVertexArrayHandle.IsSupported: Boolean;
3279
Result := GL.ARB_vertex_array_object;
3285
class function TGLVertexArrayHandle.Transferable: Boolean;
3290
// ------------------
3291
// ------------------ TGLFramebufferHandle ------------------
3292
// ------------------
3297
function TGLFramebufferHandle.DoAllocateHandle: Cardinal;
3300
GL.GenFramebuffers(1, @Result)
3306
procedure TGLFramebufferHandle.DoDestroyHandle(var AHandle: TGLuint);
3308
if not vContextActivationFailureOccurred then
3311
// reset error status
3314
DeleteFramebuffers(1, @AHandle);
3323
class function TGLFramebufferHandle.IsValid(const ID: GLuint): Boolean;
3325
Result := GL.IsFramebuffer(ID);
3331
procedure TGLFramebufferHandle.Bind;
3333
Assert(vCurrentGLContext <> nil);
3334
vCurrentGLContext.GLStates.SetFrameBuffer(Handle);
3340
procedure TGLFramebufferHandle.BindForDrawing;
3342
Assert(vCurrentGLContext <> nil);
3343
vCurrentGLContext.GLStates.DrawFrameBuffer := Handle;
3349
procedure TGLFramebufferHandle.BindForReading;
3351
Assert(vCurrentGLContext <> nil);
3352
vCurrentGLContext.GLStates.ReadFrameBuffer := Handle;
3358
procedure TGLFramebufferHandle.UnBind;
3360
Assert(vCurrentGLContext <> nil);
3361
vCurrentGLContext.GLStates.SetFrameBuffer(0);
3367
procedure TGLFramebufferHandle.UnBindForDrawing;
3369
Assert(vCurrentGLContext <> nil);
3370
vCurrentGLContext.GLStates.DrawFrameBuffer := 0;
3376
procedure TGLFramebufferHandle.UnBindForReading;
3378
Assert(vCurrentGLContext <> nil);
3379
vCurrentGLContext.GLStates.ReadFrameBuffer := 0;
3385
procedure TGLFramebufferHandle.Attach1DTexture(target: TGLenum; attachment:
3386
TGLenum; textarget: TGLenum; texture: TGLuint; level: TGLint);
3388
GL.FramebufferTexture1D(target, attachment, textarget, texture, level);
3394
procedure TGLFramebufferHandle.Attach2DTexture(target: TGLenum; attachment:
3395
TGLenum; textarget: TGLenum; texture: TGLuint; level: TGLint);
3397
GL.FramebufferTexture2D(target, attachment, textarget, texture, level);
3403
procedure TGLFramebufferHandle.Attach3DTexture(target: TGLenum; attachment:
3404
TGLenum; textarget: TGLenum; texture: TGLuint; level: TGLint; layer: TGLint);
3406
GL.FramebufferTexture3D(target, attachment, textarget, texture, level, layer);
3412
procedure TGLFramebufferHandle.AttachLayer(target: TGLenum; attachment: TGLenum;
3413
texture: TGLuint; level: TGLint; layer: TGLint);
3415
GL.FramebufferTextureLayer(target, attachment, texture, level, layer);
3418
// AttachRenderBuffer
3421
procedure TGLFramebufferHandle.AttachRenderBuffer(target: TGLenum; attachment:
3422
TGLenum; renderbuffertarget: TGLenum; renderbuffer: TGLuint);
3424
GL.FramebufferRenderbuffer(target, attachment, renderbuffertarget,
3431
procedure TGLFramebufferHandle.AttachTexture(target: TGLenum; attachment:
3432
TGLenum; texture: TGLuint; level: TGLint);
3434
GL.FramebufferTexture(target, attachment, texture, level);
3437
// AttachTextureLayer
3440
procedure TGLFramebufferHandle.AttachTextureLayer(target: TGLenum; attachment:
3441
TGLenum; texture: TGLuint; level: TGLint; layer: TGLint);
3443
GL.FramebufferTextureLayer(target, attachment, texture, level, layer);
3449
procedure TGLFramebufferHandle.Blit(srcX0: TGLint; srcY0: TGLint; srcX1: TGLint;
3451
dstX0: TGLint; dstY0: TGLint; dstX1: TGLint; dstY1: TGLint;
3452
mask: TGLbitfield; filter: TGLenum);
3454
GL.BlitFramebuffer(srcX0, srcY0, srcX1, srcY1, dstX0, dstY0, dstX1, dstY1,
3458
// GetAttachmentParameter
3461
function TGLFramebufferHandle.GetAttachmentParameter(target: TGLenum;
3462
attachment: TGLenum; pname: TGLenum): TGLint;
3464
GL.GetFramebufferAttachmentParameteriv(target, attachment, pname, @Result)
3467
// GetAttachmentObjectType
3470
function TGLFramebufferHandle.GetAttachmentObjectType(target: TGLenum;
3471
attachment: TGLenum): TGLint;
3473
GL.GetFramebufferAttachmentParameteriv(target, attachment,
3474
GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE, @Result);
3477
// GetAttachmentObjectName
3480
function TGLFramebufferHandle.GetAttachmentObjectName(target: TGLenum;
3481
attachment: TGLenum): TGLint;
3483
GL.GetFramebufferAttachmentParameteriv(target, attachment,
3484
GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME, @Result);
3490
function TGLFramebufferHandle.GetStatus: TGLFramebufferStatus;
3494
Status := GL.CheckFramebufferStatus(GL_FRAMEBUFFER);
3497
GL_FRAMEBUFFER_COMPLETE_EXT: Result := fsComplete;
3498
GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT: Result := fsIncompleteAttachment;
3499
GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT: Result :=
3500
fsIncompleteMissingAttachment;
3501
GL_FRAMEBUFFER_INCOMPLETE_DUPLICATE_ATTACHMENT_EXT: Result :=
3502
fsIncompleteDuplicateAttachment;
3503
GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT: Result := fsIncompleteDimensions;
3504
GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT: Result := fsIncompleteFormats;
3505
GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT: Result := fsIncompleteDrawBuffer;
3506
GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT: Result := fsIncompleteReadBuffer;
3507
GL_FRAMEBUFFER_UNSUPPORTED_EXT: Result := fsUnsupported;
3508
GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE: Result := fsIncompleteMultisample;
3510
Result := fsStatusError;
3514
function TGLFramebufferHandle.GetStringStatus(out clarification: string):
3515
TGLFramebufferStatus;
3517
cFBOStatus: array[TGLFramebufferStatus] of string = (
3519
'Incomplete attachment',
3520
'Incomplete missing attachment',
3521
'Incomplete duplicate attachment',
3522
'Incomplete dimensions',
3523
'Incomplete formats',
3524
'Incomplete draw buffer',
3525
'Incomplete read buffer',
3527
'Incomplite multisample',
3530
Result := GetStatus;
3531
clarification := cFBOStatus[Result];
3537
class function TGLFramebufferHandle.IsSupported: Boolean;
3539
Result := GL.EXT_framebuffer_object or GL.ARB_framebuffer_object;
3545
class function TGLFramebufferHandle.Transferable: Boolean;
3550
// ------------------
3551
// ------------------ TGLRenderbufferObject ------------------
3552
// ------------------
3557
function TGLRenderbufferHandle.DoAllocateHandle: Cardinal;
3560
GL.GenRenderbuffers(1, @Result);
3566
procedure TGLRenderbufferHandle.DoDestroyHandle(var AHandle: TGLuint);
3568
if not vContextActivationFailureOccurred then
3571
// reset error status
3574
DeleteRenderbuffers(1, @AHandle);
3583
class function TGLRenderbufferHandle.IsValid(const ID: GLuint): Boolean;
3585
Result := GL.IsRenderbuffer(ID);
3591
procedure TGLRenderbufferHandle.Bind;
3593
vCurrentGLContext.GLStates.RenderBuffer := GetHandle;
3599
procedure TGLRenderbufferHandle.UnBind;
3601
if vCurrentGLContext <> nil then
3602
vCurrentGLContext.GLStates.RenderBuffer := 0;
3608
procedure TGLRenderbufferHandle.SetStorage(internalformat: TGLenum; width,
3611
GL.RenderbufferStorage(GL_RENDERBUFFER, internalformat, width, height);
3614
// SetStorageMultisample
3617
procedure TGLRenderbufferHandle.SetStorageMultisample(internalformat: TGLenum;
3618
samples: TGLsizei; width, height: TGLsizei);
3620
GL.RenderbufferStorageMultisample(GL_RENDERBUFFER, samples, internalformat,
3627
class function TGLRenderbufferHandle.IsSupported: Boolean;
3629
Result := GL.EXT_framebuffer_object or GL.ARB_framebuffer_object;
3632
// ------------------
3633
// ------------------ TGLARBProgramHandle ------------------
3634
// ------------------
3639
function TGLARBProgramHandle.DoAllocateHandle: Cardinal;
3642
GL.GenPrograms(1, @Result);
3649
procedure TGLARBProgramHandle.DoDestroyHandle(var AHandle: TGLuint);
3651
if not vContextActivationFailureOccurred then
3654
// reset error status
3657
DeletePrograms(1, @AHandle);
3666
class function TGLARBProgramHandle.IsValid(const ID: GLuint): Boolean;
3668
Result := GL.IsProgram(ID);
3671
procedure TGLARBProgramHandle.LoadARBProgram(AText: string);
3673
cProgType: array[0..2] of string =
3674
('ARB vertex', 'ARB fragment', 'NV geometry');3679
GL.ProgramString(GetTarget, GL_PROGRAM_FORMAT_ASCII_ARB,
3680
Length(AText), PGLChar(TGLString(AText)));
3681
GL.GetIntegerv(GL_PROGRAM_ERROR_POSITION_ARB, @errPos);
3684
FInfoLog := string(GL.GetString(GL_PROGRAM_ERROR_STRING_ARB));
3686
GL_VERTEX_PROGRAM_ARB: P := 0;
3687
GL_FRAGMENT_PROGRAM_ARB: P := 1;
3691
GLSLogger.LogError(Format('%s Program Error - [Pos: %d][Error %s]', [cProgType[P], errPos, FInfoLog]));3701
procedure TGLARBProgramHandle.Enable;
3704
GL.Enable(GetTarget)
3709
procedure TGLARBProgramHandle.Disable;
3711
GL.Disable(GetTarget);
3714
procedure TGLARBProgramHandle.Bind;
3716
GL.BindProgram(GetTarget, Handle);
3719
class function TGLARBVertexProgramHandle.GetTarget: TGLenum;
3721
Result := GL_VERTEX_PROGRAM_ARB;
3724
class function TGLARBVertexProgramHandle.IsSupported: Boolean;
3726
Result := GL.ARB_vertex_program;
3729
class function TGLARBFragmentProgramHandle.GetTarget: TGLenum;
3731
Result := GL_FRAGMENT_PROGRAM_ARB;
3734
class function TGLARBFragmentProgramHandle.IsSupported: Boolean;
3736
Result := GL.ARB_vertex_program;
3739
class function TGLARBGeometryProgramHandle.GetTarget: TGLenum;
3741
Result := GL_GEOMETRY_PROGRAM_NV;
3744
class function TGLARBGeometryProgramHandle.IsSupported: Boolean;
3746
Result := GL.NV_geometry_program4;
3749
// ------------------
3750
// ------------------ TGLSLHandle ------------------
3751
// ------------------
3753
procedure TGLSLHandle.DoDestroyHandle(var AHandle: TGLuint);
3755
if not vContextActivationFailureOccurred then
3758
// reset error status
3761
DeleteObject(AHandle);
3770
function TGLSLHandle.InfoLog: string;
3776
GL.GetObjectParameteriv(GetHandle, GL_OBJECT_INFO_LOG_LENGTH_ARB, @maxLength);
3777
SetLength(log, maxLength);
3778
if maxLength > 0 then
3780
GL.GetInfoLog(GetHandle, maxLength, @maxLength, @log[1]);
3781
SetLength(log, maxLength);
3783
Result := string(log);
3789
class function TGLSLHandle.IsSupported: Boolean;
3791
Result := GL.ARB_shader_objects;
3794
// ------------------
3795
// ------------------ TGLShaderHandle ------------------
3796
// ------------------
3801
function TGLShaderHandle.DoAllocateHandle: Cardinal;
3803
Result := GL.CreateShader(FShaderType)
3809
class function TGLShaderHandle.IsValid(const ID: GLuint): Boolean;
3811
Result := GL.IsShader(ID);
3817
procedure TGLShaderHandle.ShaderSource(const source: AnsiString);
3821
p := PGLChar(TGLString(source));
3822
GL.ShaderSource(GetHandle, 1, @p, nil);
3828
function TGLShaderHandle.CompileShader: Boolean;
3834
GL.CompileShader(glH);
3836
GL.GetShaderiv(glH, GL_COMPILE_STATUS, @compiled);
3837
Result := (compiled <> 0);
3840
// ------------------
3841
// ------------------ TGLVertexShaderHandle ------------------
3842
// ------------------
3847
constructor TGLVertexShaderHandle.Create;
3849
FShaderType := GL_VERTEX_SHADER_ARB;
3856
class function TGLVertexShaderHandle.IsSupported: Boolean;
3858
Result := GL.ARB_vertex_shader;
3861
// ------------------
3862
// ------------------ TGLGeometryShaderHandle ------------------
3863
// ------------------
3868
constructor TGLGeometryShaderHandle.Create;
3870
FShaderType := GL_GEOMETRY_SHADER_EXT;
3877
class function TGLGeometryShaderHandle.IsSupported: Boolean;
3879
Result := GL.EXT_geometry_shader4;
3882
// ------------------
3883
// ------------------ TGLFragmentShaderHandle ------------------
3884
// ------------------
3889
constructor TGLFragmentShaderHandle.Create;
3891
FShaderType := GL_FRAGMENT_SHADER_ARB;
3898
class function TGLFragmentShaderHandle.IsSupported: Boolean;
3900
Result := GL.ARB_fragment_shader;
3903
// ------------------
3904
// ------------------ TGLTessControlShaderHandle ------------------
3905
// ------------------
3910
constructor TGLTessControlShaderHandle.Create;
3912
FShaderType := GL_TESS_CONTROL_SHADER;
3919
class function TGLTessControlShaderHandle.IsSupported: Boolean;
3921
Result := GL.ARB_tessellation_shader;
3924
// ------------------
3925
// ------------------ TGLTessEvaluationShaderHandle ------------------
3926
// ------------------
3931
constructor TGLTessEvaluationShaderHandle.Create;
3933
FShaderType := GL_TESS_EVALUATION_SHADER;
3940
class function TGLTessEvaluationShaderHandle.IsSupported: Boolean;
3942
Result := GL.ARB_tessellation_shader;
3945
// ------------------
3946
// ------------------ TGLProgramHandle ------------------
3947
// ------------------
3952
function TGLProgramHandle.DoAllocateHandle: cardinal;
3954
Result := GL.CreateProgram();
3960
class function TGLProgramHandle.IsValid(const ID: GLuint): Boolean;
3962
Result := GL.IsProgram(ID);
3968
procedure TGLProgramHandle.AddShader(shaderType: TGLShaderHandleClass; const
3969
shaderSource: string;
3970
treatWarningsAsErrors: Boolean = False);
3972
shader: TGLShaderHandle;
3974
shader := shaderType.CreateAndAllocate;
3976
if shader.Handle = 0 then
3977
raise EGLShader.Create('Couldn''t allocate ' + shaderType.ClassName);3978
shader.ShaderSource(AnsiString(shaderSource));
3979
if (not shader.CompileShader)
3980
or (treatWarningsAsErrors and (Pos('warning', LowerCase(shader.InfoLog)) >3982
raise EGLShader.Create(FName + ' (' + shader.ClassName + '): '#13#10 +3984
AttachObject(shader);
3994
procedure TGLProgramHandle.AttachObject(shader: TGLShaderHandle);
3996
GL.AttachShader(GetHandle, shader.Handle);
4002
procedure TGLProgramHandle.DetachAllObject;
4007
buffer: array[0..255] of TGLuint;
4012
GL.GetAttachedShaders(glH, Length(buffer), @count, @buffer[0]);
4013
count := MinInteger(count, Length(buffer));
4014
for I := 0 to count - 1 do
4015
GL.DetachShader(glH, buffer[I]);
4016
NotifyChangesOfData;
4020
// BindAttribLocation
4023
procedure TGLProgramHandle.BindAttribLocation(index: Integer; const aName:
4026
GL.BindAttribLocation(GetHandle, index, PGLChar(TGLString(aName)));
4029
// BindFragDataLocation
4032
procedure TGLProgramHandle.BindFragDataLocation(index: Integer; const aName:
4035
GL.BindFragDataLocation(GetHandle, index, PGLChar(TGLString(name)));
4041
function TGLProgramHandle.LinkProgram: Boolean;
4047
GL.LinkProgram(glH);
4049
GL.GetProgramiv(glH, GL_LINK_STATUS, @status);
4050
Result := (status <> 0);
4056
function TGLProgramHandle.ValidateProgram: Boolean;
4062
GL.ValidateProgram(h);
4064
GL.GetProgramiv(h, GL_VALIDATE_STATUS, @validated);
4065
Result := (validated <> 0);
4071
function TGLProgramHandle.GetAttribLocation(const aName: string): Integer;
4073
Result := GL.GetAttribLocation(GetHandle, PGLChar(TGLString(aName)));
4074
Assert(Result >= 0, Format(glsUnknownParam, ['attrib', aName, Name]));
4077
// GetUniformLocation
4080
function TGLProgramHandle.GetUniformLocation(const aName: string): Integer;
4082
Result := GL.GetUniformLocation(GetHandle, PGLChar(TGLString(aName)));
4083
Assert(Result >= 0, Format(glsUnknownParam, ['uniform', aName, Name]));
4086
// GetVaryingLocation
4089
function TGLProgramHandle.GetVaryingLocation(const aName: string): Integer;
4091
Result := GL.GetVaryingLocation(GetHandle, PGLChar(TGLString(aName)));
4092
Assert(Result >= 0, Format(glsUnknownParam, ['varying', aName, Name]));
4098
procedure TGLProgramHandle.AddActiveVarying(const aName: string);
4100
GL.ActiveVarying(GetHandle, PGLChar(TGLString(aName)));
4106
procedure TGLProgramHandle.UseProgramObject;
4108
Assert(vCurrentGLContext <> nil);
4109
vCurrentGLContext.GLStates.CurrentProgram := Handle;
4115
procedure TGLProgramHandle.EndUseProgramObject;
4117
Assert(vCurrentGLContext <> nil);
4118
vCurrentGLContext.GLStates.CurrentProgram := 0;
4124
function TGLProgramHandle.GetUniform1i(const index: string): Integer;
4126
GL.GetUniformiv(GetHandle, GetUniformLocation(index), @Result);
4132
function TGLProgramHandle.GetUniform2i(const index: string): TVector2i;
4134
GL.GetUniformiv(GetHandle, GetUniformLocation(index), @Result);
4140
function TGLProgramHandle.GetUniform3i(const index: string): TVector3i;
4142
GL.GetUniformiv(GetHandle, GetUniformLocation(index), @Result);
4148
function TGLProgramHandle.GetUniform4i(const index: string): TVector4i;
4150
GL.GetUniformiv(GetHandle, GetUniformLocation(index), @Result);
4156
procedure TGLProgramHandle.SetUniform1f(const index: string; val: Single);
4158
GL.Uniform1f(GetUniformLocation(index), val);
4164
function TGLProgramHandle.GetUniform1f(const index: string): Single;
4166
GL.GetUniformfv(GetHandle, GetUniformLocation(index), @Result);
4172
procedure TGLProgramHandle.SetUniform1i(const index: string; val: Integer);
4174
GL.Uniform1i(GetUniformLocation(index), val);
4180
procedure TGLProgramHandle.SetUniform2i(const index: string;
4181
const Value: TVector2i);
4183
GL.Uniform2i(GetUniformLocation(index), Value.V[0], Value.V[1]);
4189
procedure TGLProgramHandle.SetUniform3i(const index: string;
4190
const Value: TVector3i);
4192
GL.Uniform3i(GetUniformLocation(index), Value.V[0], Value.V[1], Value.V[2]);
4198
procedure TGLProgramHandle.SetUniform4i(const index: string;
4199
const Value: TVector4i);
4201
GL.Uniform4i(GetUniformLocation(index), Value.V[0], Value.V[1], Value.V[2],
4208
function TGLProgramHandle.GetUniform2f(const index: string): TVector2f;
4210
GL.GetUniformfv(GetHandle, GetUniformLocation(index), @Result);
4216
procedure TGLProgramHandle.SetUniform2f(const index: string; const val:
4219
GL.Uniform2f(GetUniformLocation(index), val.V[0], val.V[1]);
4225
function TGLProgramHandle.GetUniform3f(const index: string): TAffineVector;
4227
GL.GetUniformfv(GetHandle, GetUniformLocation(index), @Result);
4233
procedure TGLProgramHandle.SetUniform3f(const index: string; const val:
4236
GL.Uniform3f(GetUniformLocation(index), val.V[0], val.V[1], val.V[2]);
4242
function TGLProgramHandle.GetUniform4f(const index: string): TVector;
4244
GL.GetUniformfv(GetHandle, GetUniformLocation(index), @Result);
4250
procedure TGLProgramHandle.SetUniform4f(const index: string; const val:
4253
GL.Uniform4f(GetUniformLocation(index), val.V[0], val.V[1], val.V[2], val.V[3]);
4256
// GetUniformMatrix2fv
4259
function TGLProgramHandle.GetUniformMatrix2fv(const index: string): TMatrix2f;
4261
GL.GetUniformfv(GetHandle, GetUniformLocation(index), @Result);
4264
// SetUniformMatrix2fv
4267
procedure TGLProgramHandle.SetUniformMatrix2fv(const index: string; const val:
4270
GL.UniformMatrix2fv(GetUniformLocation(index), 1, False, @val);
4273
// GetUniformMatrix3fv
4276
function TGLProgramHandle.GetUniformMatrix3fv(const index: string): TMatrix3f;
4278
GL.GetUniformfv(GetHandle, GetUniformLocation(index), @Result);
4281
// SetUniformMatrix3fv
4284
procedure TGLProgramHandle.SetUniformMatrix3fv(const index: string; const val:
4287
GL.UniformMatrix3fv(GetUniformLocation(index), 1, False, @val);
4290
// GetUniformMatrix4fv
4293
function TGLProgramHandle.GetUniformMatrix4fv(const index: string): TMatrix;
4295
GL.GetUniformfv(GetHandle, GetUniformLocation(index), @Result);
4298
// SetUniformMatrix4fv
4301
procedure TGLProgramHandle.SetUniformMatrix4fv(const index: string; const val:
4304
GL.UniformMatrix4fv(GetUniformLocation(index), 1, False, @val);
4310
procedure TGLProgramHandle.SetUniformf(const index: string;
4313
SetUniform1f(index, val);
4319
procedure TGLProgramHandle.SetUniformf(const index: string; const val:
4322
SetUniform2f(index, val);
4328
procedure TGLProgramHandle.SetUniformf(const index: string;
4329
const val: TVector3f);
4331
SetUniform3f(index, val);
4337
procedure TGLProgramHandle.SetUniformf(const index: string;
4338
const val: TVector4f);
4340
SetUniform4f(index, val);
4346
procedure TGLProgramHandle.SetUniformi(const index: string;
4347
const val: integer);
4349
SetUniform1f(index, val);
4355
procedure TGLProgramHandle.SetUniformi(const index: string; const val:
4358
SetUniform2i(index, val);
4364
procedure TGLProgramHandle.SetUniformi(const index: string;
4365
const val: TVector3i);
4367
SetUniform3i(index, val);
4373
procedure TGLProgramHandle.SetUniformi(const index: string;
4374
const val: TVector4i);
4376
SetUniform4i(index, val);
4379
// GetUniformTextureHandle
4382
function TGLProgramHandle.GetUniformTextureHandle(const index: string;
4383
const TextureIndex: Integer; const TextureTarget: TGLTextureTarget): Cardinal;
4385
Result := GetUniform1i(index);
4388
// SetUniformTextureHandle
4391
procedure TGLProgramHandle.SetUniformTextureHandle(const index: string;
4392
const TextureIndex: Integer; const TextureTarget: TGLTextureTarget;
4393
const Value: Cardinal);
4395
vCurrentGLContext.GLStates.TextureBinding[0, TextureTarget] := Value;
4396
SetUniform1i(index, TextureIndex);
4402
procedure TGLProgramHandle.SetUniformBuffer(const index: string;
4403
Value: TGLUniformBufferHandle);
4405
GL.UniformBuffer(Handle, GetUniformLocation(index), Value.Handle);
4408
// GetUniformBufferSize
4411
function TGLProgramHandle.GetUniformBufferSize(const aName: string): Integer;
4413
Result := GL.GetUniformBufferSize(Handle, GetUniformLocation(aName));
4419
function TGLProgramHandle.GetUniformOffset(const aName: string): PGLInt;
4421
Result := GL.GetUniformOffset(Handle, GetUniformLocation(aName));
4424
// GetUniformBlockIndex
4427
function TGLProgramHandle.GetUniformBlockIndex(const aName: string): Integer;
4429
Result := GL.GetUniformBlockIndex(Handle, PGLChar(TGLString(aName)));
4430
Assert(Result >= 0, Format(glsUnknownParam, ['uniform block', aName, Name]));
4436
constructor TGLProgramHandle.Create;
4439
FName := 'DefaultShaderName';
4442
// ------------------
4443
// ------------------ TGLContextManager ------------------
4444
// ------------------
4446
{$IFDEF GLS_SERVICE_CONTEXT}4447
procedure OnApplicationInitialize;
4449
InitProc := OldInitProc;
4451
if Assigned(InitProc) then TProcedure(InitProc);
4453
Application.Initialize;
4454
GLContextManager.CreateServiceContext;
4461
constructor TGLContextManager.Create;
4464
{$IFNDEF GLS_MULTITHREAD}4465
FHandles := TList.Create;
4467
FHandles := TThreadList.Create;
4468
{$ENDIF GLS_MULTITHREAD}4469
FList := TThreadList.Create;
4475
destructor TGLContextManager.Destroy;
4485
function TGLContextManager.CreateContext(AClass: TGLContextClass): TGLContext;
4487
if Assigned(AClass) then
4489
Result := AClass.Create;
4490
Result.FManager := Self;
4492
else if Assigned(vContextClasses) and (vContextClasses.Count > 0) then
4494
Result := TGLContextClass(vContextClasses.Last).Create;
4495
Result.FManager := Self;
4501
{$IFDEF GLS_SERVICE_CONTEXT}4503
procedure TGLContextManager.CreateServiceContext;
4505
FServiceContext := CreateContext;
4506
FThreadTask := TServiceContextTaskList.Create;
4507
FServiceStarter := TFinishTaskEvent.Create;
4508
FThread := TServiceContextThread.Create;
4509
AddTaskForServiceContext(TServiceContextThread(FThread).DoCreateServiceContext);
4512
procedure TGLContextManager.QueueTaskDepleted;
4514
TaskRec: TServiceContextTask;
4518
with FThreadTask.LockList do
4520
for I := 0 to Count - 1 do
4522
TaskRec := Items[I];
4523
if Assigned(TaskRec.Task) then
4525
FThreadTask.UnlockList;
4526
// Task queue not empty
4527
FServiceStarter.SetEvent;
4532
FThreadTask.UnlockList;
4535
FServiceStarter.ResetEvent;
4538
with TServiceContextThread(FThread) do
4539
if (nowTime - FLastTaskStartTime > 30000)
4540
and not FReported then
4543
GLSLogger.LogInfo('Service context queue task depleted');4547
{$ENDIF GLS_SERVICE_CONTEXT}4553
procedure TGLContextManager.Lock;
4558
procedure TGLContextManager.NotifyPreparationNeed;
4563
LList := FList.LockList;
4565
for I := LList.Count - 1 downto 0 do
4566
TGLContext(LList[I]).FIsPraparationNeed := True;
4575
procedure TGLContextManager.UnLock;
4583
function TGLContextManager.ContextCount: Integer;
4585
// try..finally just a waste of CPU here, if Count fails, the list is amok,
4586
// and so is the lock...
4587
Result := FList.LockList.Count;
4594
procedure TGLContextManager.RegisterContext(aContext: TGLContext);
4596
with FList.LockList do
4598
if IndexOf(aContext) >= 0 then
4599
raise EGLContext.Create(cInvalidContextRegistration)
4610
procedure TGLContextManager.UnRegisterContext(aContext: TGLContext);
4612
with FList.LockList do
4614
if IndexOf(aContext) < 0 then
4615
raise EGLContext.Create(cInvalidContextRegistration)
4626
procedure TGLContextManager.ContextCreatedBy(aContext: TGLContext);
4630
Inc(FCreatedRCCount);
4636
// DestroyingContextBy
4639
procedure TGLContextManager.DestroyingContextBy(aContext: TGLContext);
4641
cn: TGLContextNotification;
4645
Dec(FCreatedRCCount);
4646
if FCreatedRCCount = 0 then
4648
// yes, slow and bulky, but allows for the triggered event to
4649
// cascade-remove notifications safely
4650
while Length(FNotifications) > 0 do
4652
cn := FNotifications[High(FNotifications)];
4653
SetLength(FNotifications, Length(FNotifications) - 1);
4662
// LastContextDestroyNotification
4665
procedure TGLContextManager.LastContextDestroyNotification(
4666
anObject: TObject; anEvent: TNotifyEvent);
4670
SetLength(FNotifications, Length(FNotifications) + 1);
4671
with FNotifications[High(FNotifications)] do
4681
// RemoveNotification
4684
procedure TGLContextManager.RemoveNotification(anObject: TObject);
4692
i := Low(FNotifications);
4693
while i <= High(FNotifications) do
4695
if FNotifications[i].obj = anObject then
4698
while i <= High(FNotifications) do
4700
FNotifications[i] := FNotifications[i + 1];
4703
SetLength(FNotifications, Length(FNotifications) - 1);
4709
raise EGLContext.Create(cInvalidNotificationRemoval);
4718
procedure TGLContextManager.Terminate;
4720
FTerminated := True;
4721
{$IFDEF GLS_SERVICE_CONTEXT}4722
// Sevice context may not be created becouse Application.Initialize not happened
4723
if Assigned(FServiceContext) then
4727
FServiceStarter.SetEvent;
4730
GLSLogger.LogDebug('Service thread destroyed');4731
FServiceStarter.Destroy;
4732
FThreadTask.Destroy;
4735
if ContextCount = 0 then
4737
GLContextManager := nil;
4745
procedure TGLContextManager.DestroyAllHandles;
4749
with FList.LockList do
4751
for i := Count - 1 downto 0 do
4752
TGLContext(Items[i]).DestroyAllHandles;
4758
{$IFDEF GLS_SERVICE_CONTEXT}4760
{$REGION 'TServiceContextThread'}4762
constructor TServiceContextThread.Create;
4764
FWindow := TForm.CreateNew(Application);
4766
FWindow.Position := poScreenCenter;
4768
FWindow.Height := 1;
4769
FWindow.BorderStyle := bsNone;
4770
FWindow.FormStyle := fsStayOnTop;
4772
vServiceWindow := FWindow;
4774
FDC := GetDC(FWindow.Handle);
4777
FDC := FWindow.Handle;
4779
inherited Create(False);
4782
destructor TServiceContextThread.Destroy;
4787
procedure TServiceContextThread.DoCreateServiceContext; stdcall;
4791
GLSLogger.LogError(Format('%s: can''t initialize rendering context', [ClassName]));4793
vServiceWindow := nil;
4798
GLContextManager.ServiceContext.Acceleration := chaHardware;
4799
GLContextManager.ServiceContext.CreateMemoryContext(FDC, 1, 1, 1);
4808
GLSLogger.LogWarning(Format('%s: can''t initialize memory rendering context. Try initialize common context.', [ClassName]));4810
GLContextManager.ServiceContext.CreateContext(FDC);
4817
GLSLogger.LogNotice('Service context successfuly initialized');4818
GLContextManager.ServiceContext.Activate;
4820
vServiceWindow := nil;
4823
procedure TServiceContextThread.Execute;
4825
TaskRec: TServiceContextTask;
4829
NullTask: TServiceContextTask = (Task: nil; Event: nil);
4833
TaskRec.Task := nil;
4834
with GLContextManager.FThreadTask.LockList do
4836
for I := 0 to Count - 1 do
4838
TaskRec := Items[I];
4839
if Assigned(TaskRec.Task) then
4841
Items[I] := NullTask;
4846
GLContextManager.FThreadTask.UnlockList;
4851
with GLContextManager do
4853
vMainThread := False;
4854
GLSLogger.LogNotice('Service thread started');4857
while not Terminated do
4860
if Assigned(TaskRec.Task) then
4862
with GLContextManager.ServiceContext do
4869
GLSLogger.LogError('Service thread task raised exception');4873
if Assigned(TaskRec.Event) then
4874
TaskRec.Event.SetEvent;
4878
Synchronize(GLContextManager.QueueTaskDepleted);
4879
ServiceStarter.WaitFor(30000);
4882
ServiceContext.Destroy;
4883
FServiceContext := nil;
4884
GLSLogger.LogNotice('Service thread finished');4889
procedure AddTaskForServiceContext(ATask: TTaskProcedure; FinishEvent: TFinishTaskEvent = nil);
4891
TaskRec: TServiceContextTask;
4892
rEvent: TFinishTaskEvent;
4897
if Assigned(GLContextManager.ServiceContext) and Assigned(ATask) then
4900
with GLContextManager.FThreadTask.LockList do
4902
TaskRec.Task := ATask;
4903
if FinishEvent = nil then
4904
begin // Synchronous call
4905
rEvent := TFinishTaskEvent.Create;
4906
TaskRec.Event := rEvent;
4908
else // Asynchronous call
4909
TaskRec.Event := FinishEvent;
4911
with TServiceContextThread(GLContextManager.FThread) do
4913
FLastTaskStartTime := GLSTime;
4917
GLContextManager.FThreadTask.UnlockList;
4919
GLContextManager.ServiceStarter.SetEvent;
4921
// Wait task finishing
4922
if Assigned(rEvent) then
4924
rEvent.WaitFor(INFINITE);
4930
begin // Direct task execution in service thread
4934
GLSLogger.LogError('Service thread task raised exception');4936
if Assigned(FinishEvent) then
4937
FinishEvent.SetEvent;
4941
{$ENDIF GLS_SERVICE_CONTEXT}4943
constructor TFinishTaskEvent.Create;
4945
inherited Create(nil, True, False, '');
4948
// ------------------------------------------------------------------
4949
// ------------------------------------------------------------------
4950
// ------------------------------------------------------------------
4953
// ------------------------------------------------------------------
4954
// ------------------------------------------------------------------
4955
// ------------------------------------------------------------------
4957
vMainThread := True;
4958
{$IFDEF GLS_SERVICE_CONTEXT}4959
OldInitProc := InitProc;
4960
InitProc := @OnApplicationInitialize;
4961
{$ENDIF GLS_SERVICE_CONTEXT}4962
GLContextManager := TGLContextManager.Create;
4963
GLwithoutContext := TGLExtensionsAndEntryPoints.Create;
4964
GLwithoutContext.Close;
4969
GLContextManager.Terminate;
4970
vContextClasses.Free;
4971
vContextClasses := nil;
4972
GLwithoutContext.Free;
4973
GLwithoutContext := nil;