LZScene

Форк
0
/
GLState.pas 
3821 строка · 121.3 Кб
1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Tools for managing an application-side cache of OpenGL state.
6
}
7

8
// TODO: Proper client-side pushing + popping of state, in OpenGL 3+ contexts,
9
//       rather than using glPushAttrib + glPopAttrib.
10
// TODO: Proper support for textures, taking into account that they probably
11
//       won't be linked to texture units in some future version of OpenGL.
12
// TODO: Once more of GLScene is cache-aware, enable some of the checks before
13
//       changing OpenGL state (where we will gain a speed increase).
14
// DONE: Cache some relevant legacy state
15
// TODO: improve binding objects to binding points
16
// TODO: decide how to implement the new Enable* options (without going above
17
//       32 elements in sets if possible, which would be slower in 32bit Delphi)
18
// DONE: remove stTexture1D, 2D, etc from TGLState if possible, since they are
19
//       per texture-unit + also deprecated in OpenGL 3+
20

21
unit GLState;
22

23
interface
24

25
{$I GLScene.inc}
26
{.$DEFINE GLS_CACHE_MISS_CHECK}
27

28
uses
29
  Classes, SysUtils,
30
   
31
  GLCrossPlatform,
32
  GLVectorTypes,
33
  GLVectorGeometry,
34
  OpenGLTokens,
35
  GLTextureFormat;
36

37
const
38
  GLS_VERTEX_ATTR_NUM = 16;
39

40
type
41

42
  TGLStateType = (sttCurrent, sttPoint, sttLine, sttPolygon, sttPolygonStipple,
43
    sttPixelMode, sttLighting, sttFog, sttDepthBuffer, sttAccumBuffer,
44
    sttStencilBuffer, sttViewport, sttTransform, sttEnable, sttColorBuffer,
45
    sttHint, sttEval, sttList, sttTexture, sttScissor,
46
    sttMultisample);
47
  TGLStateTypes = set of TGLStateType;
48

49
const
50
  cAllAttribBits = [low(TGLStateType)..High(TGLStateType)];
51

52
type
53

54
  TGLMeshPrimitive = (
55
    mpNOPRIMITIVE,
56
    mpTRIANGLES,
57
    mpTRIANGLE_STRIP,
58
    mpTRIANGLE_FAN,
59
    mpPOINTS,
60
    mpLINES,
61
    mpLINE_LOOP,
62
    mpLINE_STRIP,
63
    mpLINES_ADJACENCY,
64
    mpLINE_STRIP_ADJACENCY,
65
    mpTRIANGLES_ADJACENCY,
66
    mpTRIANGLE_STRIP_ADJACENCY,
67
    mpPATCHES
68
    );
69

70
  TGLMeshPrimitives = set of TGLMeshPrimitive;
71

72
const
73
  cAllMeshPrimitive = [
74
    mpTRIANGLES,
75
    mpTRIANGLE_STRIP,
76
    mpTRIANGLE_FAN,
77
    mpPOINTS,
78
    mpLINES,
79
    mpLINE_LOOP,
80
    mpLINE_STRIP,
81
    mpLINES_ADJACENCY,
82
    mpLINE_STRIP_ADJACENCY,
83
    mpTRIANGLES_ADJACENCY,
84
    mpTRIANGLE_STRIP_ADJACENCY,
85
    mpPATCHES];
86

87
type
88

89
  // TGLState
90
  //
91
// Reflects all relevant (binary) states of OpenGL subsystem
92
  TGLState = (stAlphaTest, stAutoNormal,
93
    stBlend, stColorMaterial, stCullFace, stDepthTest, stDither,
94
    stFog, stLighting, stLineSmooth, stLineStipple,
95
    stIndexLogicOp, stColorLogicOp, stNormalize, stPointSmooth, stPointSprite,
96
    stPolygonSmooth, stPolygonStipple, stScissorTest, stStencilTest,
97
    stPolygonOffsetPoint, stPolygonOffsetLine, stPolygonOffsetFill,
98
    stDepthClamp);
99

100
  TGLStates = set of TGLState;
101

102
  TComparisonFunction = (cfNever, cfAlways, cfLess, cfLEqual, cfEqual,
103
    cfGreater, cfNotEqual, cfGEqual);
104
  TStencilFunction = TComparisonFunction;
105
  TDepthFunction = TComparisonFunction;
106

107
  TBlendFunction = (bfZero, bfOne,
108
    bfSrcColor, bfOneMinusSrcColor, bfDstColor, bfOneMinusDstColor,
109
    bfSrcAlpha, bfOneMinusSrcAlpha, bfDstAlpha, bfOneMinusDstAlpha,
110
    bfConstantColor, bfOneMinusConstantColor,
111
    bfConstantAlpha, bfOneMinusConstantAlpha,
112
    bfSrcAlphaSat);
113

114
  TDstBlendFunction = bfZero..bfOneMinusConstantAlpha;
115

116
  TBlendEquation = (beAdd, beSubtract, beReverseSubtract, beMin, beMax);
117

118
  TStencilOp = (soKeep, soZero, soReplace, soIncr, soDecr, soInvert, soIncrWrap,
119
    soDecrWrap);
120

121
  TLogicOp = (loClear, loAnd, loAndReverse, loCopy, loAndInverted, loNoOp,
122
    loXOr, loOr, loNor, loEquiv, loInvert, loOrReverse, loCopyInverted,
123
    loOrInverted, loNAnd, loSet);
124

125
  TQueryType = (
126
    qrySamplesPassed,
127
    qryPrimitivesGenerated,
128
    qryTransformFeedbackPrimitivesWritten,
129
    qryTimeElapsed,
130
    qryAnySamplesPassed);
131

132
  // TFaceWinding
133
  //
134
// Describe what kind of winding has a front face
135
  TFaceWinding = (fwCounterClockWise, fwClockWise);
136

137
  TPolygonMode = (pmFill, pmLines, pmPoints);
138

139
  TCullFaceMode = (cmFront, cmBack, cmFrontAndBack);
140
  //  TSingleCullFaceMode = cmFront..cmBack;
141

142
  TColorComponent = (ccRed, ccGreen, ccBlue, ccAlpha);
143
  TColorMask = set of TColorComponent;
144

145
const
146
  cAllColorComponents = [ccRed, ccGreen, ccBlue, ccAlpha];
147
  MAX_HARDWARE_LIGHT = 16;
148
  MAX_SHADER_LIGHT = 8;
149
  MAX_HARDWARE_TEXTURE_UNIT = 48;
150
  MAX_HARDWARE_UNIFORM_BUFFER_BINDING = 75;
151

152
type
153

154
  THintType = (hintDontCare, hintFastest, hintNicest);
155

156
  TLightSourceState = packed record
157
    Position: array[0..MAX_HARDWARE_LIGHT-1] of TVector;
158
    Ambient: array[0..MAX_HARDWARE_LIGHT-1] of TVector;
159
    Diffuse: array[0..MAX_HARDWARE_LIGHT-1] of TVector;
160
    Specular: array[0..MAX_HARDWARE_LIGHT-1] of TVector;
161
    SpotDirection: array[0..MAX_HARDWARE_LIGHT-1] of TVector;
162
    SpotCosCutoffExponent: array[0..MAX_HARDWARE_LIGHT-1] of TVector;
163
    Attenuation: array[0..MAX_HARDWARE_LIGHT-1] of TVector;
164
  end;
165

166
  TShaderLightSourceState = packed record
167
    Position: array[0..MAX_SHADER_LIGHT-1] of TVector;
168
    Ambient: array[0..MAX_SHADER_LIGHT-1] of TVector;
169
    Diffuse: array[0..MAX_SHADER_LIGHT-1] of TVector;
170
    Specular: array[0..MAX_SHADER_LIGHT-1] of TVector;
171
    SpotDirection: array[0..MAX_SHADER_LIGHT-1] of TVector;
172
    SpotCosCutoffExponent: array[0..MAX_SHADER_LIGHT-1] of TVector;
173
    Attenuation: array[0..MAX_SHADER_LIGHT-1] of TVector;
174
  end;
175

176
  TOnLightsChanged = procedure(Sender: TObject);
177

178
  TGLBufferBindingTarget = (bbtUniform, bbtTransformFeedBack);
179

180
  TUBOStates = record
181
    FUniformBufferBinding: TGLuint;
182
    FOffset: TGLintptr;
183
    FSize: TGLsizeiptr;
184
  end;
185

186
  TGLMaterialLevel = (mlAuto, mlFixedFunction, mlMultitexturing, mlSM3, mlSM4, mlSM5);
187

188
  // TGLStateCache
189
  //
190
  { Manages an application-side cache of OpenGL states and parameters.
191
     Purpose of this class is to eliminate redundant state and parameter
192
     changes, and there will typically be no more than one state cache per
193
     OpenGL context. }
194
  TGLStateCache = class
195
  private
196
     
197
    // Legacy state
198
    FFrontBackColors: array[0..1, 0..3] of TVector;
199
    FFrontBackShininess: array[0..1] of Integer;
200
    FAlphaFunc: TComparisonFunction;
201
    FAlphaRef: TGLclampf;
202
    FPolygonBackMode: TPolygonMode; // Front + back have same polygon mode
203

204
    // Lighting state
205
    FMaxLights: GLuint;
206
    FLightEnabling: array[0..MAX_HARDWARE_LIGHT - 1] of Boolean;
207
    FLightIndices: array[0..MAX_HARDWARE_LIGHT - 1] of TGLint;
208
    FLightNumber: Integer;
209
    FLightStates: TLightSourceState;
210
    FSpotCutoff: array[0..MAX_HARDWARE_LIGHT-1] of Single;
211
    FShaderLightStates: TShaderLightSourceState;
212
    FShaderLightStatesChanged: Boolean;
213

214
    FColorWriting: Boolean; // TODO: change to per draw buffer (FColorWriteMask)
215
    FStates: TGLStates;
216
    FListStates: array of TGLStateTypes;
217
    FCurrentList: TGLuint;
218
    FTextureMatrixIsIdentity: array[0..3] of Boolean;
219
    FForwardContext: Boolean;
220
    FFFPLight: Boolean;
221

222
    // Vertex Array Data state
223
    FVertexArrayBinding: TGLuint;
224
    FArrayBufferBinding: TGLuint;
225
    FElementBufferBinding: TGLuint;
226
    FTextureBufferBinding: TGLuint;
227
    FEnablePrimitiveRestart: TGLboolean;
228
    FPrimitiveRestartIndex: TGLuint;
229

230
    // Transformation state
231
    FViewPort: TVector4i;
232
    FDepthRange: array[0..1] of TGLclampd;
233
    FEnableClipDistance: array[0..7] of TGLboolean;
234
    FEnableDepthClamp: TGLboolean;
235

236
    // Coloring state
237
    FClampReadColor: TGLenum; // GL_FIXED_ONLY
238
    FProvokingVertex: TGLenum; // GL_LAST_VERTEX_CONVENTION
239

240
    // Rasterization state
241
    FPointSize: TGLfloat;
242
    FPointFadeThresholdSize: TGLfloat;
243
    FPointSpriteCoordOrigin: TGLenum; // GL_UPPER_LEFT
244
    FLineWidth: Single;
245
    FLineStippleFactor: TGLint;
246
    FLineStipplePattern: TGLushort;
247

248
    FEnableLineSmooth: TGLboolean;
249
    FEnableCullFace: TGLboolean;
250
    FCullFaceMode: TCullFaceMode;
251
    FFrontFace: TFaceWinding;
252
    FEnablePolygonSmooth: TGLboolean;
253
    FPolygonMode: TPolygonMode;
254
    FPolygonOffsetFactor: TGLfloat;
255
    FPolygonOffsetUnits: TGLfloat;
256
    FEnablePolygonOffsetPoint: TGLboolean;
257
    FEnablePolygonOffsetLine: TGLboolean;
258
    FEnablePolygonOffsetFill: TGLboolean;
259

260
    // Multisample state
261
    FEnableMultisample: TGLboolean;
262
    FEnableSampleAlphaToCoverage: TGLboolean;
263
    FEnableSampleAlphaToOne: TGLboolean;
264
    FEnableSampleCoverage: TGLboolean;
265
    FSampleCoverageValue: TGLfloat;
266
    FSampleCoverageInvert: TGLboolean;
267
    FEnableSampleMask: TGLboolean;
268
    FSampleMaskValue: array[0..15] of TGLbitfield;
269

270
    // Texture state
271
    FMaxTextureSize: TGLuint;
272
    FMax3DTextureSize: TGLuint;
273
    FMaxCubeTextureSize: TGLuint;
274
    FMaxArrayTextureSize: TGLuint;
275
    FMaxTextureImageUnits: TGLuint;
276
    FMaxTextureAnisotropy: TGLuint;
277
    FMaxSamples: TGLuint;
278
    FTextureBinding: array[0..MAX_HARDWARE_TEXTURE_UNIT - 1, TGLTextureTarget] of TGLuint;
279
    FTextureBindingTime: array[0..MAX_HARDWARE_TEXTURE_UNIT - 1, TGLTextureTarget] of Double;
280
    FSamplerBinding: array[0..MAX_HARDWARE_TEXTURE_UNIT - 1] of TGLuint;
281

282
    // Active texture state
283
    FActiveTexture: TGLint; // 0 .. Max_texture_units
284
    FActiveTextureEnabling: array[0..MAX_HARDWARE_TEXTURE_UNIT - 1, TGLTextureTarget] of Boolean;
285

286
    // Pixel operation state
287
    FEnableScissorTest: TGLboolean;
288
    FScissorBox: TVector4i;
289

290
    FEnableStencilTest: TGLboolean;
291

292
    FStencilFunc: TStencilFunction;
293
    FStencilValueMask: TGLuint;
294
    FStencilRef: TGLint;
295
    FStencilFail: TStencilOp;
296
    FStencilPassDepthFail: TStencilOp;
297
    FStencilPassDepthPass: TStencilOp;
298

299
    FStencilBackFunc: TStencilFunction;
300
    FStencilBackValueMask: TGLuint;
301
    FStencilBackRef: TGLuint;
302
    FStencilBackFail: TStencilOp;
303
    FStencilBackPassDepthPass: TStencilOp;
304
    FStencilBackPassDepthFail: TStencilOp;
305

306
    FEnableDepthTest: TGLboolean;
307
    FDepthFunc: TDepthFunction;
308

309
    FEnableBlend: array[0..15] of TGLboolean;
310

311
    FBlendSrcRGB: TBlendFunction;
312
    FBlendSrcAlpha: TBlendFunction;
313
    FBlendDstRGB: TDstBlendFunction;
314
    FBlendDstAlpha: TDstBlendFunction;
315

316
    FBlendEquationRGB: TBlendEquation;
317
    FBlendEquationAlpha: TBlendEquation;
318
    FBlendColor: TVector;
319

320
    FEnableFramebufferSRGB: TGLboolean;
321
    FEnableDither: TGLboolean;
322
    FEnableColorLogicOp: TGLboolean;
323

324
    FLogicOpMode: TLogicOp;
325

326
    // Framebuffer control state
327
    FColorWriteMask: array[0..15] of TColorMask;
328
    FDepthWriteMask: TGLBoolean;
329
    FStencilWriteMask: TGLuint;
330
    FStencilBackWriteMask: TGLuint;
331
    FColorClearValue: TVector;
332
    FDepthClearValue: TGLfloat;
333
    FStencilClearValue: TGLuint;
334

335
    // Framebuffer state
336
    FDrawFrameBuffer: TGLuint;
337
    FReadFrameBuffer: TGLuint;
338

339
    // Renderbuffer state
340
    FRenderBuffer: TGLuint;
341

342
    // Pixels state
343
    FUnpackSwapBytes: TGLboolean;
344
    FUnpackLSBFirst: TGLboolean;
345
    FUnpackImageHeight: TGLuint;
346
    FUnpackSkipImages: TGLuint;
347
    FUnpackRowLength: TGLuint;
348
    FUnpackSkipRows: TGLuint;
349
    FUnpackSkipPixels: TGLuint;
350
    FUnpackAlignment: TGLuint;
351
    FPackSwapBytes: TGLboolean;
352
    FPackLSBFirst: TGLboolean;
353
    FPackImageHeight: TGLuint;
354
    FPackSkipImages: TGLuint;
355
    FPackRowLength: TGLuint;
356
    FPackSkipRows: TGLuint;
357
    FPackSkipPixels: TGLuint;
358
    FPackAlignment: TGLuint;
359

360
    FPixelPackBufferBinding: TGLuint;
361
    FPixelUnpackBufferBinding: TGLuint;
362

363
    // Program state
364
    FCurrentProgram: TGLuint;
365
    FMaxTextureUnits: TGLuint;
366
    FUniformBufferBinding: TGLuint;
367
    FUBOStates: array[TGLBufferBindingTarget, 0..MAX_HARDWARE_UNIFORM_BUFFER_BINDING-1] of TUBOStates;
368

369
    // Vector + Geometry Shader state
370
    FCurrentVertexAttrib: array[0..15] of TVector;
371
    FEnableProgramPointSize: TGLboolean;
372

373
    // Transform Feedback state
374
    FTransformFeedbackBufferBinding: TGLuint;
375

376
    // Hints state
377
    FTextureCompressionHint: THintType;
378
    FPolygonSmoothHint: THintType;
379
    FFragmentShaderDerivitiveHint: THintType;
380
    FLineSmoothHint: THintType;
381
    FMultisampleFilterHint: THintType;
382

383
    // Misc state
384
    FCurrentQuery: array[TQueryType] of TGLuint;
385
    FCopyReadBufferBinding: TGLuint;
386
    FCopyWriteBufferBinding: TGLuint;
387
    FEnableTextureCubeMapSeamless: TGLboolean;
388
    FInsideList: Boolean;
389

390
    FOnLightsChanged: TOnLightsChanged;
391
  protected
392
     
393
    // Vertex Array Data state
394
    procedure SetVertexArrayBinding(const Value: TGLuint);
395
    function GetArrayBufferBinding: TGLuint;
396
    procedure SetArrayBufferBinding(const Value: TGLuint);
397
    function GetElementBufferBinding: TGLuint;
398
    procedure SetElementBufferBinding(const Value: TGLuint);
399
    function GetEnablePrimitiveRestart: TGLboolean;
400
    function GetPrimitiveRestartIndex: TGLuint;
401
    procedure SetEnablePrimitiveRestart(const enabled: TGLboolean);
402
    procedure SetPrimitiveRestartIndex(const index: TGLuint);
403
    procedure SetTextureBufferBinding(const Value: TGLuint);
404
    // Transformation state
405
    procedure SetViewPort(const Value: TVector4i);
406
    function GetEnableClipDistance(ClipDistance: Cardinal): TGLboolean;
407
    procedure SetEnableClipDistance(Index: Cardinal; const Value: TGLboolean);
408
    function GetDepthRangeFar:TGLclampd;
409
    procedure SetDepthRangeFar(const Value: TGLclampd);
410
    function GetDepthRangeNear:TGLclampd;
411
    procedure SetDepthRangeNear(const Value: TGLclampd);
412
    procedure SetEnableDepthClamp(const enabled: TGLboolean);
413
    // Coloring state
414
    procedure SetClampReadColor(const Value: TGLenum);
415
    procedure SetProvokingVertex(const Value: TGLenum);
416
    // Rasterization state
417
    procedure SetPointSize(const Value: TGLfloat);
418
    procedure SetPointFadeThresholdSize(const Value: TGLfloat);
419
    procedure SetPointSpriteCoordOrigin(const Value: TGLenum);
420
    procedure SetLineWidth(const Value: TGLfloat);
421
    procedure SetLineStippleFactor(const Value: TGLint);
422
    procedure SetLineStipplePattern(const Value: TGLushort);
423

424
    procedure SetEnableLineSmooth(const Value: TGLboolean);
425
    procedure SetEnableCullFace(const Value: TGLboolean);
426
    procedure SetCullFaceMode(const Value: TCullFaceMode);
427
    procedure SetFrontFace(const Value: TFaceWinding);
428
    procedure SetEnablePolygonSmooth(const Value: TGLboolean);
429
    procedure SetPolygonMode(const Value: TPolygonMode);
430
    procedure SetPolygonOffsetFactor(const Value: TGLfloat);
431
    procedure SetPolygonOffsetUnits(const Value: TGLfloat);
432
    procedure SetEnablePolygonOffsetPoint(const Value: TGLboolean);
433
    procedure SetEnablePolygonOffsetLine(const Value: TGLboolean);
434
    procedure SetEnablePolygonOffsetFill(const Value: TGLboolean);
435
    // Multisample state
436
    procedure SetEnableMultisample(const Value: TGLboolean);
437
    procedure SetEnableSampleAlphaToCoverage(const Value: TGLboolean);
438
    procedure SetEnableSampleAlphaToOne(const Value: TGLboolean);
439
    procedure SetEnableSampleCoverage(const Value: TGLboolean);
440
    procedure SetSampleCoverageValue(const Value: TGLfloat);
441
    procedure SetSampleCoverageInvert(const Value: TGLboolean);
442
    procedure SetEnableSampleMask(const Value: TGLboolean);
443
    function GetSampleMaskValue(Index: Integer): TGLbitfield;
444
    procedure SetSampleMaskValue(Index: Integer; const Value: TGLbitfield);
445
    // Texture state
446
    function GetMaxTextureSize: TGLuint;
447
    function GetMax3DTextureSize: TGLuint;
448
    function GetMaxCubeTextureSize: TGLuint;
449
    function GetMaxArrayTextureSize: TGLuint;
450
    function GetMaxTextureImageUnits: TGLuint;
451
    function GetMaxTextureAnisotropy: TGLuint;
452
    function GetMaxSamples: TGLuint;
453
    function GetTextureBinding(Index: Integer; target: TGLTextureTarget):
454
      TGLuint;
455
    function GetTextureBindingTime(Index: Integer; target: TGLTextureTarget):
456
      Double;
457
    procedure SetTextureBinding(Index: Integer; target: TGLTextureTarget;
458
      const Value: TGLuint);
459
    function GetActiveTextureEnabled(Target: TGLTextureTarget): Boolean;
460
    procedure SetActiveTextureEnabled(Target: TGLTextureTarget; const Value:
461
      Boolean);
462
    function GetSamplerBinding(Index: TGLuint): TGLuint;
463
    procedure SetSamplerBinding(Index: TGLuint; const Value: TGLuint);
464
    // Active texture
465
    procedure SetActiveTexture(const Value: TGLint);
466
    // Pixel operations
467
    procedure SetEnableScissorTest(const Value: TGLboolean);
468
    procedure SetScissorBox(const Value: TVector4i);
469
    procedure SetEnableStencilTest(const Value: TGLboolean);
470
    procedure SetEnableDepthTest(const Value: TGLboolean);
471
    procedure SetDepthFunc(const Value: TDepthFunction);
472
    function GetEnableBlend(Index: Integer): TGLboolean;
473
    procedure SetEnableBlend(Index: Integer; const Value: TGLboolean);
474
    procedure SetBlendColor(const Value: TVector);
475
    procedure SetEnableFramebufferSRGB(const Value: TGLboolean);
476
    procedure SetEnableDither(const Value: TGLboolean);
477
    procedure SetEnableColorLogicOp(const Value: TGLboolean);
478
    procedure SetLogicOpMode(const Value: TLogicOp);
479
    // Framebuffer control
480
    function GetColorWriteMask(Index: Integer): TColorMask;
481
    procedure SetColorWriteMask(Index: Integer; const Value: TColorMask);
482
    procedure SetDepthWriteMask(const Value: TGLboolean);
483
    procedure SetStencilWriteMask(const Value: TGLuint);
484
    procedure SetStencilBackWriteMask(const Value: TGLuint);
485
    procedure SetColorClearValue(const Value: TVector);
486
    procedure SetDepthClearValue(const Value: TGLfloat);
487
    procedure SetStencilClearValue(const Value: TGLuint);
488
    // Framebuffer
489
    procedure SetDrawFrameBuffer(const Value: TGLuint);
490
    procedure SetReadFrameBuffer(const Value: TGLuint);
491
    // Renderbuffer
492
    procedure SetRenderBuffer(const Value: TGLuint);
493
    // Pixels
494
    procedure SetUnpackSwapBytes(const Value: TGLboolean);
495
    procedure SetUnpackLSBFirst(const Value: TGLboolean);
496
    procedure SetUnpackImageHeight(const Value: TGLuint);
497
    procedure SetUnpackSkipImages(const Value: TGLuint);
498
    procedure SetUnpackRowLength(const Value: TGLuint);
499
    procedure SetUnpackSkipRows(const Value: TGLuint);
500
    procedure SetUnpackSkipPixels(const Value: TGLuint);
501
    procedure SetUnpackAlignment(const Value: TGLuint);
502
    procedure SetPackSwapBytes(const Value: TGLboolean);
503
    procedure SetPackLSBFirst(const Value: TGLboolean);
504
    procedure SetPackImageHeight(const Value: TGLuint);
505
    procedure SetPackSkipImages(const Value: TGLuint);
506
    procedure SetPackRowLength(const Value: TGLuint);
507
    procedure SetPackSkipRows(const Value: TGLuint);
508
    procedure SetPackSkipPixels(const Value: TGLuint);
509
    procedure SetPackAlignment(const Value: TGLuint);
510
    procedure SetPixelPackBufferBinding(const Value: TGLuint);
511
    procedure SetPixelUnpackBufferBinding(const Value: TGLuint);
512
    // Program
513
    procedure SetCurrentProgram(const Value: TGLuint);
514
    procedure SetUniformBufferBinding(const Value: TGLuint);
515
    function GetMaxTextureUnits: TGLuint;
516
    // Vector + Geometry Shader state
517
    function GetCurrentVertexAttrib(Index: Integer): TVector;
518
    procedure SetCurrentVertexAttrib(Index: Integer; const Value: TVector);
519
    procedure SetEnableProgramPointSize(const Value: TGLboolean);
520
    // Transform Feedback state
521
    procedure SetTransformFeedbackBufferBinding(const Value: TGLuint);
522
    // Hints
523
    procedure SetLineSmoothHint(const Value: THintType);
524
    procedure SetPolygonSmoothHint(const Value: THintType);
525
    procedure SetTextureCompressionHint(const Value: THintType);
526
    procedure SetFragmentShaderDerivitiveHint(const Value: THintType);
527
    procedure SetMultisampleFilterHint(const Value: THintType);
528
    // Misc
529
    function GetCurrentQuery(Index: TQueryType): TGLuint;
530
    //    procedure SetCurrentQuery(Index: TQueryType; const Value: TGLuint);
531
    procedure SetCopyReadBufferBinding(const Value: TGLuint);
532
    procedure SetCopyWriteBufferBinding(const Value: TGLuint);
533
    procedure SetEnableTextureCubeMapSeamless(const Value: TGLboolean);
534
    // Ligting
535
    procedure SetFFPLight(Value: Boolean);
536
    function GetMaxLights: Integer;
537
    function GetLightEnabling(I: Integer): Boolean;
538
    procedure SetLightEnabling(I: Integer; Value: Boolean);
539
    function GetLightPosition(I: Integer): TVector;
540
    procedure SetLightPosition(I: Integer; const Value: TVector);
541
    function GetLightSpotDirection(I: Integer): TAffineVector;
542
    procedure SetLightSpotDirection(I: Integer; const Value: TAffineVector);
543
    function GetLightAmbient(I: Integer): TVector;
544
    procedure SetLightAmbient(I: Integer; const Value: TVector);
545
    function GetLightDiffuse(I: Integer): TVector;
546
    procedure SetLightDiffuse(I: Integer; const Value: TVector);
547
    function GetLightSpecular(I: Integer): TVector;
548
    procedure SetLightSpecular(I: Integer; const Value: TVector);
549
    function GetSpotCutoff(I: Integer): Single;
550
    procedure SetSpotCutoff(I: Integer; const Value: Single);
551
    function GetSpotExponent(I: Integer): Single;
552
    procedure SetSpotExponent(I: Integer; const Value: Single);
553
    function GetConstantAtten(I: Integer): Single;
554
    procedure SetConstantAtten(I: Integer; const Value: Single);
555
    function GetLinearAtten(I: Integer): Single;
556
    procedure SetLinearAtten(I: Integer; const Value: Single);
557
    function GetQuadAtten(I: Integer): Single;
558
    procedure SetQuadAtten(I: Integer; const Value: Single);
559
    procedure SetForwardContext(Value: Boolean);
560

561
    function GetMaterialAmbient(const aFace: TCullFaceMode): TVector;
562
    function GetMaterialDiffuse(const aFace: TCullFaceMode): TVector;
563
    function GetMaterialSpecular(const aFace: TCullFaceMode): TVector;
564
    function GetMaterialEmission(const aFace: TCullFaceMode): TVector;
565
    function GetMaterialShininess(const aFace: TCullFaceMode): Integer;
566
  public
567
     
568
    constructor Create; virtual;
569
    destructor Destroy; override;
570

571
    procedure PushAttrib(stateTypes: TGLStateTypes);
572
    procedure PopAttrib();
573

574
    procedure Enable(const aState: TGLState);
575
    procedure Disable(const aState: TGLState);
576
    procedure PerformEnable(const aState: TGLState);
577
    procedure PerformDisable(const aState: TGLState);
578

579
    procedure SetGLState(const aState : TGLState); deprecated;
580
    procedure UnSetGLState(const aState : TGLState); deprecated;
581
    procedure ResetGLPolygonMode; deprecated;
582
    procedure ResetGLMaterialColors; deprecated;
583
    procedure ResetGLTexture(const TextureUnit: Integer); deprecated;
584
    procedure ResetGLCurrentTexture; deprecated;
585
    procedure ResetGLFrontFace; deprecated;
586
    procedure SetGLFrontFaceCW; deprecated;
587
    procedure ResetAll; deprecated;
588

589
    { Adjusts material colors for a face. }
590
    procedure SetGLMaterialColors(const aFace: TCullFaceMode;
591
      const emission, ambient, diffuse, specular: TVector;
592
      const shininess: Integer);
593

594
    property MaterialAmbient[const aFace: TCullFaceMode]: TVector
595
      read GetMaterialAmbient;
596
    property MaterialDiffuse[const aFace: TCullFaceMode]: TVector
597
      read GetMaterialDiffuse;
598
    property MaterialSpecular[const aFace: TCullFaceMode]: TVector
599
      read GetMaterialSpecular;
600
    property MaterialEmission[const aFace: TCullFaceMode]: TVector
601
      read GetMaterialEmission;
602
    property MaterialShininess[const aFace: TCullFaceMode]: Integer
603
      read GetMaterialShininess;
604

605
    { Adjusts material alpha channel for a face. }
606
    procedure SetGLMaterialAlphaChannel(const aFace: TGLEnum; const alpha: TGLFloat);
607

608
    { Adjusts material diffuse color for a face. }
609
    procedure SetGLMaterialDiffuseColor(const aFace: TGLEnum; const diffuse: TVector);
610

611
    { Lighting states }
612
    property FixedFunctionPipeLight: Boolean read FFFPLight write SetFFPLight;
613
    property MaxLights: Integer read GetMaxLights;
614
    property LightEnabling[Index: Integer]: Boolean read GetLightEnabling write
615
    SetLightEnabling;
616
    property LightPosition[Index: Integer]: TVector read GetLightPosition write
617
    SetLightPosition;
618
    property LightSpotDirection[Index: Integer]: TAffineVector read GetLightSpotDirection write
619
    SetLightSpotDirection;
620
    property LightAmbient[Index: Integer]: TVector read GetLightAmbient write
621
    SetLightAmbient;
622
    property LightDiffuse[Index: Integer]: TVector read GetLightDiffuse write
623
    SetLightDiffuse;
624
    property LightSpecular[Index: Integer]: TVector read GetLightSpecular write
625
    SetLightSpecular;
626
    property LightSpotCutoff[Index: Integer]: Single read GetSpotCutoff write
627
    SetSpotCutoff;
628
    property LightSpotExponent[Index: Integer]: Single read GetSpotExponent write
629
    SetSpotExponent;
630
    property LightConstantAtten[Index: Integer]: Single read GetConstantAtten
631
    write SetConstantAtten;
632
    property LightLinearAtten[Index: Integer]: Single read GetLinearAtten write
633
    SetLinearAtten;
634
    property LightQuadraticAtten[Index: Integer]: Single read GetQuadAtten write
635
    SetQuadAtten;
636
    function GetLightIndicesAsAddress: PGLInt;
637
    function GetLightStateAsAddress: Pointer;
638
    property LightNumber: Integer read FLightNumber;
639
    property OnLightsChanged: TOnLightsChanged read FOnLightsChanged write FOnLightsChanged;
640

641
    { Blending states }
642
    procedure SetGLAlphaFunction(func: TComparisonFunction; ref: TGLclampf);
643

644
    // Vertex Array Data state
645
    { The currently bound array buffer (calling glVertexAttribPointer
646
       locks this buffer to the currently bound VBO). }
647
    property VertexArrayBinding: TGLuint read FVertexArrayBinding write
648
      SetVertexArrayBinding;
649
    { The currently bound vertex buffer object (VAO). }
650
    property ArrayBufferBinding: TGLuint read GetArrayBufferBinding write
651
      SetArrayBufferBinding;
652
    { The currently bound element buffer object (EBO). }
653
    property ElementBufferBinding: TGLuint read GetElementBufferBinding write
654
      SetElementBufferBinding;
655
    { Determines whether primitive restart is turned on or off. }
656
    property EnablePrimitiveRestart: TGLboolean read GetEnablePrimitiveRestart
657
      write SetEnablePrimitiveRestart;
658
    { The index Value that causes a primitive restart. }
659
    property PrimitiveRestartIndex: TGLuint read GetPrimitiveRestartIndex write
660
      SetPrimitiveRestartIndex;
661
    { The currently bound texture buffer object (TBO). }
662
    property TextureBufferBinding: TGLuint read FTextureBufferBinding write
663
      SetTextureBufferBinding;
664

665
    // Transformation state
666
    { The viewport. }
667
    property ViewPort: TVector4i read FViewPort write SetViewPort;
668
    { Modifies the near + far clipping planes. }
669
    procedure SetDepthRange(const ZNear, ZFar: TGLclampd);
670
    { The near clipping plane distance. }
671
    property DepthRangeNear: TGLclampd read GetDepthRangeNear write
672
      SetDepthRangeNear;
673
    { The far clipping plane distance. }
674
    property DepthRangeFar: TGLclampd read GetDepthRangeFar write
675
      SetDepthRangeFar;
676
    { Enables/Disables each of the clip distances, used in shaders. }
677
    property EnableClipDistance[Index: Cardinal]: TGLboolean read
678
    GetEnableClipDistance write SetEnableClipDistance;
679
    { Enables/Disables depth clamping. }
680
    property EnableDepthClamp: TGLboolean read FEnableDepthClamp write
681
      SetEnableDepthClamp;
682

683
    // Coloring state
684
    { Controls read color clamping. }
685
    property ClampReadColor: TGLenum read FClampReadColor write
686
      SetClampReadColor;
687
    { The provoking vertex used in flat shading.  All the vertices of each
688
       primitive will the same value determined by this property. }
689
    property ProvokingVertex: TGLenum read FProvokingVertex write
690
      SetProvokingVertex;
691

692
    // Rasterization state
693
    { The default point size, used when EnableProgramPointSize = false. }
694
    property PointSize: TGLfloat read FPointSize write SetPointSize;
695
    { If multisampling is enabled, this can control when points are faded out.}
696
    property PointFadeThresholdSize: TGLfloat read FPointFadeThresholdSize write
697
      SetPointFadeThresholdSize;
698
    { The texture coordinate origin of point sprites. }
699
    property PointSpriteCoordOrigin: TGLenum read FPointSpriteCoordOrigin write
700
      SetPointSpriteCoordOrigin;
701
    { The line width. }
702
    property LineWidth: TGLfloat read FLineWidth write SetLineWidth;
703
    { The line stipple. }
704
    property LineStippleFactor: TGLint read FLineStippleFactor write
705
      SetLineStippleFactor;
706
    { The line stipple. }
707
    property LineStipplePattern: TGLushort read FLineStipplePattern write
708
      SetLineStipplePattern;
709
    { Enable/Disable line smoothing. }
710
    property EnableLineSmooth: TGLboolean read FEnableLineSmooth write
711
      SetEnableLineSmooth;
712
    { Enable/Disable face culling. }
713
    property EnableCullFace: TGLboolean read FEnableCullFace write
714
      SetEnableCullFace;
715
    { Selects which faces to cull: front, back or front+back.}
716
    property CullFaceMode: TCullFaceMode read FCullFaceMode write
717
      SetCullFaceMode;
718
    { The winding direction that indicates a front facing primitive. }
719
    property FrontFace: {TGLenum} TFaceWinding read FFrontFace write
720
    SetFrontFace;
721
    // Enables/Disables polygon smoothing.
722
    property EnablePolygonSmooth: TGLboolean read FEnablePolygonSmooth write
723
      SetEnablePolygonSmooth;
724
    { Whether polygons appear filled, lines or points. }
725
    property PolygonMode: TPolygonMode read FPolygonMode write SetPolygonMode;
726
    { Scales the maximum depth of the polygon. }
727
    property PolygonOffsetFactor: TGLfloat read FPolygonOffsetFactor write
728
      SetPolygonOffsetFactor;
729
    { Scales an implementation-dependent constant that relates to the usable
730
       resolution of the depth buffer. }
731
    property PolygonOffsetUnits: TGLfloat read FPolygonOffsetUnits write
732
      SetPolygonOffsetUnits;
733
    { Set polygon offset. }
734
    procedure SetPolygonOffset(const factor, units: TGLfloat);
735
    { Enable/Disable polygon offset for polygons in point mode. }
736
    property EnablePolygonOffsetPoint: TGLboolean read FEnablePolygonOffsetPoint
737
      write SetEnablePolygonOffsetPoint;
738
    { Enable/Disable polygon offset for polygons in line mode. }
739
    property EnablePolygonOffsetLine: TGLboolean read FEnablePolygonOffsetLine
740
      write SetEnablePolygonOffsetLine;
741
    { Enable/Disable polygon offset for polygons in fill mode. }
742
    property EnablePolygonOffsetFill: TGLboolean read FEnablePolygonOffsetFill
743
      write SetEnablePolygonOffsetFill;
744

745
    // Multisample state
746
    { Enable/Disable multisampling. }
747
    property EnableMultisample: TGLboolean read FEnableMultisample write
748
      SetEnableMultisample;
749
    { Enable/Disable sample alpha to coverage. }
750
    property EnableSampleAlphaToCoverage: TGLboolean read
751
      FEnableSampleAlphaToCoverage write SetEnableSampleAlphaToCoverage;
752
    { Enable/Disable sample alpha to one. }
753
    property EnableSampleAlphaToOne: TGLboolean read FEnableSampleAlphaToOne
754
      write SetEnableSampleAlphaToOne;
755
    { Enable/Disable sample coverage. }
756
    property EnableSampleCoverage: TGLboolean read FEnableSampleCoverage write
757
      SetEnableSampleCoverage;
758
    { Sample coverage Value. }
759
    property SampleCoverageValue: TGLfloat read FSampleCoverageValue write
760
      SetSampleCoverageValue;
761
    { Inverts sample coverage Value. }
762
    property SampleCoverageInvert: TGLboolean read FSampleCoverageInvert write
763
      SetSampleCoverageInvert;
764
    { Set sample coverage. }
765
    procedure SetSampleCoverage(const Value: TGLfloat; invert: TGLboolean);
766
    { Enable/Disable sample mask. }
767
    property EnableSampleMask: TGLboolean read FEnableSampleMask write
768
      SetEnableSampleMask;
769
    { Sample mask values. }
770
    property SampleMaskValue[Index: Integer]: TGLbitfield read GetSampleMaskValue
771
    write SetSampleMaskValue;
772

773
    // Textures
774
    { Textures bound to each texture unit + binding point. }
775
    property TextureBinding[Index: Integer; target: TGLTextureTarget]: TGLuint
776
      read GetTextureBinding write SetTextureBinding;
777
    property TextureBindingTime[Index: Integer; target: TGLTextureTarget]: Double
778
      read GetTextureBindingTime;
779
    property ActiveTextureEnabled[Target: TGLTextureTarget]: Boolean read
780
    GetActiveTextureEnabled write SetActiveTextureEnabled;
781
    property SamplerBinding[Index: TGLuint]: TGLuint read GetSamplerBinding
782
      write SetSamplerBinding;
783
    property MaxTextureSize: TGLuint read GetMaxTextureSize;
784
    property Max3DTextureSize: TGLuint read GetMax3DTextureSize;
785
    property MaxCubeTextureSize: TGLuint read GetMaxCubeTextureSize;
786
    property MaxArrayTextureSize: TGLuint read GetMaxArrayTextureSize;
787
    property MaxTextureImageUnits: TGLuint read GetMaxTextureImageUnits;
788
    property MaxTextureAnisotropy: TGLuint read GetMaxTextureAnisotropy;
789
    property MaxSamples: TGLuint read GetMaxSamples;
790
    // TODO: GL_TEXTURE_BUFFER_DATA_STORE_BINDING ?
791

792
    // Active texture
793
    { The active texture unit.  Valid values are 0 .. Max texture units. }
794
    property ActiveTexture: TGLint read FActiveTexture write SetActiveTexture;
795

796
    // Pixel operations
797
    { Enables/Disables scissor test. }
798
    property EnableScissorTest: TGLboolean read FEnableScissorTest write
799
      SetEnableScissorTest;
800
    { The bounding box used in scissor test. }
801
    property ScissorBox: TVector4i read FScissorBox write SetScissorBox;
802
    { Enables/Disables stencil test. }
803
    property EnableStencilTest: TGLboolean read FEnableStencilTest write
804
      SetEnableStencilTest;
805
    { The stencil function.  Determines the comparison function to be used
806
       when comparing the reference + stored stencil values.  }
807
    property StencilFunc: TStencilFunction read FStencilFunc;
808
    // write SetStencilFunc;
809
  { The stencil value mask.  Masks both the reference + stored stencil
810
     values. }
811
    property StencilValueMask: TGLuint read FStencilValueMask;
812
    // write SetStencilValueMask;
813
  { The stencil reference value.  Clamped to 0..255 with an 8 bit stencil. }
814
    property StencilRef: TGLint read FStencilRef; // write SetStencilRef;
815
    { The operation to perform when stencil test fails. }
816
    property StencilFail: TStencilOp read FStencilFail; // write SetStencilFail;
817
    { The operation to perform when stencil test passes + depth test fails. }
818
    property StencilPassDepthFail: TStencilOp read FStencilPassDepthFail;
819
    // write SetStencilPassDepthFail;
820
  { The operation to perform when stencil test passes + depth test passes. }
821
    property StencilPassDepthPass: TStencilOp read FStencilPassDepthPass;
822
    // write SetStencilPassDepthPass;
823

824
  { The stencil back function.  Determines the comparison function to be
825
     used when comparing the reference + stored stencil values on back
826
     facing primitives. }
827
    property StencilBackFunc: TStencilFunction read FStencilBackFunc;
828
    // write SetStencilBackFunc;
829
  { The stencil back value mask.  Masks both the reference + stored stencil
830
     values. }
831
    property StencilBackValueMask: TGLuint read FStencilBackValueMask;
832
    // write SetStencilBackValueMask;
833
  { The stencil back reference value.  Clamped to 0..255 with an 8 bit
834
     stencil. }
835
    property StencilBackRef: TGLuint read FStencilBackRef;
836
    // write SetStencilBackRef;
837
  { The operation to perform when stencil test fails on back facing
838
     primitives. }
839
    property StencilBackFail: TStencilOp read FStencilBackFail;
840
    // write SetStencilBackFail;
841
  { The operation to perform when stencil test passes + depth test fails on
842
     back facing primitives. }
843
    property StencilBackPassDepthFail: TStencilOp read
844
      FStencilBackPassDepthFail;
845
    // write SetStencilBackPassDepthFail;
846
  { The operation to perform when stencil test passes + depth test passes on
847
     back facing primitives. }
848
    property StencilBackPassDepthPass: TStencilOp read
849
      FStencilBackPassDepthPass;
850
    // write SetStencilBackPassDepthPass;
851
  { Used to set stencil Function, Reference + Mask values, for both front +
852
     back facing primitives. }
853
    procedure SetStencilFunc(const func: TStencilFunction; const ref: TGLint;
854
      const mask: TGLuint);
855
    { Used to set stencil Function, Reference + Mask values for either the
856
       front or back facing primitives (or both, which is the same as calling
857
       SetStencilFunc). }
858
    procedure SetStencilFuncSeparate(const face: TCullFaceMode;
859
      const func: TStencilFunction; const ref: TGLint; const mask: TGLuint);
860
    { Used to set the StencilFail, StencilPassDepthFail + StencilPassDepthPass
861
       in one go. }
862
    procedure SetStencilOp(const fail, zfail, zpass: TStencilOp);
863
    { Used to set the StencilFail, StencilPassDepthFail + StencilPassDepthPass
864
       in one go, for either front or back facing primitives. }
865
    procedure SetStencilOpSeparate(const face: TCullFaceMode; const sfail,
866
      dpfail, dppass: TStencilOp);
867

868
    { Enables/disables depth testing. }
869
    property EnableDepthTest: TGLboolean read FEnableDepthTest write
870
      SetEnableDepthTest;
871
    { The depth function.  Used to determine whether to keep a fragment or
872
       discard it, depending on the current value stored in the depth buffer. }
873
    property DepthFunc: TDepthFunction read FDepthFunc write SetDepthFunc;
874
    { Enables/disables blending for each draw buffer. }
875
    property EnableBlend[Index: Integer]: TGLboolean read GetEnableBlend write
876
    SetEnableBlend;
877
    { The weighting factor used in blending equation, for source RGB. }
878
    property BlendSrcRGB: TBlendFunction read FBlendSrcRGB;
879
    // write SetBlendSrcRGB;
880
  { The weighting factor used in blending equation, for source alpha. }
881
    property BlendSrcAlpha: TBlendFunction read FBlendSrcAlpha;
882
    // write SetBlendSrcAlpha;
883
  { The weighting factor used in blending equation, for destination RGB. }
884
    property BlendDstRGB: TDstBlendFunction read FBlendDstRGB;
885
    // write SetBlendDstRGB;
886
  { The weighting factor used in blending equation, for destination alpha. }
887
    property BlendDstAlpha: TDstBlendFunction read FBlendDstAlpha;
888
    // write SetBlendDstAlpha;
889
  { Sets the weighting factors to be used by the blending equation, for
890
     both color + alpha. }
891
    procedure SetBlendFunc(const Src: TBlendFunction;
892
      const Dst: TDstBlendFunction);
893
    { Sets the weighting factors to be used by the blending equation, with
894
       separate values used for color + alpha components. }
895
    procedure SetBlendFuncSeparate(const SrcRGB: TBlendFunction;
896
      const DstRGB: TDstBlendFunction; const SrcAlpha: TBlendFunction;
897
      const DstAlpha: TDstBlendFunction);
898
    { The blending equation.  Determines how the incoming source fragment's
899
       RGB are combined with the destination RGB. }
900
    property BlendEquationRGB: TBlendEquation read FBlendEquationRGB;
901
    // write SetBlendEquationRGB;
902
  { The blending equation.  Determines how the incoming source fragment's
903
     alpha values are combined with the destination alpha values. }
904
    property BlendEquationAlpha: TBlendEquation read FBlendEquationAlpha;
905
    // write SetBlendEquationAlpha;
906
  { Sets the blend equation for RGB + alpha to the same value. }
907
    procedure SetBlendEquation(const mode: TBlendEquation);
908
    { Sets the blend equations for RGB + alpha separately. }
909
    procedure SetBlendEquationSeparate(const modeRGB, modeAlpha:
910
      TBlendEquation);
911
    { A constant blend color, that can be used in the blend equation. }
912
    property BlendColor: TVector read FBlendColor write SetBlendColor;
913
    { Enables/disables framebuffer SRGB. }
914
    property EnableFramebufferSRGB: TGLboolean read FEnableFramebufferSRGB write
915
      SetEnableFramebufferSRGB;
916
    { Enables/disables dithering. }
917
    property EnableDither: TGLboolean read FEnableDither write SetEnableDither;
918
    { Enables/disables color logic op. }
919
    property EnableColorLogicOp: TGLboolean read FEnableColorLogicOp write
920
      SetEnableColorLogicOp;
921
    { Logic op mode. }
922
    property LogicOpMode: TLogicOp read FLogicOpMode write SetLogicOpMode;
923

924
    // Framebuffer control
925
    { The color write mask, for each draw buffer. }
926
    property ColorWriteMask[Index: Integer]: TColorMask read GetColorWriteMask
927
    write SetColorWriteMask;
928
    { Set the color write mask for all draw buffers. }
929
    procedure SetColorMask(mask: TColorMask);
930
    { The depth write mask. }
931
    property DepthWriteMask: TGLBoolean read FDepthWriteMask write
932
      SetDepthWriteMask;
933
    { The stencil write mask. }
934
    property StencilWriteMask: TGLuint read FStencilWriteMask write
935
      SetStencilWriteMask;
936
    { The stencil back write mask. }
937
    property StencilBackWriteMask: TGLuint read FStencilBackWriteMask write
938
      SetStencilBackWriteMask;
939
    { The color clear value. }
940
    property ColorClearValue: TVector read FColorClearValue write
941
      SetColorClearValue;
942
    { The depth clear value. }
943
    property DepthClearValue: TGLfloat read FDepthClearValue write
944
      SetDepthClearValue;
945
    { The stencil clear value. }
946
    property StencilClearValue: TGLuint read FStencilClearValue write
947
      SetStencilClearValue;
948

949
    // Framebuffer
950
    { Framebuffer to be used for draw operations, 0 = default framebuffer. }
951
    property DrawFrameBuffer: TGLuint read FDrawFrameBuffer write
952
      SetDrawFrameBuffer;
953
    { Framebuffer to be used for read operations, 0 = default framebuffer. }
954
    property ReadFrameBuffer: TGLuint read FReadFrameBuffer write
955
      SetReadFrameBuffer;
956
    { set both draw + read framebuffer. }
957
    procedure SetFrameBuffer(const Value: TGLuint);
958
    //property FrameBuffer: TGLuint read FDrawFrameBuffer write SetFrameBuffer;
959

960
    // Renderbuffer
961
    { Currently bound render buffer. }
962
    property RenderBuffer: TGLuint read FRenderBuffer write SetRenderBuffer;
963

964
    // Pixels
965
    { Controls whether byte swapping occurs during pixel unpacking. }
966
    property UnpackSwapBytes: TGLboolean read FUnpackSwapBytes write
967
      SetUnpackSwapBytes;
968
    { Whether unpacked data is required with LSB (least significant bit) first. }
969
    property UnpackLSBFirst: TGLboolean read FUnpackLSBFirst write
970
      SetUnpackLSBFirst;
971
    { Unpack image height. }
972
    property UnpackImageHeight: TGLuint read FUnpackImageHeight write
973
      SetUnpackImageHeight;
974
    { Unpack skip images. }
975
    property UnpackSkipImages: TGLuint read FUnpackSkipImages write
976
      SetUnpackSkipImages;
977
    { Unpack row length. }
978
    property UnpackRowLength: TGLuint read FUnpackRowLength write
979
      SetUnpackRowLength;
980
    { Unpack skip rows. }
981
    property UnpackSkipRows: TGLuint read FUnpackSkipRows write
982
      SetUnpackSkipRows;
983
    { Unpack skip pixels. }
984
    property UnpackSkipPixels: TGLuint read FUnpackSkipPixels write
985
      SetUnpackSkipPixels;
986
    { Unpack alignment. }
987
    property UnpackAlignment: TGLuint read FUnpackAlignment write
988
      SetUnpackAlignment;
989
    { Controls whether byte swapping occurs during pixel packing. }
990
    property PackSwapBytes: TGLboolean read FPackSwapBytes write
991
      SetPackSwapBytes;
992
    { Whether packed data is required with LSB (least significant bit) first. }
993
    property PackLSBFirst: TGLboolean read FPackLSBFirst write SetPackLSBFirst;
994
    { Pack image height. }
995
    property PackImageHeight: TGLuint read FPackImageHeight write
996
      SetPackImageHeight;
997
    { Pack skip images. }
998
    property PackSkipImages: TGLuint read FPackSkipImages write
999
      SetPackSkipImages;
1000
    { Pack row length. }
1001
    property PackRowLength: TGLuint read FPackRowLength write SetPackRowLength;
1002
    { Pack skip rows. }
1003
    property PackSkipRows: TGLuint read FPackSkipRows write SetPackSkipRows;
1004
    { Pack skip pixels. }
1005
    property PackSkipPixels: TGLuint read FPackSkipPixels write
1006
      SetPackSkipPixels;
1007
    { Pack alignment. }
1008
    property PackAlignment: TGLuint read FPackAlignment write SetPackAlignment;
1009
    { Buffer bound for pixel packing (eg. ReadPixels). }
1010
    property PixelPackBufferBinding: TGLuint read FPixelPackBufferBinding
1011
      write SetPixelPackBufferBinding;
1012
    { Buffer bound for pixel unpacking (eg. Tex*Image). }
1013
    property PixelUnpackBufferBinding: TGLuint read FPixelUnpackBufferBinding
1014
      write SetPixelUnpackBufferBinding;
1015

1016
    // Program
1017
    { Currently bound program. }
1018
    property CurrentProgram: TGLuint read FCurrentProgram write
1019
      SetCurrentProgram;
1020
    property MaxTextureUnits: TGLuint read GetMaxTextureUnits;
1021
    { Currently bound uniform buffer. }
1022
    property UniformBufferBinding: TGLuint read FUniformBufferBinding
1023
      write SetUniformBufferBinding;
1024

1025
    procedure SetBufferIndexedBinding(const Value: TGLuint; ATarget: TGLBufferBindingTarget; AIndex: TGLuint; ABufferSize: TGLsizeiptr); overload;
1026
    procedure SetBufferIndexedBinding(const Value: TGLuint; ATarget: TGLBufferBindingTarget; AIndex: TGLuint; AOffset: TGLintptr; ARangeSize: TGLsizeiptr); overload;
1027

1028
    // Vector + Geometry Shader state
1029
    { Default values to be used when a vertex array is not used for that
1030
       attribute. }
1031
    property CurrentVertexAttrib[Index: Integer]: TVector
1032
    read GetCurrentVertexAttrib write SetCurrentVertexAttrib;
1033
    { Enables/disables program point size. }
1034
    property EnableProgramPointSize: TGLboolean read FEnableProgramPointSize
1035
      write SetEnableProgramPointSize;
1036

1037
    // Transform Feedback state
1038
    { Currently bound transform feedbac buffer. }
1039
    property TransformFeedbackBufferBinding: TGLuint
1040
      read FTransformFeedbackBufferBinding write
1041
      SetTransformFeedbackBufferBinding;
1042

1043
    // Hints
1044
    { Line smooth hint. }
1045
    property LineSmoothHint: THintType read FLineSmoothHint write
1046
      SetLineSmoothHint;
1047
    { Polygon smooth hint. }
1048
    property PolygonSmoothHint: THintType read FPolygonSmoothHint write
1049
      SetPolygonSmoothHint;
1050
    { Texture compression hint. }
1051
    property TextureCompressionHint: THintType
1052
      read FTextureCompressionHint write SetTextureCompressionHint;
1053
    { Fragment shader derivitive hint. }
1054
    property FragmentShaderDerivitiveHint: THintType
1055
      read FFragmentShaderDerivitiveHint write SetFragmentShaderDerivitiveHint;
1056
    property MultisampleFilterHint: THintType read FMultisampleFilterHint
1057
      write SetMultisampleFilterHint;
1058

1059
    // Misc
1060
    { Current queries. }
1061
    property CurrentQuery[Index: TQueryType]: TGLuint read GetCurrentQuery;
1062
    { Begins a query of "Target" type.  "Value" must be a valid query object. }
1063
    procedure BeginQuery(const Target: TQueryType; const Value: TGLuint);
1064
    { Ends current query of type "Target". }
1065
    procedure EndQuery(const Target: TQueryType);
1066
    { The buffer currently bound to the copy read buffer binding point, this
1067
       is an extra binding point provided so that you don't need to overwrite
1068
       other binding points to copy between buffers. }
1069
    property CopyReadBufferBinding: TGLuint read FCopyReadBufferBinding
1070
      write SetCopyReadBufferBinding;
1071
    { The buffer currently bound to the copy write buffer binding point, this
1072
       is an extra binding point provided so that you don't need to overwrite
1073
       other binding points to copy between buffers. }
1074
    property CopyWriteBufferBinding: TGLuint read FCopyWriteBufferBinding
1075
      write SetCopyWriteBufferBinding;
1076
    { Enables/Disables seamless texture cube maps. }
1077
    property EnableTextureCubeMapSeamless: TGLboolean read
1078
      FEnableTextureCubeMapSeamless write SetEnableTextureCubeMapSeamless;
1079
    { Indicates the current presence within the list. }
1080
    property InsideList: Boolean read FInsideList;
1081
    { Begin new display list. }
1082
    procedure NewList(list: TGLuint; mode: TGLEnum);
1083
    { End display list. }
1084
    procedure EndList;
1085
    { Call display list. }
1086
    procedure CallList(list: TGLuint);
1087

1088
    { Defines the OpenGL texture matrix.
1089
       Assumed texture mode is GL_MODELVIEW. }
1090
    procedure SetGLTextureMatrix(const matrix: TMatrix);
1091
    procedure ResetGLTextureMatrix;
1092
    procedure ResetAllGLTextureMatrix;
1093

1094
    // note: needs to change to per draw-buffer
1095
    procedure SetGLColorWriting(flag: Boolean);
1096

1097
    { Inverts front face winding (CCW/CW). }
1098
    procedure InvertGLFrontFace;
1099

1100
    // read only properties
1101
    property States: TGLStates read FStates;
1102

1103
    { True for ignore deprecated and removed features in OpenGL 3x }
1104
    property ForwardContext: Boolean read FForwardContext
1105
      write SetForwardContext;
1106

1107
  end;
1108

1109
type
1110
  TStateRecord = record
1111
    GLConst: TGLEnum;
1112
    GLDeprecated: Boolean;
1113
  end;
1114

1115
const
1116
{$WARN SYMBOL_DEPRECATED OFF}
1117
  cGLStateTypeToGLEnum: array[TGLStateType] of TGLenum = (
1118
    GL_CURRENT_BIT, GL_POINT_BIT, GL_LINE_BIT, GL_POLYGON_BIT,
1119
    GL_POLYGON_STIPPLE_BIT, GL_PIXEL_MODE_BIT, GL_LIGHTING_BIT, GL_FOG_BIT,
1120
    GL_DEPTH_BUFFER_BIT, GL_ACCUM_BUFFER_BIT, GL_STENCIL_BUFFER_BIT,
1121
    GL_VIEWPORT_BIT, GL_TRANSFORM_BIT, GL_ENABLE_BIT, GL_COLOR_BUFFER_BIT,
1122
    GL_HINT_BIT, GL_EVAL_BIT, GL_LIST_BIT, GL_TEXTURE_BIT, GL_SCISSOR_BIT,
1123
    GL_MULTISAMPLE_BIT);
1124

1125
{$WARN SYMBOL_DEPRECATED ON}
1126
  cGLStateToGLEnum: array[TGLState] of TStateRecord =
1127
    ((GLConst: GL_ALPHA_TEST; GLDeprecated: True),
1128
    (GLConst: GL_AUTO_NORMAL; GLDeprecated: True),
1129
    (GLConst: GL_BLEND; GLDeprecated: False),
1130
    (GLConst: GL_COLOR_MATERIAL; GLDeprecated: True),
1131
    (GLConst: GL_CULL_FACE; GLDeprecated: False),
1132
    (GLConst: GL_DEPTH_TEST; GLDeprecated: False),
1133
    (GLConst: GL_DITHER; GLDeprecated: False),
1134
    (GLConst: GL_FOG; GLDeprecated: True),
1135
    (GLConst: GL_LIGHTING; GLDeprecated: True),
1136
    (GLConst: GL_LINE_SMOOTH; GLDeprecated: True),
1137
    (GLConst: GL_LINE_STIPPLE; GLDeprecated: True),
1138
    (GLConst: GL_INDEX_LOGIC_OP; GLDeprecated: True),
1139
    (GLConst: GL_COLOR_LOGIC_OP; GLDeprecated: False),
1140
    (GLConst: GL_NORMALIZE; GLDeprecated: True),
1141
    (GLConst: GL_POINT_SMOOTH; GLDeprecated: True),
1142
    (GLConst: GL_POINT_SPRITE; GLDeprecated: True),
1143
    (GLConst: GL_POLYGON_SMOOTH; GLDeprecated: True),
1144
    (GLConst: GL_POLYGON_STIPPLE; GLDeprecated: True),
1145
    (GLConst: GL_SCISSOR_TEST; GLDeprecated: False),
1146
    (GLConst: GL_STENCIL_TEST; GLDeprecated: False),
1147
    (GLConst: GL_POLYGON_OFFSET_POINT; GLDeprecated: False),
1148
    (GLConst: GL_POLYGON_OFFSET_LINE; GLDeprecated: False),
1149
    (GLConst: GL_POLYGON_OFFSET_FILL; GLDeprecated: False),
1150
    (GLConst: GL_DEPTH_CLAMP; GLDeprecated: False)
1151
    );
1152

1153
  cGLTexTypeToGLEnum: array[TGLTextureTarget] of TGLenum =
1154
    (0, GL_TEXTURE_1D, GL_TEXTURE_2D, GL_TEXTURE_3D, GL_TEXTURE_1D_ARRAY,
1155
    GL_TEXTURE_2D_ARRAY, GL_TEXTURE_RECTANGLE, GL_TEXTURE_BUFFER,
1156
    GL_TEXTURE_CUBE_MAP, GL_TEXTURE_2D_MULTISAMPLE,
1157
    GL_TEXTURE_2D_MULTISAMPLE_ARRAY, GL_TEXTURE_CUBE_MAP_ARRAY);
1158

1159
  cGLQueryTypeToGLEnum: array[TQueryType] of TGLenum =
1160
    (GL_SAMPLES_PASSED, GL_PRIMITIVES_GENERATED,
1161
    GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN,
1162
    GL_TIME_ELAPSED, GL_ANY_SAMPLES_PASSED);
1163

1164
  cGLStencilOpToGLEnum: array[TStencilOp] of TGLenum =
1165
    (GL_KEEP, GL_ZERO, GL_REPLACE, GL_INCR, GL_DECR, GL_INVERT, GL_INCR_WRAP,
1166
    GL_DECR_WRAP);
1167

1168
  cGLLogicOpToGLEnum: array[TLogicOp] of TGLEnum =
1169
    (GL_CLEAR, GL_AND, GL_AND_REVERSE, GL_COPY, GL_AND_INVERTED, GL_NOOP,
1170
    GL_XOR, GL_OR, GL_NOR, GL_EQUIV, GL_INVERT, GL_OR_REVERSE,
1171
    GL_COPY_INVERTED, GL_OR_INVERTED, GL_NAND, GL_SET);
1172

1173
  cGLComparisonFunctionToGLEnum: array[TComparisonFunction] of TGLenum =
1174
    (GL_NEVER, GL_ALWAYS, GL_LESS, GL_LEQUAL, GL_EQUAL, GL_GREATER,
1175
    GL_NOTEQUAL, GL_GEQUAL);
1176

1177
  cGLBlendFunctionToGLEnum: array[TBlendFunction] of TGLenum =
1178
    (GL_ZERO, GL_ONE, GL_SRC_COLOR, GL_ONE_MINUS_SRC_COLOR, GL_DST_COLOR,
1179
    GL_ONE_MINUS_DST_COLOR, GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
1180
    GL_DST_ALPHA, GL_ONE_MINUS_DST_ALPHA, GL_CONSTANT_COLOR,
1181
    GL_ONE_MINUS_CONSTANT_COLOR, GL_CONSTANT_ALPHA,
1182
    GL_ONE_MINUS_CONSTANT_ALPHA, GL_SRC_ALPHA_SATURATE {valid for src only});
1183

1184
  cGLBlendEquationToGLEnum: array[TBlendEquation] of TGLEnum =
1185
    (GL_FUNC_ADD, GL_FUNC_SUBTRACT, GL_FUNC_REVERSE_SUBTRACT, GL_MIN,
1186
    GL_MAX);
1187

1188
  cGLFaceWindingToGLEnum: array[TFaceWinding] of TGLenum =
1189
    (GL_CCW, GL_CW);
1190

1191
  cGLPolygonModeToGLEnum: array[TPolygonMode] of TGLEnum =
1192
    (GL_FILL, GL_LINE, GL_POINT);
1193

1194
  cGLCullFaceModeToGLEnum: array[TCullFaceMode] of TGLEnum =
1195
    (GL_FRONT, GL_BACK, GL_FRONT_AND_BACK);
1196

1197
  cGLHintToGLEnum: array[THintType] of TGLEnum =
1198
    (GL_DONT_CARE, GL_FASTEST, GL_NICEST);
1199

1200
  cGLBufferBindingTarget: array[TGLBufferBindingTarget] of TGLEnum =
1201
    (GL_UNIFORM_BUFFER, GL_TRANSFORM_FEEDBACK_BUFFER);
1202
  //------------------------------------------------------
1203
  //------------------------------------------------------
1204
  //------------------------------------------------------
1205
implementation
1206
//------------------------------------------------------
1207
//------------------------------------------------------
1208
//------------------------------------------------------
1209

1210
uses
1211
  GLContext, GLColor;
1212

1213
{$IFDEF GLS_CACHE_MISS_CHECK}
1214
resourcestring
1215
  glsStateCashMissing = 'States cash missing: ';
1216
{$ENDIF}
1217

1218
  // ------------------
1219
  // ------------------ TGLStateCache ------------------
1220
  // ------------------
1221

1222
procedure TGLStateCache.BeginQuery(const Target: TQueryType; const Value:
1223
  TGLuint);
1224
begin
1225
  Assert(FCurrentQuery[Target] = 0, 'Can only have one query (of each type)' +
1226
    ' running at a time');
1227
  // Assert(glIsQuery(Value), 'Not a valid query');
1228
 //  if Value<>FCurrentQuery[Target] then
1229
  begin
1230
    FCurrentQuery[Target] := Value;
1231
    GL.BeginQuery(cGLQueryTypeToGLEnum[Target], Value);
1232
  end;
1233
end;
1234

1235
// Create
1236
//
1237
constructor TGLStateCache.Create;
1238
var
1239
  I: Integer;
1240
begin
1241
  inherited;
1242
  SetLength(FListStates, 128);
1243
  FCurrentList := 0;
1244

1245
  // Material colors
1246
  FFrontBackColors[0][0] := clrBlack;
1247
  FFrontBackColors[0][1] := clrGray20;
1248
  FFrontBackColors[0][2] := clrGray80;
1249
  FFrontBackColors[0][3] := clrBlack;
1250
  FFrontBackShininess[0] := 0;
1251

1252
  FFrontBackColors[1][0] := clrBlack;
1253
  FFrontBackColors[1][1] := clrGray20;
1254
  FFrontBackColors[1][2] := clrGray80;
1255
  FFrontBackColors[1][3] := clrBlack;
1256
  FFrontBackShininess[1] := 0;
1257

1258
  FAlphaFunc := cfAlways;
1259

1260
  // Lighting
1261
  FFFPLight := True;
1262
  FMaxLights := 0;
1263
  FLightNumber := 0;
1264

1265
  for I := High(FLightEnabling) downto 0 do
1266
  begin
1267
    FLightEnabling[I] := False;
1268
    FLightIndices[I] := 0;
1269
    FLightStates.Position[I] := NullHmgVector;
1270
    FLightStates.Ambient[I] := clrBlack;
1271
    FLightStates.Diffuse[I] := clrBlack;
1272
    FLightStates.Specular[I] := clrBlack;
1273
    FLightStates.SpotDirection[I] := VectorMake(0.0, 0.0, -1.0, 0.0);
1274
    FSpotCutoff[I] := 180.0;
1275
    FlightStates.SpotCosCutoffExponent[I].V[0] := -1;
1276
    FLightStates.SpotCosCutoffExponent[I].V[1] := 0;
1277
    FLightStates.Attenuation[I] := NullHmgVector;
1278
  end;
1279
  FLightStates.Diffuse[0] := clrWhite;
1280
  FLightStates.Specular[0] := clrWhite;
1281

1282
  for I := High(FTextureMatrixIsIdentity) downto 0 do
1283
    FTextureMatrixIsIdentity[I] := False;
1284
  FForwardContext := False;
1285

1286
  // Vertex Array Data state
1287
  FVertexArrayBinding := 0;
1288
  FTextureBufferBinding := 0;
1289

1290
  // Transformation state
1291
  // FViewPort := Rect(0,0,0,0);  // (0, 0, Width, Height)
1292
  FDepthRange[0] := 0.0;
1293
  FDepthRange[1] := 1.0;
1294

1295
  FillChar(FEnableClipDistance, sizeof(FEnableClipDistance), $00);
1296
  FEnableDepthClamp := false;
1297

1298
  // Coloring state
1299
  FClampReadColor := GL_FIXED_ONLY;
1300
  FProvokingVertex := GL_LAST_VERTEX_CONVENTION;
1301

1302
  // Rasterization state
1303
  FPointSize := 1.0;
1304
  FPointFadeThresholdSize := 1.0;
1305
  FPointSpriteCoordOrigin := GL_UPPER_LEFT;
1306
  FLineWidth := 1.0;
1307
  FLineStippleFactor := 1;
1308
  FLineStipplePattern := $FFFF;
1309
  FEnableLineSmooth := false;
1310
  FEnableCullFace := false;
1311
  FCullFaceMode := cmBack;
1312
  FFrontFace := fwCounterClockWise;
1313
  FEnablePolygonSmooth := false;
1314
  FPolygonMode := pmFill;
1315
  FPolygonOffsetFactor := 0.0;
1316
  FPolygonOffsetUnits := 0.0;
1317
  FEnablePolygonOffsetPoint := false;
1318
  FEnablePolygonOffsetLine := false;
1319
  FEnablePolygonOffsetFill := false;
1320

1321
  // Multisample state
1322
  FEnableMultisample := true;
1323
  FEnableSampleAlphaToCoverage := false;
1324
  FEnableSampleAlphaToOne := false;
1325
  FEnableSampleCoverage := false;
1326
  FSampleCoverageValue := 1.0;
1327
  FSampleCoverageInvert := false;
1328
  FEnableSampleMask := false;
1329
  FillChar(FSampleMaskValue, sizeof(FSampleMaskValue), $FF);
1330

1331
  // Texture state
1332
  FillChar(FTextureBinding, sizeof(FTextureBinding), $00);
1333
  FillChar(FActiveTextureEnabling, sizeof(FActiveTextureEnabling), $00);
1334

1335
  // Active texture state
1336
  FActiveTexture := 0;
1337

1338
  // Pixel operation state
1339
  FEnableScissorTest := false;
1340
  //    FScissorBox := Rect(0, 0, Width, Height);
1341
  FEnableStencilTest := false;
1342
  FStencilFunc := cfAlways;
1343
  FStencilValueMask := $FFFFFFFF;
1344
  FStencilRef := 0;
1345
  FStencilFail := soKeep;
1346
  FStencilPassDepthFail := soKeep;
1347
  FStencilPassDepthPass := soKeep;
1348

1349
  FStencilBackFunc := cfAlways;
1350
  FStencilBackValueMask := $FFFFFFFF;
1351
  FStencilBackRef := 0;
1352
  FStencilBackFail := soKeep;
1353
  FStencilBackPassDepthPass := soKeep;
1354
  FStencilBackPassDepthFail := soKeep;
1355

1356
  FEnableDepthTest := false;
1357
  FDepthFunc := cfLess;
1358

1359
  FillChar(FEnableBlend, sizeof(FEnableBlend), $0);
1360

1361
  FBlendSrcRGB := bfOne;
1362
  FBlendSrcAlpha := bfOne;
1363
  FBlendDstRGB := bfZero;
1364
  FBlendDstAlpha := bfZero;
1365

1366
  FBlendEquationRGB := beAdd;
1367
  FBlendEquationAlpha := beAdd;
1368
  FBlendColor := NullHmgVector;
1369

1370
  FEnableFramebufferSRGB := false;
1371
  FEnableDither := true;
1372
  FEnableColorLogicOp := false;
1373

1374
  FLogicOpMode := loCopy;
1375

1376
  // Framebuffer control state
1377
//    for I := 0 to Length(FColorWriteMask) - 1 do
1378
//      FColorWriteMask[i] := [ccRed, ccGreen, ccBlue, ccAlpha];
1379
  FillChar(FColorWriteMask, sizeof(FColorWriteMask), $F);
1380
  FDepthWriteMask := True;
1381
  FStencilWriteMask := $FFFFFFFF;
1382
  FStencilBackWriteMask := $FFFFFFFF;
1383
  FColorClearValue := NullHmgVector;
1384
  FDepthClearValue := 1.0;
1385
  FStencilClearValue := 0;
1386

1387
  // Framebuffer state
1388
  FDrawFrameBuffer := 0;
1389
  FReadFrameBuffer := 0;
1390

1391
  // Renderbuffer state
1392
  FRenderBuffer := 0;
1393

1394
  // Pixels state
1395
  FUnpackSwapBytes := false;
1396
  FUnpackLSBFirst := false;
1397
  FUnpackImageHeight := 0;
1398
  FUnpackSkipImages := 0;
1399
  FUnpackRowLength := 0;
1400
  FUnpackSkipRows := 0;
1401
  FUnpackSkipPixels := 0;
1402
  FUnpackAlignment := 4;
1403
  FPackSwapBytes := False;
1404
  FPackLSBFirst := False;
1405
  FPackImageHeight := 0;
1406
  FPackSkipImages := 0;
1407
  FPackRowLength := 0;
1408
  FPackSkipRows := 0;
1409
  FPackSkipPixels := 0;
1410
  FPackAlignment := 4;
1411

1412
  FPixelPackBufferBinding := 0;
1413
  FPixelUnpackBufferBinding := 0;
1414

1415
  // Program state
1416
  FCurrentProgram := 0;
1417
  FUniformBufferBinding := 0;
1418
  FillChar(FUBOStates[bbtUniform][0], SizeOf(FUBOStates), $00);
1419

1420
  // Vector + Geometry Shader state
1421
  for I := 0 to Length(FCurrentVertexAttrib) - 1 do
1422
    FCurrentVertexAttrib[I] := NullHmgPoint;
1423
  FEnableProgramPointSize := false;
1424

1425
  // Transform Feedback state
1426
  FTransformFeedbackBufferBinding := 0;
1427

1428
  // Hints state
1429
  FTextureCompressionHint := hintDontCare;
1430
  FPolygonSmoothHint := hintDontCare;
1431
  FFragmentShaderDerivitiveHint := hintDontCare;
1432
  FLineSmoothHint := hintDontCare;
1433

1434
  // Misc state
1435
  FillChar(FCurrentQuery, sizeof(FCurrentQuery), $00);
1436
  FCopyReadBufferBinding := 0;
1437
  FCopyWriteBufferBinding := 0;
1438
  FEnableTextureCubeMapSeamless := false;
1439
  FInsideList := False;
1440
end;
1441

1442
// Destroy
1443
//
1444
destructor TGLStateCache.Destroy;
1445
begin
1446
  inherited;
1447
end;
1448

1449
procedure TGLStateCache.EndQuery(const Target: TQueryType);
1450
begin
1451
  Assert(FCurrentQuery[Target] <> 0, 'No query running');
1452
  FCurrentQuery[Target] := 0;
1453
  GL.EndQuery(cGLQueryTypeToGLEnum[Target]);
1454
end;
1455

1456
// Enable
1457
//
1458
procedure TGLStateCache.Enable(const aState: TGLState);
1459
begin
1460
  if cGLStateToGLEnum[aState].GLDeprecated and FForwardContext then
1461
    exit;
1462
  if not (aState in FStates) or FInsideList then
1463
  begin
1464
    if FInsideList then
1465
      Include(FListStates[FCurrentList], sttEnable)
1466
    else
1467
      Include(FStates, aState);
1468
{$IFDEF GLS_CACHE_MISS_CHECK}
1469
    if GL.IsEnabled(cGLStateToGLEnum[aState].GLConst) then
1470
      GLSLogger.LogError(glsStateCashMissing + 'Enable');
1471
{$ENDIF}
1472
    GL.Enable(cGLStateToGLEnum[aState].GLConst);
1473
  end;
1474
end;
1475

1476
// Disable
1477
//
1478
procedure TGLStateCache.Disable(const aState: TGLState);
1479
begin
1480
  if cGLStateToGLEnum[aState].GLDeprecated and FForwardContext then
1481
    exit;
1482
  if (aState in FStates) or FInsideList then
1483
  begin
1484
    if FInsideList then
1485
      Include(FListStates[FCurrentList], sttEnable)
1486
    else
1487
      Exclude(FStates, aState);
1488
{$IFDEF GLS_CACHE_MISS_CHECK}
1489
    if not GL.IsEnabled(cGLStateToGLEnum[aState].GLConst) then
1490
      GLSLogger.LogError(glsStateCashMissing + 'Disable');
1491
{$ENDIF}
1492
    GL.Disable(cGLStateToGLEnum[aState].GLConst);
1493
    if aState = stColorMaterial then
1494
      if FInsideList then
1495
        Include(FListStates[FCurrentList], sttLighting)
1496
      else
1497
        with GL do
1498
        begin
1499
          Materialfv(GL_FRONT, GL_EMISSION, @FFrontBackColors[0][0]);
1500
          Materialfv(GL_FRONT, GL_AMBIENT, @FFrontBackColors[0][1]);
1501
          Materialfv(GL_FRONT, GL_DIFFUSE, @FFrontBackColors[0][2]);
1502
          Materialfv(GL_FRONT, GL_SPECULAR, @FFrontBackColors[0][3]);
1503
          Materiali(GL_FRONT, GL_SHININESS, FFrontBackShininess[0]);
1504

1505
          Materialfv(GL_BACK, GL_EMISSION, @FFrontBackColors[1][0]);
1506
          Materialfv(GL_BACK, GL_AMBIENT, @FFrontBackColors[1][1]);
1507
          Materialfv(GL_BACK, GL_DIFFUSE, @FFrontBackColors[1][2]);
1508
          Materialfv(GL_BACK, GL_SPECULAR, @FFrontBackColors[1][3]);
1509
          Materiali(GL_BACK, GL_SHININESS, FFrontBackShininess[1]);
1510
        end;
1511
  end;
1512
end;
1513

1514
// PerformEnable
1515
//
1516

1517
procedure TGLStateCache.PerformEnable(const aState: TGLState);
1518
begin
1519
  if cGLStateToGLEnum[aState].GLDeprecated and FForwardContext then
1520
    exit;
1521
  Include(FStates, aState);
1522
  GL.Enable(cGLStateToGLEnum[aState].GLConst);
1523
end;
1524

1525
// PerformDisable
1526
//
1527
procedure TGLStateCache.PerformDisable(const aState: TGLState);
1528
begin
1529
  if cGLStateToGLEnum[aState].GLDeprecated and FForwardContext then
1530
    exit;
1531
  Exclude(FStates, aState);
1532
  GL.Disable(cGLStateToGLEnum[aState].GLConst);
1533
end;
1534

1535
procedure TGLStateCache.PopAttrib;
1536
begin
1537
  // TODO: replace with proper client side push/pop
1538
  GL.PopAttrib();
1539
end;
1540

1541
procedure TGLStateCache.PushAttrib(stateTypes: TGLStateTypes);
1542
var
1543
  tempFlag: TGLuint;
1544
  I: Integer;
1545
begin
1546
  // TODO: replace with proper client side push/pop
1547
  tempFlag := 0;
1548
  for I := Integer(Low(TGLStateType)) to Integer(high(TGLStateType)) do
1549
  begin
1550
    if TGLStateType(I) in stateTypes then
1551
    begin
1552
      tempFlag := tempFlag or cGLStateTypeToGLEnum[TGLStateType(I)];
1553
    end;
1554
  end;
1555
  GL.PushAttrib(tempFlag);
1556
end;
1557

1558
// SetGLMaterialColors
1559
//
1560

1561
procedure TGLStateCache.SetGLMaterialColors(const aFace: TCullFaceMode;
1562
  const emission, ambient, diffuse, specular: TVector;
1563
  const shininess: Integer);
1564
var
1565
  i: Integer;
1566
  currentFace: TGLenum;
1567
begin
1568
  if FForwardContext then
1569
    exit;
1570
  Assert((aFace = cmFront) or (aFace = cmBack),
1571
    'Only cmFront or cmBack supported');
1572
  i := Integer(aFace);
1573
  currentFace := cGLCullFaceModeToGLEnum[aFace];
1574

1575
  if (FFrontBackShininess[i] <> shininess)
1576
    or FInsideList then
1577
  begin
1578
    GL.Materiali(currentFace, GL_SHININESS, shininess);
1579
    if not FInsideList then
1580
      FFrontBackShininess[i] := shininess;
1581
  end;
1582
  if not AffineVectorEquals(FFrontBackColors[i][0], emission)
1583
    or FInsideList then
1584
  begin
1585
    GL.Materialfv(currentFace, GL_EMISSION, @emission);
1586
    if not FInsideList then
1587
      SetVector(FFrontBackColors[i][0], emission);
1588
  end;
1589
  if not AffineVectorEquals(FFrontBackColors[i][1], ambient)
1590
    or FInsideList then
1591
  begin
1592
    GL.Materialfv(currentFace, GL_AMBIENT, @ambient);
1593
    if not FInsideList then
1594
      SetVector(FFrontBackColors[i][1], ambient);
1595
  end;
1596
  if not VectorEquals(FFrontBackColors[i][2], diffuse)
1597
    or FInsideList then
1598
  begin
1599
    GL.Materialfv(currentFace, GL_DIFFUSE, @diffuse);
1600
    if not FInsideList then
1601
      SetVector(FFrontBackColors[i][2], diffuse);
1602
  end;
1603
  if not AffineVectorEquals(FFrontBackColors[i][3], specular)
1604
    or FInsideList then
1605
  begin
1606
    GL.Materialfv(currentFace, GL_SPECULAR, @specular);
1607
    if not FInsideList then
1608
      SetVector(FFrontBackColors[i][3], specular);
1609
  end;
1610
  if FInsideList then
1611
    Include(FListStates[FCurrentList], sttLighting);
1612
end;
1613

1614
// SetGLMaterialAlphaChannel
1615
//
1616

1617
procedure TGLStateCache.SetGLMaterialAlphaChannel(const aFace: TGLEnum; const
1618
  alpha: TGLFloat);
1619
var
1620
  i: Integer;
1621
  color: TVector4f;
1622
begin
1623
  if FForwardContext then Exit;
1624

1625
  if not(stLighting in FStates) then
1626
  begin
1627
    // We need a temp variable, because FColor is cauched.
1628
    GL.GetFloatv(GL_CURRENT_COLOR, @color);
1629
    color.V[3] := alpha;
1630
    GL.Color4fv(@color);
1631
  end
1632
  else
1633
  begin
1634
    i := aFace - GL_FRONT;
1635
    if (FFrontBackColors[i][2].V[3] <> alpha) or FInsideList then
1636
    begin
1637
      if FInsideList then
1638
      begin
1639
        Include(FListStates[FCurrentList], sttLighting);
1640
        GL.Materialfv(aFace, GL_DIFFUSE, @FFrontBackColors[i][2]);
1641

1642
      end
1643
      else
1644
      begin
1645
        FFrontBackColors[i][2].V[3] := alpha;
1646
        GL.Materialfv(aFace, GL_DIFFUSE, @FFrontBackColors[i][2]);
1647
      end;
1648
    end;
1649
  end;
1650
end;
1651

1652
procedure TGLStateCache.SetGLMaterialDiffuseColor(const aFace: TGLEnum; const diffuse: TVector);
1653
var
1654
  i: Integer;
1655
begin
1656
  if FForwardContext then Exit;
1657

1658
  if not(stLighting in FStates) then
1659
  begin
1660
    GL.Color4fv(@diffuse);
1661
  end
1662
  else
1663
  begin
1664
    //
1665
    i := aFace - GL_FRONT;
1666
    if (not VectorEquals(FFrontBackColors[i][2], diffuse)) or FInsideList then
1667
    begin
1668
      if FInsideList then
1669
      begin
1670
        Include(FListStates[FCurrentList], sttLighting);
1671
        GL.Materialfv(aFace, GL_DIFFUSE, @FFrontBackColors[i][2]);
1672
      end
1673
      else
1674
      begin
1675
        FFrontBackColors[i][2] := diffuse;
1676
        GL.Materialfv(aFace, GL_DIFFUSE, @diffuse);
1677
      end;
1678
    end;
1679
  end;
1680
end;
1681

1682
procedure TGLStateCache.SetActiveTexture(const Value: TGLint);
1683
begin
1684
  if GL.ARB_multitexture then
1685
    if (Value <> FActiveTexture) or FInsideList then
1686
    begin
1687
      if FInsideList then
1688
        Include(FListStates[FCurrentList], sttTexture)
1689
      else
1690
        FActiveTexture := Value;
1691
      GL.ActiveTexture(GL_TEXTURE0 + Value);
1692
    end;
1693
end;
1694

1695
procedure TGLStateCache.SetVertexArrayBinding(const Value: TGLuint);
1696
begin
1697
  if Value <> FVertexArrayBinding then
1698
  begin
1699
    FVertexArrayBinding := Value;
1700
    GL.BindVertexArray(Value);
1701
  end;
1702
end;
1703

1704
function TGLStateCache.GetArrayBufferBinding: TGLuint;
1705
begin
1706
  Result := FArrayBufferBinding;
1707
end;
1708

1709
procedure TGLStateCache.SetArrayBufferBinding(const Value: TGLuint);
1710
begin
1711
  if (Value <> FArrayBufferBinding) or (FVertexArrayBinding <> 0) then
1712
  begin
1713
    FArrayBufferBinding := Value;
1714
    GL.BindBuffer(GL_ARRAY_BUFFER, Value);
1715
  end;
1716
end;
1717

1718
function TGLStateCache.GetElementBufferBinding: TGLuint;
1719
begin
1720
  Result := FElementBufferBinding
1721
end;
1722

1723
procedure TGLStateCache.SetElementBufferBinding(const Value: TGLuint);
1724
begin
1725
  if (Value <> FElementBufferBinding) or (FVertexArrayBinding <> 0) then
1726
  begin
1727
    FElementBufferBinding := Value;
1728
    GL.BindBuffer(GL_ELEMENT_ARRAY_BUFFER, Value);
1729
  end;
1730
end;
1731

1732
function TGLStateCache.GetEnablePrimitiveRestart: TGLboolean;
1733
begin
1734
  Result := FEnablePrimitiveRestart;
1735
end;
1736

1737
procedure TGLStateCache.SetEnablePrimitiveRestart(const enabled: TGLboolean);
1738
begin
1739
  if enabled <> FEnablePrimitiveRestart then
1740
  begin
1741
    FEnablePrimitiveRestart := enabled;
1742
    if FForwardContext then
1743
    begin
1744
      if enabled then
1745
        GL.Enable(GL_PRIMITIVE_RESTART)
1746
      else
1747
        GL.Disable(GL_PRIMITIVE_RESTART);
1748
    end
1749
    else if GL.NV_primitive_restart then
1750
    begin
1751
      if enabled then
1752
        GL.EnableClientState(GL_PRIMITIVE_RESTART_NV)
1753
      else
1754
        GL.DisableClientState(GL_PRIMITIVE_RESTART_NV);
1755
    end;
1756
  end;
1757
end;
1758

1759
function TGLStateCache.GetPrimitiveRestartIndex: TGLuint;
1760
begin
1761
  Result := FPrimitiveRestartIndex;
1762
end;
1763

1764
procedure TGLStateCache.SetPrimitiveRestartIndex(const index: TGLuint);
1765
begin
1766
  if index <> FPrimitiveRestartIndex then
1767
  begin
1768
    if GL.NV_primitive_restart or FForwardContext then
1769
    begin
1770
      FPrimitiveRestartIndex := index;
1771
      GL.PrimitiveRestartIndex(index)
1772
    end;
1773
  end;
1774
end;
1775

1776
procedure TGLStateCache.SetEnableProgramPointSize(const Value: TGLboolean);
1777
begin
1778
  if Value <> FEnableProgramPointSize then
1779
  begin
1780
    FEnableProgramPointSize := Value;
1781
    if Value then
1782
      GL.Enable(GL_PROGRAM_POINT_SIZE)
1783
    else
1784
      GL.Disable(GL_PROGRAM_POINT_SIZE);
1785
  end;
1786
end;
1787

1788
procedure TGLStateCache.SetBlendColor(const Value: TVector);
1789
begin
1790
  if not VectorEquals(Value, FBlendColor) or FInsideList then
1791
  begin
1792
    if FInsideList then
1793
      Include(FListStates[FCurrentList], sttColorBuffer)
1794
    else
1795
      FBlendColor := Value;
1796
    GL.BlendColor(Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
1797
  end;
1798
end;
1799

1800
procedure TGLStateCache.SetBlendEquationSeparate(const modeRGB, modeAlpha:
1801
  TBlendEquation);
1802
begin
1803
  if (modeRGB <> FBlendEquationRGB) or (modeAlpha <> FBlendEquationAlpha)
1804
    or FInsideList then
1805
  begin
1806
    FBlendEquationRGB := modeRGB;
1807
    FBlendEquationAlpha := modeAlpha;
1808
    GL.BlendEquationSeparate(cGLBlendEquationToGLEnum[modeRGB],
1809
      cGLBlendEquationToGLEnum[modeAlpha]);
1810
  end;
1811
  if FInsideList then
1812
    Include(FListStates[FCurrentList], sttColorBuffer);
1813
end;
1814

1815
procedure TGLStateCache.SetBlendEquation(const mode: TBlendEquation);
1816
begin
1817
  if (mode <> FBlendEquationRGB) or (mode <> FBlendEquationAlpha)
1818
    or FInsideList then
1819
  begin
1820
    if FInsideList then
1821
      Include(FListStates[FCurrentList], sttColorBuffer)
1822
    else
1823
    begin
1824
      FBlendEquationRGB := mode;
1825
      FBlendEquationAlpha := mode;
1826
    end;
1827
    GL.BlendEquation(cGLBlendEquationToGLEnum[mode]);
1828
  end;
1829
end;
1830

1831
procedure TGLStateCache.SetBlendFunc(const Src: TBlendFunction;
1832
  const Dst: TDstBlendFunction);
1833
begin
1834
  if (Src <> FBlendSrcRGB) or (Dst <> FBlendDstRGB) or FInsideList then
1835
  begin
1836
    if FInsideList then
1837
      Include(FListStates[FCurrentList], sttColorBuffer)
1838
    else
1839
    begin
1840
      FBlendSrcRGB := Src;
1841
      FBlendDstRGB := Dst;
1842
      FBlendSrcAlpha := Src;
1843
      FBlendSrcAlpha := Dst;
1844
    end;
1845
    GL.BlendFunc(cGLBlendFunctionToGLEnum[Src], cGLBlendFunctionToGLEnum[Dst]);
1846
  end;
1847
end;
1848

1849
procedure TGLStateCache.SetBlendFuncSeparate(const SrcRGB: TBlendFunction;
1850
  const DstRGB: TDstBlendFunction; const SrcAlpha: TBlendFunction;
1851
  const DstAlpha: TDstBlendFunction);
1852
begin
1853
  if (SrcRGB <> FBlendSrcRGB) or (DstRGB <> FBlendDstRGB) or
1854
    (SrcAlpha <> FBlendSrcAlpha) or (DstAlpha <> FBlendDstAlpha)
1855
    or FInsideList then
1856
  begin
1857
    if FInsideList then
1858
      Include(FListStates[FCurrentList], sttColorBuffer)
1859
    else
1860
    begin
1861
      FBlendSrcRGB := SrcRGB;
1862
      FBlendDstRGB := DstRGB;
1863
      FBlendSrcAlpha := SrcAlpha;
1864
      FBlendDstAlpha := DstAlpha;
1865
    end;
1866
    GL.BlendFuncSeparate(
1867
      cGLBlendFunctionToGLEnum[SrcRGB],
1868
      cGLBlendFunctionToGLEnum[DstRGB],
1869
      cGLBlendFunctionToGLEnum[SrcAlpha],
1870
      cGLBlendFunctionToGLEnum[DstAlpha]);
1871
  end;
1872
end;
1873

1874
procedure TGLStateCache.SetClampReadColor(const Value: TGLenum);
1875
begin
1876
  if (Value <> FClampReadColor) or FInsideList then
1877
  begin
1878
    if FInsideList then
1879
      Include(FListStates[FCurrentList], sttColorBuffer)
1880
    else
1881
      FClampReadColor := Value;
1882
    GL.ClampColor(GL_CLAMP_READ_COLOR, Value);
1883
  end;
1884
end;
1885

1886
procedure TGLStateCache.SetColorWriteMask(Index: Integer;
1887
  const Value: TColorMask);
1888
begin
1889
  if FColorWriteMask[Index] <> Value then
1890
  begin
1891
    FColorWriteMask[Index] := Value;
1892
    GL.ColorMaski(Index, ccRed in Value, ccGreen in Value, ccBlue in Value,
1893
      ccAlpha in Value);
1894
  end;
1895
end;
1896

1897
procedure TGLStateCache.SetCopyReadBufferBinding(const Value: TGLuint);
1898
begin
1899
  if Value <> FCopyReadBufferBinding then
1900
  begin
1901
    FCopyReadBufferBinding := Value;
1902
    GL.BindBuffer(GL_COPY_READ_BUFFER, Value);
1903
  end;
1904
end;
1905

1906
procedure TGLStateCache.SetCopyWriteBufferBinding(const Value: TGLuint);
1907
begin
1908
  if Value <> FCopyWriteBufferBinding then
1909
  begin
1910
    FCopyWriteBufferBinding := Value;
1911
    GL.BindBuffer(GL_COPY_WRITE_BUFFER, Value);
1912
  end;
1913
end;
1914

1915
procedure TGLStateCache.SetCullFaceMode(const Value: TCullFaceMode);
1916
begin
1917
  if (Value <> FCullFaceMode) or FInsideList then
1918
  begin
1919
    if FInsideList then
1920
      Include(FListStates[FCurrentList], sttPolygon)
1921
    else
1922
      FCullFaceMode := Value;
1923
    GL.CullFace(cGLCullFaceModeToGLEnum[Value]);
1924
  end;
1925

1926
end;
1927

1928
procedure TGLStateCache.SetCurrentProgram(const Value: TGLuint);
1929
begin
1930
  if Value <> FCurrentProgram then
1931
  begin
1932
    FCurrentProgram := Value;
1933
    GL.UseProgram(Value);
1934
  end;
1935
end;
1936

1937
procedure TGLStateCache.SetTextureBufferBinding(const Value: TGLuint);
1938
begin
1939
  if Value <> FTextureBufferBinding then
1940
  begin
1941
    FTextureBufferBinding := Value;
1942
    GL.BindBuffer(GL_TEXTURE_BUFFER, Value);
1943
  end;
1944
end;
1945

1946
procedure TGLStateCache.SetCurrentVertexAttrib(Index: Integer;
1947
  const Value: TVector);
1948
begin
1949
  if not VectorEquals(Value, FCurrentVertexAttrib[Index]) then
1950
  begin
1951
    FCurrentVertexAttrib[Index] := Value;
1952
    GL.VertexAttrib4fv(Index, @Value.V[0]);
1953
  end;
1954
end;
1955

1956
procedure TGLStateCache.SetDepthClearValue(const Value: TGLfloat);
1957
begin
1958
  if (Value <> FDepthClearValue) or FInsideList then
1959
  begin
1960
    if FInsideList then
1961
      Include(FListStates[FCurrentList], sttDepthBuffer)
1962
    else
1963
      FDepthClearValue := Value;
1964
    GL.ClearDepth(Value);
1965
  end;
1966

1967
end;
1968

1969
procedure TGLStateCache.SetDepthFunc(const Value: TDepthFunction);
1970
begin
1971
  if (Value <> FDepthFunc) or FInsideList then
1972
  begin
1973
    if FInsideList then
1974
      Include(FListStates[FCurrentList], sttDepthBuffer)
1975
    else
1976
      FDepthFunc := Value;
1977
    GL.DepthFunc(cGLComparisonFunctionToGLEnum[Value]);
1978
  end;
1979

1980
end;
1981

1982
procedure TGLStateCache.SetDepthRange(const ZNear, ZFar: TGLclampd);
1983
begin
1984
  if (ZNear <> FDepthRange[0]) or (ZFar <> FDepthRange[1])
1985
    or FInsideList then
1986
  begin
1987
    if FInsideList then
1988
      Include(FListStates[FCurrentList], sttViewport)
1989
    else
1990
    begin
1991
      FDepthRange[0] := ZNear;
1992
      FDepthRange[1] := ZFar;
1993
    end;
1994
    GL.DepthRange(ZNear, ZFar);
1995
  end;
1996
end;
1997

1998
procedure TGLStateCache.SetDepthRangeFar(const Value: TGLclampd);
1999
begin
2000
  if (Value <> FDepthRange[1]) or FInsideList then
2001
  begin
2002
    if FInsideList then
2003
      Include(FListStates[FCurrentList], sttViewport)
2004
    else
2005
      FDepthRange[1] := Value;
2006
    GL.DepthRange(FDepthRange[0], Value);
2007
  end;
2008
end;
2009

2010
procedure TGLStateCache.SetDepthRangeNear(const Value: TGLclampd);
2011
begin
2012
  if (Value <> FDepthRange[0]) or FInsideList then
2013
  begin
2014
    if FInsideList then
2015
      Include(FListStates[FCurrentList], sttViewport)
2016
    else
2017
      FDepthRange[0] := Value;
2018
    GL.DepthRange(Value, FDepthRange[1]);
2019
  end;
2020
end;
2021

2022
procedure TGLStateCache.SetDepthWriteMask(const Value: TGLboolean);
2023
begin
2024
  if (Value <> FDepthWriteMask) or FInsideList then
2025
  begin
2026
    if FInsideList then
2027
      Include(FListStates[FCurrentList], sttDepthBuffer)
2028
    else
2029
      FDepthWriteMask := Value;
2030
    GL.DepthMask(Value);
2031
  end;
2032
end;
2033

2034
procedure TGLStateCache.SetDrawFrameBuffer(const Value: TGLuint);
2035
begin
2036
  if Value <> FDrawFrameBuffer then
2037
  begin
2038
    FDrawFrameBuffer := Value;
2039
    GL.BindFramebuffer(GL_DRAW_FRAMEBUFFER, Value);
2040
  end;
2041
end;
2042

2043
procedure TGLStateCache.SetEnableBlend(Index: Integer;
2044
  const Value: TGLboolean);
2045
begin
2046
  if FEnableBlend[Index] <> Value then
2047
  begin
2048
    FEnableBlend[Index] := Value;
2049
    if Value then
2050
      GL.Enablei(GL_BLEND, Index)
2051
    else
2052
      GL.Disablei(GL_BLEND, Index);
2053
  end;
2054
end;
2055

2056
procedure TGLStateCache.SetEnableClipDistance(Index: Cardinal;
2057
  const Value: TGLboolean);
2058
begin
2059
  if FEnableClipDistance[Index] <> Value then
2060
  begin
2061
    FEnableClipDistance[Index] := Value;
2062
    if Value then
2063
      GL.Enable(GL_CLIP_DISTANCE0 + Index)
2064
    else
2065
      GL.Disable(GL_CLIP_DISTANCE0 + Index);
2066
  end;
2067
end;
2068

2069
procedure TGLStateCache.SetEnableColorLogicOp(const Value: TGLboolean);
2070
begin
2071
  if Value <> FEnableColorLogicOp then
2072
  begin
2073
    FEnableColorLogicOp := Value;
2074
    if Value then
2075
      GL.Enable(GL_COLOR_LOGIC_OP)
2076
    else
2077
      GL.Disable(GL_COLOR_LOGIC_OP);
2078
  end;
2079
end;
2080

2081
procedure TGLStateCache.SetEnableCullFace(const Value: TGLboolean);
2082
begin
2083

2084
end;
2085

2086
procedure TGLStateCache.SetEnableDepthClamp(const enabled: TGLboolean);
2087
begin
2088

2089
end;
2090

2091
procedure TGLStateCache.SetEnableDepthTest(const Value: TGLboolean);
2092
begin
2093

2094
end;
2095

2096
procedure TGLStateCache.SetEnableDither(const Value: TGLboolean);
2097
begin
2098

2099
end;
2100

2101
procedure TGLStateCache.SetEnableFramebufferSRGB(const Value: TGLboolean);
2102
begin
2103

2104
end;
2105

2106
procedure TGLStateCache.SetEnableLineSmooth(const Value: TGLboolean);
2107
begin
2108

2109
end;
2110

2111
procedure TGLStateCache.SetEnableMultisample(const Value: TGLboolean);
2112
begin
2113

2114
end;
2115

2116
procedure TGLStateCache.SetEnablePolygonOffsetFill(const Value: TGLboolean);
2117
begin
2118

2119
end;
2120

2121
procedure TGLStateCache.SetEnablePolygonOffsetLine(const Value: TGLboolean);
2122
begin
2123

2124
end;
2125

2126
procedure TGLStateCache.SetEnablePolygonOffsetPoint(const Value: TGLboolean);
2127
begin
2128

2129
end;
2130

2131
procedure TGLStateCache.SetEnablePolygonSmooth(const Value: TGLboolean);
2132
begin
2133

2134
end;
2135

2136
procedure TGLStateCache.SetEnableSampleAlphaToCoverage(const Value: TGLboolean);
2137
begin
2138
  if Value <> FEnableSampleAlphaToCoverage then
2139
  begin
2140
    FEnableSampleAlphaToCoverage := Value;
2141
    if Value then
2142
      GL.Enable(GL_SAMPLE_ALPHA_TO_COVERAGE)
2143
    else
2144
      GL.Disable(GL_SAMPLE_ALPHA_TO_COVERAGE);
2145
  end;
2146
end;
2147

2148
procedure TGLStateCache.SetEnableSampleCoverage(const Value: TGLboolean);
2149
begin
2150
  if Value <> FEnableSampleCoverage then
2151
  begin
2152
    FEnableSampleCoverage := Value;
2153
    if Value then
2154
      GL.Enable(GL_SAMPLE_COVERAGE)
2155
    else
2156
      GL.Disable(GL_SAMPLE_COVERAGE);
2157
  end;
2158
end;
2159

2160
procedure TGLStateCache.SetEnableSampleMask(const Value: TGLboolean);
2161
begin
2162
  if Value <> FEnableSampleMask then
2163
  begin
2164
    FEnableSampleMask := Value;
2165
    if Value then
2166
      GL.Enable(GL_SAMPLE_MASK)
2167
    else
2168
      GL.Disable(GL_SAMPLE_MASK);
2169
  end;
2170
end;
2171

2172
procedure TGLStateCache.SetEnableSampleAlphaToOne(const Value: TGLboolean);
2173
begin
2174
  if Value <> FEnableSampleAlphaToOne then
2175
  begin
2176
    FEnableSampleAlphaToOne := Value;
2177
    if Value then
2178
      GL.Enable(GL_SAMPLE_ALPHA_TO_ONE)
2179
    else
2180
      GL.Disable(GL_SAMPLE_ALPHA_TO_ONE);
2181
  end;
2182
end;
2183

2184
procedure TGLStateCache.SetEnableScissorTest(const Value: TGLboolean);
2185
begin
2186

2187
end;
2188

2189
procedure TGLStateCache.SetEnableStencilTest(const Value: TGLboolean);
2190
begin
2191

2192
end;
2193

2194
procedure TGLStateCache.SetFragmentShaderDerivitiveHint(const Value: THintType);
2195
begin
2196
  if Value <> FFragmentShaderDerivitiveHint then
2197
  begin
2198
    if FInsideList then
2199
      Include(FListStates[FCurrentList], sttHint)
2200
    else
2201
      FFragmentShaderDerivitiveHint := Value;
2202
    GL.Hint(GL_FRAGMENT_SHADER_DERIVATIVE_HINT, cGLHintToGLEnum[Value]);
2203
  end;
2204
end;
2205

2206
procedure TGLStateCache.SetMultisampleFilterHint(const Value: THintType);
2207
begin
2208
  if GL.NV_multisample_filter_hint then
2209
    if Value <> FMultisampleFilterHint then
2210
    begin
2211
      if FInsideList then
2212
        Include(FListStates[FCurrentList], sttHint)
2213
      else
2214
        FMultisampleFilterHint := Value;
2215
      GL.Hint(GL_MULTISAMPLE_FILTER_HINT_NV, cGLHintToGLEnum[Value]);
2216
    end;
2217
end;
2218

2219
procedure TGLStateCache.SetFrameBuffer(const Value: TGLuint);
2220
begin
2221
  if (Value <> FDrawFrameBuffer) or (Value <> FReadFrameBuffer)
2222
    or FInsideList then
2223
  begin
2224
    FDrawFrameBuffer := Value;
2225
    FReadFrameBuffer := Value;
2226
    GL.BindFramebuffer(GL_FRAMEBUFFER, Value);
2227
  end;
2228
end;
2229

2230
procedure TGLStateCache.SetFrontFace(const Value: TFaceWinding);
2231
begin
2232
  if (Value <> FFrontFace) or FInsideList then
2233
  begin
2234
    if FInsideList then
2235
      Include(FListStates[FCurrentList], sttPolygon)
2236
    else
2237
      FFrontFace := Value;
2238
    GL.FrontFace(cGLFaceWindingToGLEnum[Value]);
2239
  end;
2240
end;
2241

2242
procedure TGLStateCache.SetGLAlphaFunction(func: TComparisonFunction;
2243
  ref: TGLclampf);
2244
{$IFDEF GLS_CACHE_MISS_CHECK}
2245
var I: TGLuint; E: Single;
2246
{$ENDIF}
2247
begin
2248
  if FForwardContext then
2249
    exit;
2250
{$IFDEF GLS_CACHE_MISS_CHECK}
2251
  GL.GetIntegerv(GL_ALPHA_TEST_FUNC, @I);
2252
  if cGLComparisonFunctionToGLEnum[FAlphaFunc] <> I then
2253
    GLSLogger.LogError(glsStateCashMissing + 'AlphaTest function');
2254
  GL.GetFloatv(GL_ALPHA_TEST_REF, @E);
2255
  if FAlphaRef <> E then
2256
    GLSLogger.LogError(glsStateCashMissing + 'AlphaTest reference');
2257
{$ENDIF}
2258
  if (FAlphaFunc <> func) or (FAlphaRef <> ref)
2259
    or FInsideList then
2260
  begin
2261
    if FInsideList then
2262
      Include(FListStates[FCurrentList], sttColorBuffer)
2263
    else
2264
    begin
2265
      FAlphaFunc := func;
2266
      FAlphaRef := ref;
2267
    end;
2268
    GL.AlphaFunc(cGLComparisonFunctionToGLEnum[func], ref);
2269
  end;
2270
end;
2271

2272
function TGLStateCache.GetColorWriteMask(Index: Integer): TColorMask;
2273
begin
2274
  Result := FColorWriteMask[Index];
2275
end;
2276

2277
function TGLStateCache.GetCurrentQuery(Index: TQueryType): TGLuint;
2278
begin
2279
  Result := FCurrentQuery[Index];
2280
end;
2281

2282
function TGLStateCache.GetCurrentVertexAttrib(Index: Integer): TVector;
2283
begin
2284
  Result := FCurrentVertexAttrib[Index];
2285
end;
2286

2287
function TGLStateCache.GetDepthRangeFar: TGLclampd;
2288
begin
2289
  Result := FDepthRange[1];
2290
end;
2291

2292
function TGLStateCache.GetDepthRangeNear: TGLclampd;
2293
begin
2294
  Result := FDepthRange[0];
2295
end;
2296

2297
function TGLStateCache.GetEnableBlend(Index: Integer): TGLboolean;
2298
begin
2299
  Result := FEnableBlend[Index];
2300
end;
2301

2302
function TGLStateCache.GetEnableClipDistance(
2303
  ClipDistance: Cardinal): TGLboolean;
2304
begin
2305
  Result := FEnableClipDistance[ClipDistance];
2306
end;
2307

2308
function TGLStateCache.GetSampleMaskValue(Index: Integer): TGLbitfield;
2309
begin
2310
  Result := FSampleMaskValue[Index];
2311
end;
2312

2313
function TGLStateCache.GetMaxTextureSize: TGLuint;
2314
begin
2315
  if FMaxTextureSize = 0 then
2316
    GL.GetIntegerv(GL_MAX_TEXTURE_SIZE, @FMaxTextureSize);
2317
  Result := FMaxTextureSize;
2318
end;
2319

2320
function TGLStateCache.GetMaterialAmbient(const aFace: TCullFaceMode): TVector;
2321
begin
2322
  Result := FFrontBackColors[ord(aFace)][1];
2323
end;
2324

2325
function TGLStateCache.GetMaterialDiffuse(const aFace: TCullFaceMode): TVector;
2326
begin
2327
  Result := FFrontBackColors[ord(aFace)][2];
2328
end;
2329

2330
function TGLStateCache.GetMaterialEmission(const aFace: TCullFaceMode): TVector;
2331
begin
2332
  Result := FFrontBackColors[ord(aFace)][0];
2333
end;
2334

2335
function TGLStateCache.GetMaterialShininess(const aFace: TCullFaceMode): Integer;
2336
begin
2337
  Result := FFrontBackShininess[ord(aFace)];
2338
end;
2339

2340
function TGLStateCache.GetMaterialSpecular(const aFace: TCullFaceMode): TVector;
2341
begin
2342
  Result := FFrontBackColors[ord(aFace)][3];
2343
end;
2344

2345
function TGLStateCache.GetMax3DTextureSize: TGLuint;
2346
begin
2347
  if FMax3DTextureSize = 0 then
2348
    GL.GetIntegerv(GL_MAX_3D_TEXTURE_SIZE, @FMax3DTextureSize);
2349
  Result := FMax3DTextureSize;
2350
end;
2351

2352
function TGLStateCache.GetMaxCubeTextureSize: TGLuint;
2353
begin
2354
  if FMaxCubeTextureSize = 0 then
2355
    GL.GetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @FMaxCubeTextureSize);
2356
  Result := FMaxCubeTextureSize;
2357
end;
2358

2359
function TGLStateCache.GetMaxArrayTextureSize: TGLuint;
2360
begin
2361
  if FMaxArrayTextureSize = 0 then
2362
    GL.GetIntegerv(GL_MAX_ARRAY_TEXTURE_LAYERS, @FMaxArrayTextureSize);
2363
  Result := FMaxArrayTextureSize;
2364
end;
2365

2366

2367
function TGLStateCache.GetMaxTextureImageUnits: TGLuint;
2368
begin
2369
  if FMaxTextureImageUnits = 0 then
2370
    GL.GetIntegerv(GL_MAX_TEXTURE_IMAGE_UNITS, @FMaxTextureImageUnits);
2371
  Result := FMaxTextureImageUnits;
2372
end;
2373

2374
function TGLStateCache.GetMaxTextureAnisotropy: TGLuint;
2375
begin
2376
  if (FMaxTextureAnisotropy = 0) and GL.EXT_texture_filter_anisotropic then
2377
    GL.GetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @FMaxTextureAnisotropy);
2378
  Result := FMaxTextureAnisotropy;
2379
end;
2380

2381
function TGLStateCache.GetMaxSamples: TGLuint;
2382
begin
2383
  if (FMaxSamples = 0) and GL.EXT_multisample then
2384
    GL.GetIntegerv(GL_MAX_SAMPLES, @FMaxSamples);
2385
  Result := FMaxSamples;
2386
end;
2387

2388
function TGLStateCache.GetTextureBinding(Index: Integer;
2389
  target: TGLTextureTarget): TGLuint;
2390
begin
2391
  Result := FTextureBinding[Index, target];
2392
end;
2393

2394
function TGLStateCache.GetTextureBindingTime(Index: Integer; target: TGLTextureTarget):
2395
  Double;
2396
begin
2397
  Result := FTextureBindingTime[Index, target];
2398
end;
2399

2400
function TGLStateCache.GetSamplerBinding(Index: TGLuint): TGLuint;
2401
begin
2402
  Result := FSamplerBinding[Index];
2403
end;
2404

2405
procedure TGLStateCache.SetSamplerBinding(Index: TGLuint; const Value: TGLuint);
2406
begin
2407
  if Index > High(FSamplerBinding) then
2408
    exit;
2409
  if (Value <> FSamplerBinding[Index]) or FInsideList then
2410
  begin
2411
    if FInsideList then
2412
      Include(FListStates[FCurrentList], sttTexture)
2413
    else
2414
      FSamplerBinding[Index] := Value;
2415
    GL.BindSampler(Index, Value);
2416
  end;
2417
end;
2418

2419
// SetGLTextureMatrix
2420
//
2421

2422
procedure TGLStateCache.SetGLTextureMatrix(const matrix: TMatrix);
2423
begin
2424
  if FForwardContext then
2425
    exit;
2426
  if FInsideList then
2427
    Include(FListStates[FCurrentList], sttTransform)
2428
  else
2429
    FTextureMatrixIsIdentity[ActiveTexture] := False;
2430
  GL.MatrixMode(GL_TEXTURE);
2431
  GL.LoadMatrixf(PGLFloat(@matrix.V[0].V[0]));
2432
  GL.MatrixMode(GL_MODELVIEW);
2433
end;
2434

2435
// ResetGLTextureMatrix
2436
//
2437

2438
procedure TGLStateCache.ResetGLTextureMatrix;
2439
begin
2440
  if FForwardContext then
2441
    exit;
2442
  GL.MatrixMode(GL_TEXTURE);
2443
  GL.LoadIdentity;
2444
  FTextureMatrixIsIdentity[ActiveTexture] := True;
2445
  GL.MatrixMode(GL_MODELVIEW);
2446
end;
2447

2448
// ResetAllGLTextureMatrix
2449
//
2450

2451
procedure TGLStateCache.ResetAllGLTextureMatrix;
2452
var
2453
  I: Integer;
2454
  lastActiveTexture: TGLuint;
2455
begin
2456
  if FForwardContext then
2457
    exit;
2458
  lastActiveTexture := ActiveTexture;
2459
  GL.MatrixMode(GL_TEXTURE);
2460
  for I := High(FTextureMatrixIsIdentity) downto 0 do
2461
    if not FTextureMatrixIsIdentity[I] then
2462
    begin
2463
      ActiveTexture := I;
2464
      GL.LoadIdentity;
2465
      FTextureMatrixIsIdentity[I] := True;
2466
    end;
2467
  GL.MatrixMode(GL_MODELVIEW);
2468
  ActiveTexture := lastActiveTexture;
2469
end;
2470

2471
procedure TGLStateCache.SetLineSmoothHint(const Value: THintType);
2472
begin
2473
  if (Value <> FLineSmoothHint) or FInsideList then
2474
  begin
2475
    if FInsideList then
2476
      Include(FListStates[FCurrentList], sttHint)
2477
    else
2478
      FLineSmoothHint := Value;
2479
    GL.Hint(GL_LINE_SMOOTH_HINT, cGLHintToGLEnum[Value]);
2480
  end;
2481
end;
2482

2483
procedure TGLStateCache.SetLineWidth(const Value: TGLfloat);
2484
begin
2485
  // note: wide lines no longer deprecated (see OpenGL spec)
2486
  if (Value <> FLineWidth) or FInsideList then
2487
  begin
2488
    if FInsideList then
2489
      Include(FListStates[FCurrentList], sttLine)
2490
    else
2491
      FLineWidth := Value;
2492
    GL.LineWidth(Value);
2493
  end;
2494
end;
2495

2496
procedure TGLStateCache.SetLineStippleFactor(const Value: TGLint);
2497
begin
2498
  if (Value <> FLineStippleFactor) or FInsideList then
2499
  begin
2500
    if FInsideList then
2501
      Include(FListStates[FCurrentList], sttLine)
2502
    else
2503
      FLineStippleFactor := Value;
2504
    GL.LineStipple(Value, FLineStipplePattern);
2505
  end;
2506
end;
2507

2508
procedure TGLStateCache.SetLineStipplePattern(const Value: TGLushort);
2509
begin
2510
  if (Value <> FLineStipplePattern) or FInsideList then
2511
  begin
2512
    if FInsideList then
2513
      Include(FListStates[FCurrentList], sttLine)
2514
    else
2515
      FLineStipplePattern := Value;
2516
    GL.LineStipple(FLineStippleFactor, Value);
2517
  end;
2518
end;
2519

2520
procedure TGLStateCache.SetLogicOpMode(const Value: TLogicOp);
2521
begin
2522
  if (Value <> FLogicOpMode) or FInsideList then
2523
  begin
2524
    if FInsideList then
2525
      Include(FListStates[FCurrentList], sttColorBuffer)
2526
    else
2527
      FLogicOpMode := Value;
2528
    GL.LogicOp(cGLLogicOpToGLEnum[Value]);
2529
  end;
2530
end;
2531

2532
procedure TGLStateCache.SetPackAlignment(const Value: TGLuint);
2533
begin
2534
  if Value <> FPackAlignment then
2535
  begin
2536
    FPackAlignment := Value;
2537
    GL.PixelStoref(GL_PACK_ALIGNMENT, Value);
2538
  end;
2539
end;
2540

2541
procedure TGLStateCache.SetPackImageHeight(const Value: TGLuint);
2542
begin
2543
  if Value <> FPackImageHeight then
2544
  begin
2545
    FPackImageHeight := Value;
2546
    GL.PixelStoref(GL_PACK_IMAGE_HEIGHT, Value);
2547
  end;
2548
end;
2549

2550
procedure TGLStateCache.SetPackLSBFirst(const Value: TGLboolean);
2551
begin
2552
  if Value <> FPackLSBFirst then
2553
  begin
2554
    FPackLSBFirst := Value;
2555
    GL.PixelStorei(GL_PACK_LSB_FIRST, byte(Value));
2556
  end;
2557
end;
2558

2559
procedure TGLStateCache.SetPackRowLength(const Value: TGLuint);
2560
begin
2561
  if Value <> FPackRowLength then
2562
  begin
2563
    FPackRowLength := Value;
2564
    GL.PixelStoref(GL_PACK_ROW_LENGTH, Value);
2565
  end;
2566
end;
2567

2568
procedure TGLStateCache.SetPackSkipImages(const Value: TGLuint);
2569
begin
2570
  if Value <> FPackSkipImages then
2571
  begin
2572
    FPackSkipImages := Value;
2573
    GL.PixelStoref(GL_PACK_SKIP_IMAGES, Value);
2574
  end;
2575
end;
2576

2577
procedure TGLStateCache.SetPackSkipPixels(const Value: TGLuint);
2578
begin
2579
  if Value <> FPackSkipPixels then
2580
  begin
2581
    FPackSkipPixels := Value;
2582
    GL.PixelStoref(GL_PACK_SKIP_PIXELS, Value);
2583
  end;
2584
end;
2585

2586
procedure TGLStateCache.SetPackSkipRows(const Value: TGLuint);
2587
begin
2588
  if Value <> FPackSkipRows then
2589
  begin
2590
    FPackSkipRows := Value;
2591
    GL.PixelStoref(GL_PACK_SKIP_ROWS, Value);
2592
  end;
2593
end;
2594

2595
procedure TGLStateCache.SetPackSwapBytes(const Value: TGLboolean);
2596
begin
2597
  if Value <> FPackSwapBytes then
2598
  begin
2599
    FPackSwapBytes := Value;
2600
    GL.PixelStorei(GL_PACK_SWAP_BYTES, byte(Value));
2601
  end;
2602
end;
2603

2604
procedure TGLStateCache.SetPixelPackBufferBinding(const Value: TGLuint);
2605
begin
2606
  if Value <> FPixelPackBufferBinding then
2607
  begin
2608
    FPixelPackBufferBinding := Value;
2609
    GL.BindBuffer(GL_PIXEL_PACK_BUFFER, Value);
2610
  end;
2611
end;
2612

2613
procedure TGLStateCache.SetPixelUnpackBufferBinding(const Value: TGLuint);
2614
begin
2615
  if Value <> FPixelUnpackBufferBinding then
2616
  begin
2617
    FPixelUnpackBufferBinding := Value;
2618
    GL.BindBuffer(GL_PIXEL_UNPACK_BUFFER, Value);
2619
  end;
2620
end;
2621

2622
procedure TGLStateCache.SetPointFadeThresholdSize(const Value: TGLfloat);
2623
begin
2624
  if (Value <> FPointFadeThresholdSize) or FInsideList then
2625
  begin
2626
    if FInsideList then
2627
      Include(FListStates[FCurrentList], sttPoint)
2628
    else
2629
      FPointFadeThresholdSize := Value;
2630
    GL.PointParameterf(GL_POINT_FADE_THRESHOLD_SIZE, Value);
2631
  end;
2632
end;
2633

2634
procedure TGLStateCache.SetPointSize(const Value: TGLfloat);
2635
begin
2636
  if (Value <> FPointSize) or FInsideList then
2637
  begin
2638
    if FInsideList then
2639
      Include(FListStates[FCurrentList], sttPoint)
2640
    else
2641
      FPointSize := Value;
2642
    GL.PointSize(Value);
2643
  end;
2644
end;
2645

2646
procedure TGLStateCache.SetPointSpriteCoordOrigin(const Value: TGLenum);
2647
begin
2648
  if (Value <> FPointSpriteCoordOrigin) or FInsideList then
2649
  begin
2650
    if FInsideList then
2651
      Include(FListStates[FCurrentList], sttPoint)
2652
    else
2653
      FPointSpriteCoordOrigin := Value;
2654
    GL.PointParameterf(GL_POINT_SPRITE_COORD_ORIGIN, Value);
2655
  end;
2656
end;
2657

2658
procedure TGLStateCache.SetPolygonMode(const Value: TPolygonMode);
2659
begin
2660
  if (Value <> FPolygonMode) or FInsideList then
2661
  begin
2662
    if FInsideList then
2663
      Include(FListStates[FCurrentList], sttPolygon)
2664
    else
2665
    begin
2666
      FPolygonMode := Value;
2667
      FPolygonBackMode := Value;
2668
    end;
2669
    GL.PolygonMode(GL_FRONT_AND_BACK, cGLPolygonModeToGLEnum[Value]);
2670
  end;
2671
end;
2672

2673
procedure TGLStateCache.SetPolygonOffset(const factor, units: TGLfloat);
2674
begin
2675
  if (factor <> FPolygonOffsetFactor) or (units <> FPolygonOffsetUnits)
2676
    or FInsideList then
2677
  begin
2678
    if FInsideList then
2679
      Include(FListStates[FCurrentList], sttPolygon)
2680
    else
2681
    begin
2682
      FPolygonOffsetFactor := factor;
2683
      FPolygonOffsetUnits := units;
2684
    end;
2685
    GL.PolygonOffset(factor, units);
2686
  end;
2687
end;
2688

2689
procedure TGLStateCache.SetPolygonOffsetFactor(const Value: TGLfloat);
2690
begin
2691
  if (Value <> FPolygonOffsetFactor) or FInsideList then
2692
  begin
2693
    if FInsideList then
2694
      Include(FListStates[FCurrentList], sttPolygon)
2695
    else
2696
      FPolygonOffsetFactor := Value;
2697
    GL.PolygonOffset(Value, FPolygonOffsetUnits);
2698
  end;
2699
end;
2700

2701
procedure TGLStateCache.SetPolygonOffsetUnits(const Value: TGLfloat);
2702
begin
2703
  if (Value <> FPolygonOffsetUnits) or FInsideList then
2704
  begin
2705
    if FInsideList then
2706
      Include(FListStates[FCurrentList], sttPolygon)
2707
    else
2708
      FPolygonOffsetUnits := Value;
2709
    GL.PolygonOffset(FPolygonOffsetFactor, Value);
2710
  end;
2711
end;
2712

2713
procedure TGLStateCache.SetPolygonSmoothHint(const Value: THintType);
2714
begin
2715
  if (Value <> FPolygonSmoothHint) or FInsideList then
2716
  begin
2717
    if FInsideList then
2718
      Include(FListStates[FCurrentList], sttHint)
2719
    else
2720
      FPolygonSmoothHint := Value;
2721
    GL.Hint(GL_POLYGON_SMOOTH_HINT, cGLHintToGLEnum[Value]);
2722
  end;
2723
end;
2724

2725
procedure TGLStateCache.SetProvokingVertex(const Value: TGLenum);
2726
begin
2727
  if Value <> FProvokingVertex then
2728
  begin
2729
    FProvokingVertex := Value;
2730
    GL.ProvokingVertex(Value);
2731
  end;
2732
end;
2733

2734
procedure TGLStateCache.SetReadFrameBuffer(const Value: TGLuint);
2735
begin
2736
  if Value <> FReadFrameBuffer then
2737
  begin
2738
    FReadFrameBuffer := Value;
2739
    GL.BindFramebuffer(GL_READ_FRAMEBUFFER, Value);
2740
  end;
2741
end;
2742

2743
procedure TGLStateCache.SetRenderBuffer(const Value: TGLuint);
2744
begin
2745
  if Value <> FRenderBuffer then
2746
  begin
2747
    FRenderBuffer := Value;
2748
    GL.BindRenderbuffer(GL_RENDERBUFFER, Value);
2749
  end;
2750
end;
2751

2752
procedure TGLStateCache.SetSampleCoverage(const Value: TGLfloat;
2753
  invert: TGLboolean);
2754
begin
2755
  if (Value <> FSampleCoverageValue) or (invert <> FSampleCoverageInvert)
2756
    or FInsideList then
2757
  begin
2758
    if FInsideList then
2759
      Include(FListStates[FCurrentList], sttMultisample)
2760
    else
2761
    begin
2762
      FSampleCoverageValue := Value;
2763
      FSampleCoverageInvert := invert;
2764
    end;
2765
    GL.SampleCoverage(Value, invert);
2766
  end;
2767
end;
2768

2769
procedure TGLStateCache.SetSampleCoverageInvert(const Value: TGLboolean);
2770
begin
2771
  if (Value <> FSampleCoverageInvert) or FInsideList then
2772
  begin
2773
    if FInsideList then
2774
      Include(FListStates[FCurrentList], sttMultisample)
2775
    else
2776
      FSampleCoverageInvert := Value;
2777
    GL.SampleCoverage(FSampleCoverageValue, Value);
2778
  end;
2779
end;
2780

2781
procedure TGLStateCache.SetSampleCoverageValue(const Value: TGLfloat);
2782
begin
2783
  if (Value <> FSampleCoverageValue) or FInsideList then
2784
  begin
2785
    if FInsideList then
2786
      Include(FListStates[FCurrentList], sttMultisample)
2787
    else
2788
      FSampleCoverageValue := Value;
2789
    GL.SampleCoverage(Value, FSampleCoverageInvert);
2790
  end;
2791
end;
2792

2793
procedure TGLStateCache.SetSampleMaskValue(Index: Integer;
2794
  const Value: TGLbitfield);
2795
begin
2796
  if (FSampleMaskValue[Index] <> Value) or FInsideList then
2797
  begin
2798
    if FInsideList then
2799
      Include(FListStates[FCurrentList], sttMultisample)
2800
    else
2801
      FSampleMaskValue[Index] := Value;
2802
    GL.SampleMaski(Index, Value);
2803
  end;
2804
end;
2805

2806
procedure TGLStateCache.SetScissorBox(const Value: TVector4i);
2807
begin
2808
  if not VectorEquals(FScissorBox, Value) or FInsideList then
2809
  begin
2810
    if FInsideList then
2811
      Include(FListStates[FCurrentList], sttScissor)
2812
    else
2813
      FScissorBox := Value;
2814
    GL.Scissor(Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
2815
  end;
2816
end;
2817

2818
procedure TGLStateCache.SetStencilBackWriteMask(const Value: TGLuint);
2819
begin
2820
  if (Value <> FStencilBackWriteMask) or FInsideList then
2821
  begin
2822
    if FInsideList then
2823
      Include(FListStates[FCurrentList], sttStencilBuffer)
2824
    else
2825
      FStencilBackWriteMask := Value;
2826
    // DONE: ignore if unsupported
2827
    if GL.VERSION_2_0 then
2828
      GL.StencilMaskSeparate(GL_BACK, Value);
2829
  end;
2830
end;
2831

2832
procedure TGLStateCache.SetStencilClearValue(const Value: TGLuint);
2833
{$IFDEF GLS_CACHE_MISS_CHECK}
2834
var I: TGLuint;
2835
{$ENDIF}
2836
begin
2837
{$IFDEF GLS_CACHE_MISS_CHECK}
2838
  GL.GetIntegerv(GL_STENCIL_CLEAR_VALUE, @I);
2839
  if FStencilClearValue <> I then
2840
    GLSLogger.LogError(glsStateCashMissing + 'Stencil clear value');
2841
{$ENDIF}
2842
  if (Value <> FStencilClearValue) or FInsideList then
2843
  begin
2844
    if FInsideList then
2845
      Include(FListStates[FCurrentList], sttStencilBuffer)
2846
    else
2847
      FStencilClearValue := Value;
2848
    GL.ClearStencil(Value);
2849
  end;
2850
end;
2851

2852
procedure TGLStateCache.SetColorClearValue(const Value: TVector);
2853
begin
2854
  if not VectorEquals(Value, FColorClearValue) or FInsideList then
2855
  begin
2856
    if FInsideList then
2857
      Include(FListStates[FCurrentList], sttColorBuffer)
2858
    else
2859
      FColorClearValue := Value;
2860
    GL.ClearColor(Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
2861
  end;
2862
end;
2863

2864
procedure TGLStateCache.SetColorMask(mask: TColorMask);
2865
var
2866
  i: integer;
2867
begin
2868
  // it might be faster to keep track of whether all draw buffers are same
2869
  // value or not, since using this is probably more common than setting
2870
  // the color write mask for individual draw buffers
2871
  if FInsideList then
2872
    Include(FListStates[FCurrentList], sttColorBuffer)
2873
  else
2874
    for I := low(FColorWriteMask) to high(FColorWriteMask) do
2875
    begin
2876
      FColorWriteMask[I] := mask;
2877
    end;
2878
  GL.ColorMask(ccRed in mask, ccGreen in mask, ccBlue in mask, ccAlpha in mask);
2879
end;
2880

2881
procedure TGLStateCache.SetStencilFuncSeparate(const face: TCullFaceMode;
2882
  const func: TStencilFunction; const ref: TGLint; const mask: TGLuint);
2883
{$IFDEF GLS_CACHE_MISS_CHECK}
2884
var UI: TGLuint; I: TGLint;
2885
{$ENDIF}
2886
begin
2887
//  if (func<>FStencilFunc) or (ref<>FStencilRef) or (mask<>FStencilValueMask)
2888
//    or FInsideList then
2889
{$IFDEF GLS_CACHE_MISS_CHECK}
2890
  GL.GetIntegerv(GL_STENCIL_FUNC, @UI);
2891
  if cGLComparisonFunctionToGLEnum[FStencilFunc] <> UI then
2892
    GLSLogger.LogError(glsStateCashMissing + 'Stencil function');
2893
  GL.GetIntegerv(GL_STENCIL_REF, @I);
2894
  if FStencilRef <> I then
2895
    GLSLogger.LogError(glsStateCashMissing + 'Stencil reference');
2896
    GLSLogger.LogError(glsStateCashMissing + 'Stencil function');
2897
  GL.GetIntegerv(GL_STENCIL_VALUE_MASK, @UI);
2898
  if FStencilValueMask <> UI then
2899
    GLSLogger.LogError(glsStateCashMissing + 'Stencil value mask');
2900
{$ENDIF}
2901
  begin
2902
    if FInsideList then
2903
      Include(FListStates[FCurrentList], sttStencilBuffer)
2904
    else
2905
      case face of
2906
        cmFront:
2907
          begin
2908
            FStencilFunc := func;
2909
            FStencilRef := ref;
2910
            FStencilValueMask := mask;
2911
          end;
2912
        cmBack:
2913
          begin
2914
            FStencilBackFunc := func;
2915
            FStencilBackRef := ref;
2916
            FStencilBackValueMask := mask;
2917
          end;
2918
        cmFrontAndBack:
2919
          begin
2920
            FStencilFunc := func;
2921
            FStencilRef := ref;
2922
            FStencilValueMask := mask;
2923
            FStencilBackFunc := func;
2924
            FStencilBackRef := ref;
2925
            FStencilBackValueMask := mask;
2926
          end;
2927
      end;
2928

2929
    GL.StencilFuncSeparate(cGLCullFaceModeToGLEnum[face],
2930
      cGLComparisonFunctionToGLEnum[func], ref, mask);
2931
  end;
2932
end;
2933

2934
procedure TGLStateCache.SetStencilFunc(const func: TStencilFunction; const ref:
2935
  TGLint; const mask: TGLuint);
2936
begin
2937
  if (func <> FStencilFunc) or (ref <> FStencilRef) or (mask <>
2938
    FStencilValueMask) or FInsideList then
2939
  begin
2940
    if FInsideList then
2941
      Include(FListStates[FCurrentList], sttStencilBuffer)
2942
    else
2943
    begin
2944
      FStencilFunc := func;
2945
      FStencilRef := ref;
2946
      FStencilValueMask := mask;
2947
    end;
2948
    GL.StencilFunc(cGLComparisonFunctionToGLEnum[func], ref, mask);
2949
  end;
2950
end;
2951

2952
procedure TGLStateCache.SetStencilOp(const fail, zfail, zpass: TStencilOp);
2953
{$IFDEF GLS_CACHE_MISS_CHECK}
2954
var I: TGLuint;
2955
{$ENDIF}
2956
begin
2957
{$IFDEF GLS_CACHE_MISS_CHECK}
2958
  GL.GetIntegerv(GL_STENCIL_FAIL, @I);
2959
  if cGLStencilOpToGLEnum[FStencilFail] <> I then
2960
    GLSLogger.LogError(glsStateCashMissing + 'Stencil fail');
2961
  GL.GetIntegerv(GL_STENCIL_PASS_DEPTH_FAIL, @I);
2962
  if cGLStencilOpToGLEnum[FStencilPassDepthFail] <> I then
2963
    GLSLogger.LogError(glsStateCashMissing + 'Stencil zfail');
2964
  GL.GetIntegerv(GL_STENCIL_PASS_DEPTH_PASS, @I);
2965
  if cGLStencilOpToGLEnum[FStencilPassDepthPass] <> I then
2966
    GLSLogger.LogError(glsStateCashMissing + 'Stencil zpass');
2967
{$ENDIF}
2968
  if (fail <> FStencilFail) or (zfail <> FStencilPassDepthFail)
2969
    or (zpass <> FStencilPassDepthPass) or FInsideList then
2970
  begin
2971
    if FInsideList then
2972
      Include(FListStates[FCurrentList], sttStencilBuffer)
2973
    else
2974
    begin
2975
      FStencilFail := fail;
2976
      FStencilPassDepthFail := zfail;
2977
      FStencilPassDepthPass := zpass;
2978
    end;
2979
    GL.StencilOp(cGLStencilOpToGLEnum[fail],
2980
      cGLStencilOpToGLEnum[zfail],
2981
      cGLStencilOpToGLEnum[zpass]);
2982
  end;
2983
end;
2984

2985
procedure TGLStateCache.SetStencilOpSeparate(const face: TCullFaceMode;
2986
  const sfail, dpfail, dppass: TStencilOp);
2987
begin
2988
  if FInsideList then
2989
    Include(FListStates[FCurrentList], sttStencilBuffer)
2990
  else
2991
    case face of
2992
      cmFront:
2993
        begin
2994
          FStencilFail := sfail;
2995
          FStencilPassDepthFail := dpfail;
2996
          FStencilPassDepthPass := dppass;
2997
        end;
2998
      cmBack:
2999
        begin
3000
          FStencilBackFail := sfail;
3001
          FStencilBackPassDepthFail := dpfail;
3002
          FStencilBackPassDepthPass := dppass;
3003
        end;
3004
      cmFrontAndBack:
3005
        begin
3006
          FStencilFail := sfail;
3007
          FStencilPassDepthFail := dpfail;
3008
          FStencilPassDepthPass := dppass;
3009
          FStencilBackFail := sfail;
3010
          FStencilBackPassDepthFail := dpfail;
3011
          FStencilBackPassDepthPass := dppass;
3012
        end;
3013
    end;
3014

3015
  GL.StencilOpSeparate(cGLCullFaceModeToGLEnum[face],
3016
    cGLStencilOpToGLEnum[sfail],
3017
    cGLStencilOpToGLEnum[dpfail],
3018
    cGLStencilOpToGLEnum[dppass]);
3019
end;
3020

3021
procedure TGLStateCache.SetStencilWriteMask(const Value: TGLuint);
3022
{$IFDEF GLS_CACHE_MISS_CHECK}
3023
var I: TGLuint;
3024
{$ENDIF}
3025
begin
3026
{$IFDEF GLS_CACHE_MISS_CHECK}
3027
  GL.GetIntegerv(GL_STENCIL_WRITEMASK, @I);
3028
  if FStencilWriteMask <> I then
3029
    GLSLogger.LogError(glsStateCashMissing + 'Stencil write mask');
3030
{$ENDIF}
3031
  if (Value <> FStencilWriteMask) or FInsideList then
3032
  begin
3033
    if FInsideList then
3034
      Include(FListStates[FCurrentList], sttStencilBuffer)
3035
    else
3036
      FStencilWriteMask := Value;
3037
    GL.StencilMaskSeparate(GL_FRONT, Value);
3038
  end;
3039
end;
3040

3041
procedure TGLStateCache.SetTextureBinding(Index: Integer; target:
3042
  TGLTextureTarget;
3043
  const Value: TGLuint);
3044
var
3045
  lastActiveTexture: TGLuint;
3046
begin
3047
  if target = ttNoShape then
3048
    exit;
3049
  if (Value <> FTextureBinding[Index, target]) or FInsideList then
3050
  begin
3051
    if FInsideList then
3052
      Include(FListStates[FCurrentList], sttTexture)
3053
    else
3054
      FTextureBinding[Index, target] := Value;
3055
    lastActiveTexture := ActiveTexture;
3056
    ActiveTexture := Index;
3057
    GL.BindTexture(cGLTexTypeToGLEnum[target], Value);
3058
    ActiveTexture := lastActiveTexture;
3059
  end;
3060
  FTextureBindingTime[Index, target] := GLSTime;
3061
end;
3062

3063
function TGLStateCache.GetActiveTextureEnabled(Target: TGLTextureTarget):
3064
  Boolean;
3065
begin
3066
  Result := FActiveTextureEnabling[FActiveTexture][Target];
3067
end;
3068

3069
procedure TGLStateCache.SetActiveTextureEnabled(Target: TGLTextureTarget;
3070
  const Value: Boolean);
3071
var
3072
  glTarget: TGLEnum;
3073
begin
3074
  glTarget := DecodeGLTextureTarget(Target);
3075
  if FForwardContext or not IsTargetSupported(glTarget) then
3076
    exit;
3077
  if (Value <> FActiveTextureEnabling[FActiveTexture][Target])
3078
    or FInsideList then
3079
  begin
3080
    if FInsideList then
3081
      Include(FListStates[FCurrentList], sttEnable)
3082
    else
3083
      FActiveTextureEnabling[FActiveTexture][Target] := Value;
3084
    if Value then
3085
      GL.Enable(glTarget)
3086
    else
3087
      GL.Disable(glTarget);
3088
  end;
3089
end;
3090

3091
procedure TGLStateCache.SetTextureCompressionHint(const Value: THintType);
3092
begin
3093
  if (Value <> FTextureCompressionHint) or FInsideList then
3094
  begin
3095
    if FInsideList then
3096
      Include(FListStates[FCurrentList], sttHint)
3097
    else
3098
      FTextureCompressionHint := Value;
3099
    GL.Hint(GL_TEXTURE_COMPRESSION_HINT, cGLHintToGLEnum[Value]);
3100
  end;
3101
end;
3102

3103
procedure TGLStateCache.SetTransformFeedbackBufferBinding(const Value: TGLuint);
3104
begin
3105
  if (Value <> FTransformFeedbackBufferBinding) or FInsideList then
3106
  begin
3107
    FTransformFeedbackBufferBinding := Value;
3108
    GL.BindBuffer(GL_TRANSFORM_FEEDBACK_BUFFER, Value);
3109
  end;
3110
end;
3111

3112
procedure TGLStateCache.SetEnableTextureCubeMapSeamless(const Value:
3113
  TGLboolean);
3114
begin
3115
  if Value <> FEnableTextureCubeMapSeamless then
3116
  begin
3117
    FEnableTextureCubeMapSeamless := Value;
3118
    if Value = true then
3119
      GL.Enable(GL_TEXTURE_CUBE_MAP_SEAMLESS)
3120
    else
3121
      GL.Disable(GL_TEXTURE_CUBE_MAP_SEAMLESS);
3122
  end;
3123
end;
3124

3125
procedure TGLStateCache.NewList(list: TGLuint; mode: TGLEnum);
3126
var
3127
  I: TGLuint;
3128
begin
3129
  Assert(mode = GL_COMPILE,
3130
    'Compile & executing not supported by TGLStateCache');
3131
  FCurrentList := list - 1;
3132
  while High(FListStates) < Integer(FCurrentList) do
3133
    SetLength(FListStates, 2 * Length(FListStates));
3134

3135
  FListStates[FCurrentList] := [];
3136
  FInsideList := True;
3137
  // Reset VBO binding and client attribute
3138
  with GL do
3139
  begin
3140
    if ARB_vertex_buffer_object then
3141
    begin
3142
      ArrayBufferBinding := 0;
3143
      ElementBufferBinding := 0;
3144
      for I := 0 to 15 do
3145
        DisableVertexAttribArray(I);
3146
    end;
3147
    NewList(list, mode);
3148
  end;
3149
end;
3150

3151
procedure TGLStateCache.EndList;
3152
begin
3153
  GL.EndList;
3154
  FInsideList := False;
3155
end;
3156

3157
procedure TGLStateCache.CallList(list: TGLuint);
3158
begin
3159
  while High(FListStates) < Integer(list) do
3160
    SetLength(FListStates, 2 * Length(FListStates));
3161

3162
  if FListStates[list - 1] <> [] then
3163
  begin
3164
    PushAttrib(FListStates[list - 1]);
3165
    GL.CallList(list);
3166
    PopAttrib;
3167
  end
3168
  else
3169
    GL.CallList(list);
3170
end;
3171

3172
procedure TGLStateCache.SetUniformBufferBinding(const Value: TGLuint);
3173
begin
3174
  Assert(not FInsideList);
3175
  if Value <> FUniformBufferBinding then
3176
  begin
3177
    FUniformBufferBinding := Value;
3178
    GL.BindBuffer(GL_UNIFORM_BUFFER, Value);
3179
  end;
3180
end;
3181

3182
procedure TGLStateCache.SetBufferIndexedBinding(const Value: TGLuint;
3183
  ATarget: TGLBufferBindingTarget; AIndex: TGLuint; ABufferSize: TGLsizeiptr);
3184
begin
3185
  Assert(not FInsideList);
3186
  if (FUBOStates[ATarget, AIndex].FUniformBufferBinding <> Value)
3187
    or (FUBOStates[ATarget, AIndex].FOffset > 0)
3188
    or (FUBOStates[ATarget, AIndex].FSize <> ABufferSize) then
3189
  begin
3190
    case ATarget of
3191
      bbtUniform: FUniformBufferBinding := Value;
3192
      bbtTransformFeedBack: FTransformFeedbackBufferBinding := Value;
3193
    end;
3194
    FUBOStates[ATarget, AIndex].FUniformBufferBinding := Value;
3195
    FUBOStates[ATarget, AIndex].FOffset := 0;
3196
    FUBOStates[ATarget, AIndex].FSize := ABufferSize;
3197
    GL.BindBufferBase(cGLBufferBindingTarget[ATarget], AIndex, Value);
3198
  end
3199
  else
3200
    case ATarget of
3201
      bbtUniform: SetUniformBufferBinding(Value);
3202
      bbtTransformFeedBack: SetTransformFeedbackBufferBinding(Value);
3203
    end;
3204
end;
3205

3206
procedure TGLStateCache.SetBufferIndexedBinding(const Value: TGLuint;
3207
  ATarget: TGLBufferBindingTarget; AIndex: TGLuint;
3208
    AOffset: TGLintptr; ARangeSize: TGLsizeiptr);
3209
begin
3210
  Assert(not FInsideList);
3211
  if (FUBOStates[ATarget, AIndex].FUniformBufferBinding <> Value)
3212
    or (FUBOStates[ATarget, AIndex].FOffset <> AOffset)
3213
    or (FUBOStates[ATarget, AIndex].FSize <> ARangeSize) then
3214
  begin
3215
    case ATarget of
3216
      bbtUniform: FUniformBufferBinding := Value;
3217
      bbtTransformFeedBack: FTransformFeedbackBufferBinding := Value;
3218
    end;
3219
    FUBOStates[ATarget, AIndex].FUniformBufferBinding := Value;
3220
    FUBOStates[ATarget, AIndex].FOffset := AOffset;
3221
    FUBOStates[ATarget, AIndex].FSize := ARangeSize;
3222
    GL.BindBufferRange(cGLBufferBindingTarget[ATarget], AIndex, Value, AOffset, ARangeSize);
3223
  end;
3224
end;
3225

3226
function TGLStateCache.GetMaxTextureUnits: TGLuint;
3227
begin
3228
  if FMaxTextureUnits = 0 then
3229
    GL.GetIntegerv(GL_MAX_TEXTURE_IMAGE_UNITS_ARB, @FMaxTextureUnits);
3230
  Result := FMaxTextureUnits;
3231
end;
3232

3233
procedure TGLStateCache.SetUnpackAlignment(const Value: TGLuint);
3234
begin
3235
  if Value <> FUnpackAlignment then
3236
  begin
3237
    FUnpackAlignment := Value;
3238
    GL.PixelStoref(GL_UNPACK_ALIGNMENT, Value);
3239
  end;
3240
end;
3241

3242
procedure TGLStateCache.SetUnpackImageHeight(const Value: TGLuint);
3243
begin
3244
  if Value <> FUnpackImageHeight then
3245
  begin
3246
    FUnpackImageHeight := Value;
3247
    GL.PixelStoref(GL_UNPACK_IMAGE_HEIGHT, Value);
3248
  end;
3249
end;
3250

3251
procedure TGLStateCache.SetUnpackLSBFirst(const Value: TGLboolean);
3252
begin
3253
  if Value <> FUnpackLSBFirst then
3254
  begin
3255
    FUnpackLSBFirst := Value;
3256
    GL.PixelStorei(GL_UNPACK_LSB_FIRST, byte(Value));
3257
  end;
3258
end;
3259

3260
procedure TGLStateCache.SetUnpackRowLength(const Value: TGLuint);
3261
begin
3262
  if Value <> FUnpackRowLength then
3263
  begin
3264
    FUnpackRowLength := Value;
3265
    GL.PixelStoref(GL_UNPACK_ROW_LENGTH, Value);
3266
  end;
3267
end;
3268

3269
procedure TGLStateCache.SetUnpackSkipImages(const Value: TGLuint);
3270
begin
3271
  if Value <> FUnpackSkipImages then
3272
  begin
3273
    FUnpackSkipImages := Value;
3274
    GL.PixelStoref(GL_UNPACK_SKIP_IMAGES, Value);
3275
  end;
3276
end;
3277

3278
procedure TGLStateCache.SetUnpackSkipPixels(const Value: TGLuint);
3279
begin
3280
  if Value <> FUnpackSkipPixels then
3281
  begin
3282
    FUnpackSkipPixels := Value;
3283
    GL.PixelStoref(GL_UNPACK_SKIP_PIXELS, Value);
3284
  end;
3285
end;
3286

3287
procedure TGLStateCache.SetUnpackSkipRows(const Value: TGLuint);
3288
begin
3289
  if Value <> FUnpackSkipRows then
3290
  begin
3291
    FUnpackSkipRows := Value;
3292
    GL.PixelStoref(GL_UNPACK_SKIP_ROWS, Value);
3293
  end;
3294
end;
3295

3296
procedure TGLStateCache.SetUnpackSwapBytes(const Value: TGLboolean);
3297
begin
3298
  if Value <> FUnpackSwapBytes then
3299
  begin
3300
    FUnpackSwapBytes := Value;
3301
    GL.PixelStorei(GL_UNPACK_SWAP_BYTES, byte(Value));
3302
  end;
3303
end;
3304

3305
procedure TGLStateCache.SetViewPort(const Value: TVector4i);
3306
begin
3307
  if not VectorEquals(Value, FViewPort) or FInsideList then
3308
  begin
3309
    if FInsideList then
3310
      Include(FListStates[FCurrentList], sttViewport)
3311
    else
3312
      FViewPort := Value;
3313
    GL.Viewport(Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
3314
  end;
3315
end;
3316

3317
procedure TGLStateCache.SetFFPLight(Value: Boolean);
3318
begin
3319
  FFFPLight := Value and not FForwardContext;
3320
end;
3321

3322
function TGLStateCache.GetMaxLights: Integer;
3323
begin
3324
  if FMaxLights = 0 then
3325
  if FForwardContext then
3326
    FMaxLights := MAX_HARDWARE_LIGHT
3327
  else
3328
    GL.GetIntegerv(GL_MAX_LIGHTS, @FMaxLights);
3329
  Result := FMaxLights;
3330
end;
3331

3332
function TGLStateCache.GetLightEnabling(I: Integer): Boolean;
3333
begin
3334
  Result := FLightEnabling[I];
3335
end;
3336

3337
procedure TGLStateCache.SetLightEnabling(I: Integer; Value: Boolean);
3338
var
3339
  J, K: Integer;
3340
begin
3341
  if (FLightEnabling[I] <> Value) or FInsideList then
3342
  begin
3343
    if FInsideList then
3344
      Include(FListStates[FCurrentList], sttLighting)
3345
    else
3346
      FLightEnabling[I] := Value;
3347

3348
    if FFFPLight then
3349
    begin
3350
      if Value then
3351
        GL.Enable(GL_LIGHT0 + I)
3352
      else
3353
        GL.Disable(GL_LIGHT0 + I);
3354
    end;
3355

3356
    K := 0;
3357
    for J := 0 to MAX_HARDWARE_LIGHT - 1 do
3358
    if FLightEnabling[J] then
3359
    begin
3360
      FLightIndices[K] := J;
3361
      Inc(K);
3362
    end;
3363
    FLightNumber := K;
3364

3365
    FShaderLightStatesChanged := True;
3366
    if Assigned(FOnLightsChanged) then
3367
      FOnLightsChanged(Self);
3368
  end;
3369
end;
3370

3371
function TGLStateCache.GetLightIndicesAsAddress: PGLInt;
3372
begin
3373
  Result := @FLightIndices[0];
3374
end;
3375

3376
function TGLStateCache.GetLightStateAsAddress: Pointer;
3377
var
3378
  I, J, C: Integer;
3379
begin
3380
  C := MinInteger(FLightNumber, MAX_SHADER_LIGHT);
3381
  if FShaderLightStatesChanged then
3382
  begin
3383
    if C > 0 then
3384
    begin
3385
      if GL.VERSION_3_0 then
3386
      begin
3387
        Move(FLightStates.Position,
3388
          FShaderLightStates.Position,
3389
          SizeOf(FShaderLightStates.Position));
3390
        Move(FLightStates.Ambient,
3391
         FShaderLightStates.Ambient,
3392
         SizeOf(FShaderLightStates.Ambient));
3393
        Move(FLightStates.Diffuse,
3394
          FShaderLightStates.Diffuse,
3395
          SizeOf(FShaderLightStates.Diffuse));
3396
        Move(FLightStates.Specular,
3397
          FShaderLightStates.Specular,
3398
          SizeOf(FShaderLightStates.Specular));
3399
        Move(FLightStates.SpotDirection,
3400
          FShaderLightStates.SpotDirection,
3401
          SizeOf(FShaderLightStates.SpotDirection));
3402
        Move(FLightStates.SpotCosCutoffExponent,
3403
          FShaderLightStates.SpotCosCutoffExponent,
3404
          SizeOf(FShaderLightStates.SpotCosCutoffExponent));
3405
        Move(FLightStates.Attenuation,
3406
          FShaderLightStates.Attenuation,
3407
          SizeOf(FShaderLightStates.Attenuation));
3408
      end
3409
      else
3410
      begin
3411
        for I := C - 1 downto 0 do
3412
        begin
3413
          J := FLightIndices[I];
3414
          FShaderLightStates.Position[I] := FLightStates.Position[J];
3415
          FShaderLightStates.Ambient[I] := FLightStates.Ambient[J];
3416
          FShaderLightStates.Diffuse[I] := FLightStates.Diffuse[J];
3417
          FShaderLightStates.Specular[I] := FLightStates.Specular[J];
3418
          FShaderLightStates.SpotDirection[I] := FLightStates.SpotDirection[J];
3419
          FShaderLightStates.SpotCosCutoffExponent[I] := FLightStates.SpotCosCutoffExponent[J];
3420
          FShaderLightStates.Attenuation[I] := FLightStates.Attenuation[J];
3421
        end;
3422
      end;
3423
    end
3424
    else
3425
      FillChar(FShaderLightStatesChanged, SizeOf(FShaderLightStatesChanged), $00);
3426
    FShaderLightStatesChanged := False;
3427
  end;
3428

3429
  Result := @FShaderLightStates;
3430
end;
3431

3432
function TGLStateCache.GetLightPosition(I: Integer): TVector;
3433
begin
3434
  Result := FLightStates.Position[I];
3435
end;
3436

3437
procedure TGLStateCache.SetLightPosition(I: Integer; const Value: TVector);
3438
begin
3439
  if not VectorEquals(Value, FLightStates.Position[I]) then
3440
  begin
3441
    FLightStates.Position[I] := Value;
3442
    FShaderLightStatesChanged := True;
3443
    if Assigned(FOnLightsChanged) then
3444
      FOnLightsChanged(Self);
3445
  end;
3446
end;
3447

3448
function TGLStateCache.GetLightSpotDirection(I: Integer): TAffineVector;
3449
begin
3450
  Result := AffineVectorMake(FLightStates.SpotDirection[I]);
3451
end;
3452

3453
procedure TGLStateCache.SetLightSpotDirection(I: Integer; const Value: TAffineVector);
3454
begin
3455
  if not VectorEquals(Value, AffineVectorMake(FLightStates.SpotDirection[I])) then
3456
  begin
3457
    FLightStates.SpotDirection[I] := VectorMake(Value);
3458
    FShaderLightStatesChanged := True;
3459
    if Assigned(FOnLightsChanged) then
3460
      FOnLightsChanged(Self);
3461
  end;
3462
end;
3463

3464
function TGLStateCache.GetLightAmbient(I: Integer): TVector;
3465
begin
3466
  Result := FLightStates.Ambient[I];
3467
end;
3468

3469
procedure TGLStateCache.SetLightAmbient(I: Integer; const Value: TVector);
3470
begin
3471
  if not VectorEquals(Value, FLightStates.Ambient[I]) or FInsideList then
3472
  begin
3473
    if FInsideList then
3474
      Include(FListStates[FCurrentList], sttLighting)
3475
    else
3476
      FLightStates.Ambient[I] := Value;
3477

3478
    if FFFPLight then
3479
      GL.Lightfv(GL_LIGHT0 + I, GL_AMBIENT, @Value);
3480

3481
    FShaderLightStatesChanged := True;
3482
    if Assigned(FOnLightsChanged) then
3483
      FOnLightsChanged(Self);
3484
  end;
3485
end;
3486

3487
function TGLStateCache.GetLightDiffuse(I: Integer): TVector;
3488
begin
3489
  Result := FLightStates.Diffuse[I];
3490
end;
3491

3492
procedure TGLStateCache.SetLightDiffuse(I: Integer; const Value: TVector);
3493
begin
3494
  if not VectorEquals(Value, FLightStates.Diffuse[I]) or FInsideList then
3495
  begin
3496
    if FInsideList then
3497
      Include(FListStates[FCurrentList], sttLighting)
3498
    else
3499
      FLightStates.Diffuse[I] := Value;
3500

3501
    if FFFPLight then
3502
      GL.Lightfv(GL_LIGHT0 + I, GL_DIFFUSE, @Value);
3503

3504
    FShaderLightStatesChanged := True;
3505
    if Assigned(FOnLightsChanged) then
3506
      FOnLightsChanged(Self);
3507
  end;
3508
end;
3509

3510
function TGLStateCache.GetLightSpecular(I: Integer): TVector;
3511
begin
3512
  Result := FLightStates.Specular[I];
3513
end;
3514

3515
procedure TGLStateCache.SetLightSpecular(I: Integer; const Value: TVector);
3516
begin
3517
  if not VectorEquals(Value, FLightStates.Specular[I]) or FInsideList then
3518
  begin
3519
    if FInsideList then
3520
      Include(FListStates[FCurrentList], sttLighting)
3521
    else
3522
      FLightStates.Specular[I] := Value;
3523

3524
    if FFFPLight then
3525
      GL.Lightfv(GL_LIGHT0 + I, GL_SPECULAR, @Value);
3526

3527
    FShaderLightStatesChanged := True;
3528
    if Assigned(FOnLightsChanged) then
3529
      FOnLightsChanged(Self);
3530
  end;
3531
end;
3532

3533
function TGLStateCache.GetSpotCutoff(I: Integer): Single;
3534
begin
3535
  Result := FSpotCutoff[I];
3536
end;
3537

3538
procedure TGLStateCache.SetSpotCutoff(I: Integer; const Value: Single);
3539
begin
3540
  if (Value <> FSpotCutoff[I]) or FInsideList then
3541
  begin
3542
    if FInsideList then
3543
      Include(FListStates[FCurrentList], sttLighting)
3544
    else
3545
    begin
3546
      FSpotCutoff[I] := Value;
3547
      FLightStates.SpotCosCutoffExponent[I].V[0] := cos(GLVectorGeometry.DegToRad(Value));
3548
    end;
3549
	
3550
    if FFFPLight then
3551
      GL.Lightfv(GL_LIGHT0 + I, GL_SPOT_CUTOFF, @Value);
3552
                  
3553
    FShaderLightStatesChanged := True;
3554
    if Assigned(FOnLightsChanged) then
3555
      FOnLightsChanged(Self);
3556
  end;
3557
end;
3558

3559
function TGLStateCache.GetSpotExponent(I: Integer): Single;
3560
begin
3561
  Result := FLightStates.SpotCosCutoffExponent[I].V[1];
3562
end;
3563

3564
procedure TGLStateCache.SetSpotExponent(I: Integer; const Value: Single);
3565
begin
3566
  if (Value <> FLightStates.SpotCosCutoffExponent[I].V[1] )
3567
    or FInsideList then
3568
  begin
3569
    if FInsideList then
3570
      Include(FListStates[FCurrentList], sttLighting)
3571
    else
3572
      FLightStates.SpotCosCutoffExponent[I].V[1]  := Value;
3573

3574
    if FFFPLight then
3575
      GL.Lightfv(GL_LIGHT0 + I, GL_SPOT_EXPONENT, @Value);
3576

3577
    FShaderLightStatesChanged := True;
3578
    if Assigned(FOnLightsChanged) then
3579
      FOnLightsChanged(Self);
3580
  end;
3581
end;
3582

3583
function TGLStateCache.GetConstantAtten(I: Integer): Single;
3584
begin
3585
  Result := FLightStates.Attenuation[I].V[0] ;
3586
end;
3587

3588
procedure TGLStateCache.SetConstantAtten(I: Integer; const Value: Single);
3589
begin
3590
  if (Value <> FLightStates.Attenuation[I].V[0] ) or FInsideList then
3591
  begin
3592
    if FInsideList then
3593
      Include(FListStates[FCurrentList], sttLighting)
3594
    else
3595
      FLightStates.Attenuation[I].V[0]  := Value;
3596

3597
    if FFFPLight then
3598
      GL.Lightfv(GL_LIGHT0 + I, GL_CONSTANT_ATTENUATION, @Value);
3599

3600
    FShaderLightStatesChanged := True;
3601
    if Assigned(FOnLightsChanged) then
3602
      FOnLightsChanged(Self);
3603
  end;
3604
end;
3605

3606
function TGLStateCache.GetLinearAtten(I: Integer): Single;
3607
begin
3608
  Result := FLightStates.Attenuation[I].V[1] ;
3609
end;
3610

3611
procedure TGLStateCache.SetLinearAtten(I: Integer; const Value: Single);
3612
begin
3613
  if (Value <> FLightStates.Attenuation[I].V[1] ) or FInsideList then
3614
  begin
3615
    if FInsideList then
3616
      Include(FListStates[FCurrentList], sttLighting)
3617
    else
3618
      FLightStates.Attenuation[I].V[1]  := Value;
3619

3620
    if FFFPLight then
3621
      GL.Lightfv(GL_LIGHT0 + I, GL_LINEAR_ATTENUATION, @Value);
3622

3623
    FShaderLightStatesChanged := True;
3624
    if Assigned(FOnLightsChanged) then
3625
      FOnLightsChanged(Self);
3626
  end;
3627
end;
3628

3629
function TGLStateCache.GetQuadAtten(I: Integer): Single;
3630
begin
3631
  Result := FLightStates.Attenuation[I].V[2] ;
3632
end;
3633

3634
procedure TGLStateCache.SetQuadAtten(I: Integer; const Value: Single);
3635
begin
3636
  if (Value <> FLightStates.Attenuation[I].V[2] ) or FInsideList then
3637
  begin
3638
    if FInsideList then
3639
      Include(FListStates[FCurrentList], sttLighting)
3640
    else
3641
      FLightStates.Attenuation[I].V[2]  := Value;
3642

3643
    if FFFPLight then
3644
      GL.Lightfv(GL_LIGHT0 + I, GL_QUADRATIC_ATTENUATION, @Value);
3645

3646
    FShaderLightStatesChanged := True;
3647
    if Assigned(FOnLightsChanged) then
3648
      FOnLightsChanged(Self);
3649
  end;
3650
end;
3651

3652
procedure TGLStateCache.SetForwardContext(Value: Boolean);
3653
begin
3654
  if Value <> FForwardContext then
3655
  begin
3656
    FForwardContext := Value;
3657
    if Value then
3658
    begin
3659
      SetFFPlight(False);
3660
    end;
3661
  end;
3662
end;
3663

3664

3665
// SetGLColorIgnoring
3666
//
3667

3668
procedure TGLStateCache.SetGLColorWriting(flag: Boolean);
3669
begin
3670
  if (FColorWriting <> flag) or FInsideList then
3671
  begin
3672
    if FInsideList then
3673
      Include(FListStates[FCurrentList], sttColorBuffer)
3674
    else
3675
      FColorWriting := flag;
3676
    GL.ColorMask(flag, flag, flag, flag);
3677
  end;
3678
end;
3679

3680
// InvertGLFrontFace
3681
//
3682

3683
procedure TGLStateCache.InvertGLFrontFace;
3684
begin
3685
  if FFrontFace = fwCounterClockWise then
3686
    FrontFace := fwClockWise
3687
  else
3688
    FrontFace := fwCounterClockWise;
3689
end;
3690

3691
// SetGLState
3692
//
3693
procedure TGLStateCache.SetGLState(const aState : TGLState);
3694
begin
3695
	Enable(aState);
3696
end;
3697

3698
// UnSetGLState
3699
//
3700
procedure TGLStateCache.UnSetGLState(const aState : TGLState);
3701
begin
3702
	Disable(aState);
3703
end;
3704

3705
// ResetGLPolygonMode
3706
//
3707

3708
procedure TGLStateCache.ResetGLPolygonMode;
3709
begin
3710
  GL.PolygonMode(GL_FRONT_AND_BACK, GL_FILL);
3711
  FPolygonMode := pmFill;
3712
  FPolygonBackMode := pmFill;
3713
end;
3714

3715
// ResetGLMaterialColors
3716
//
3717

3718
procedure TGLStateCache.ResetGLMaterialColors;
3719
begin
3720
  GL.Materialfv(GL_FRONT_AND_BACK, GL_AMBIENT, @clrGray20);
3721
  GL.Materialfv(GL_FRONT_AND_BACK, GL_DIFFUSE, @clrGray80);
3722
  GL.Materialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @clrBlack);
3723
  GL.Materialfv(GL_FRONT_AND_BACK, GL_EMISSION, @clrBlack);
3724
  GL.Materiali(GL_FRONT_AND_BACK, GL_SHININESS, 0);
3725
  FillChar(FFrontBackColors, SizeOf(FFrontBackColors), 127);
3726
  FFrontBackShininess[0] := 0;
3727
  FFrontBackShininess[1] := 0;
3728
end;
3729

3730
// ResetGLTexture
3731
//
3732

3733
procedure TGLStateCache.ResetGLTexture(const TextureUnit: Integer);
3734
var
3735
  t: TGLTextureTarget;
3736
  glTarget: TGLEnum;
3737
begin
3738
  GL.ActiveTexture(GL_TEXTURE0 + TextureUnit);
3739
  for t := Low(TGLTextureTarget) to High(TGLTextureTarget) do
3740
  begin
3741
    glTarget := DecodeGLTextureTarget(t);
3742
    if IsTargetSupported(glTarget) then
3743
    begin
3744
      GL.BindTexture(glTarget, 0);
3745
      FTextureBinding[TextureUnit, t] := 0;
3746
    end;
3747
  end;
3748
  GL.ActiveTexture(GL_TEXTURE0);
3749
  FActiveTexture := 0;
3750
end;
3751

3752
// ResetGLCurrentTexture
3753
//
3754

3755
procedure TGLStateCache.ResetGLCurrentTexture;
3756
var
3757
  a: TGLint;
3758
  t: TGLTextureTarget;
3759
  glTarget: TGLEnum;
3760
begin
3761
  if GL.ARB_multitexture then
3762
  begin
3763
    for a := MaxTextureImageUnits - 1 to 0 do
3764
    begin
3765
      GL.ActiveTexture(GL_TEXTURE0 + a);
3766
      for t := Low(TGLTextureTarget) to High(TGLTextureTarget) do
3767
      begin
3768
        glTarget := DecodeGLTextureTarget(t);
3769
        if IsTargetSupported(glTarget) then
3770
        begin
3771
          GL.BindTexture(glTarget, 0);
3772
          FTextureBinding[a, t] := 0;
3773
        end;
3774
      end;
3775
    end;
3776
  end
3777
  else
3778
    for t := Low(TGLTextureTarget) to High(TGLTextureTarget) do
3779
    begin
3780
      glTarget := DecodeGLTextureTarget(t);
3781
      if IsTargetSupported(glTarget) then
3782
      begin
3783
        GL.BindTexture(glTarget, 0);
3784
        FTextureBinding[0, t] := 0;
3785
      end;
3786
    end;
3787
end;
3788

3789
// ResetGLFrontFace
3790
//
3791

3792
procedure TGLStateCache.ResetGLFrontFace;
3793
begin
3794
  GL.FrontFace(GL_CCW);
3795
  FFrontFace := fwCounterClockWise;
3796
end;
3797

3798

3799
procedure TGLStateCache.SetGLFrontFaceCW;
3800
begin
3801
  if FFrontFace = fwCounterClockWise then
3802
  begin
3803
    GL.FrontFace(GL_CW);
3804
    FFrontFace := fwClockWise;
3805
  end;
3806
end;
3807

3808
// ResetAll
3809
//
3810

3811
procedure TGLStateCache.ResetAll;
3812
begin
3813
 {$WARN SYMBOL_DEPRECATED OFF}
3814
  ResetGLPolygonMode;
3815
  ResetGLMaterialColors;
3816
  ResetGLCurrentTexture;
3817
  ResetGLFrontFace;
3818
 {$WARN SYMBOL_DEPRECATED ON}
3819
end;
3820

3821
end.
3822

3823

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.