LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
    TGLSLShader is a wrapper for GLS shaders.
6

7
	 History :  
8
       09/02/13 - Yar - Added OnApplyEx, OnInitializeEx events where is TGLLibMaterial as Sender (thanks to Dmitriy Buharin)
9
       10/11/12 - PW - Added CPP compatibility: changed vector arrays to records
10
       18/02/11 - Yar - Fixed transform feedback varyings activation
11
       23/08/10 - Yar - Replaced OpenGL1x to OpenGLTokens
12
       02/06/10 - Yar - Replace OpenGL functions to OpenGLAdapter
13
                           Added unsigned integer uniforms
14
       22/04/10 - Yar - Fixes after GLState revision
15
       02/04/10 - Yar -  Added GetActiveAttribs to TGLCustomGLSLShader
16
       04/11/09 - DaStr - Added default value to TGLCustomGLSLShader.TransformFeedBackMode
17
       26/10/09 - DaStr - Updated GeometryShader support (thanks YarUnderoaker)
18
       24/08/09 - DaStr - Added GeometryShader support (thanks YarUnderoaker)
19
       24/07/09 - DaStr - Added support for TGLCustomShader.DebugMode
20
                             Fixed spelling mistake in TGLShaderUnAplyEvent
21
                             TGLShader.DoInitialize() now passes rci
22
                              (BugTracker ID = 2826217)
23
                             Bugfixed TGLCustomGLSLShader.DoInitialize() - now
24
                              shader cleanes up correctly if failed to initialize
25
       15/03/08 - DaStr - Fixups for vIgnoreContextActivationFailures mode
26
                                                      (BugTracker ID = 1914782)
27
       25/12/07 - DaStr - Fix-up for previous update (BugtrackerID = 1772477)
28
       12/08/07 - LC -    TGLSLShaderParameter.SetAsCustomTexture now restores
29
                              the active texture unit (BugtrackerID = 1772477)
30
       12/07/07 - DaStr - TGLSLInitializedShaderParameters removed because
31
                              even if implemented, it could not give
32
                              a significant performance increase
33
       30/03/07 - fig -   Changed OnInitialize event to be fired after
34
                              linking, but before validation. This can now be
35
                              used to set texture units for different sampler
36
                              types (1D/2D/3D) before validation, which fixes
37
                              a bug (or complies to strict validation) with ATI
38
                              drivers
39
       30/03/07 - DaStr - Bugfixed TGLCustomGLSLShader.DoUnApply
40
                              (Result was not initialized)
41
       20/03/07 - DaStr - TGLCustomGLSLShader now generates its own events
42
                             Added TGLSLShaderParameter
43
                             Added TGLCustomGLSLShader.DoInitialPass
44
                             Added TGLCustomGLSLShader.Param[]
45
       21/02/07 - DaStr - Initial version (contributed to GLScene)
46

47

48

49
    Previous version history:
50
      v1.0    11 March     '2006  Creation
51
      v1.1    06 August    '2006  TGLCustomGLSLShader.DoInitialize bugfixed
52
      v1.1.2  24 August    '2006  TGLCustomShader.SetParameterTexture[1-3]D added
53
      v1.1.4  09 September '2006  Fixed a memory leak which occured when
54
                                   enabling / disabling the shader several times
55
      v1.1.6  22 September '2006  DoUnApply fixed (suggested by Nelsol Chu)
56
      v1.2    04 November  '2006  function GetGLSLProg added (just in case)
57
                                  TGLSLShader has more published properties
58
                                  Bugfix in DoInitialize (when no shader is active)
59
                                  (Get/Set)ParameterTexture[1/2/3]DHandle added
60
                                  (Get/Set)ParameterCustomTextureHandle support added
61
      v1.2.4  22 November  '2006  TGLProgramHandle.Name is now used
62
                                  Assign() bugfixed
63
                                  Fixed a possible bug in DoInitialize
64
                                    (Handle was freed, but not nil'ed)
65

66
}
67
unit GLSLShader;
68

69
interface
70

71
{$I GLScene.inc}
72

73
uses
74
  Classes, SysUtils,
75

76
  GLVectorGeometry, GLVectorTypes, GLTexture, OpenGLTokens, GLContext, GLCustomShader,
77
  GLRenderContextInfo, GLTextureFormat, GLSLParameter;
78

79
type
80
  TGLSLShaderParameter = class;
81
  TGLCustomGLSLShader = class;
82
  EGLSLShaderException = class(EGLCustomShaderException);
83

84
  TGLSLShaderEvent = procedure(Shader: TGLCustomGLSLShader) of object;
85
  TGLSLShaderUnApplyEvent = procedure(Shader: TGLCustomGLSLShader;
86
                                     var ThereAreMorePasses: Boolean) of object;
87
  TGLSLShaderEventEx = procedure(Shader: TGLCustomGLSLShader;
88
    Sender: TObject) of object;
89

90
  TGLActiveAttrib = record
91
    Name: string;
92
    Size: GLInt;
93
    AType: TGLSLDataType;
94
    Location: Integer;
95
  end;
96

97
  TGLActiveAttribArray = array of TGLActiveAttrib;
98

99
  TGLCustomGLSLShader = class(TGLCustomShader)
100
  private
101
    FGLSLProg: TGLProgramHandle;
102
    FParam: TGLSLShaderParameter;
103
    FActiveVarying: TStrings;
104
    FTransformFeedBackMode: TGLTransformFeedBackMode;
105

106
    FOnInitialize: TGLSLShaderEvent;
107
    FOnApply: TGLSLShaderEvent;
108
    FOnUnApply: TGLSLShaderUnApplyEvent;
109
    FOnInitializeEx: TGLSLShaderEventEx;
110
    FOnApplyEx: TGLSLShaderEventEx;
111

112
    function GetParam(const Index: string): TGLSLShaderParameter;
113
    function GetDirectParam(const Index: Cardinal): TGLSLShaderParameter;
114
    procedure OnChangeActiveVarying(Sender: TObject);
115
  protected
116
    property OnApply: TGLSLShaderEvent read FOnApply write FOnApply;
117
    property OnUnApply: TGLSLShaderUnApplyEvent read FOnUnApply write FOnUnApply;
118
    property OnInitialize: TGLSLShaderEvent read FOnInitialize write FOnInitialize;
119
    property OnInitializeEx: TGLSLShaderEventEx read FOnInitializeEx write FOnInitializeEx;
120
    property OnApplyEx: TGLSLShaderEventEx read FOnApplyEx write FOnApplyEx;
121

122
    function GetGLSLProg: TGLProgramHandle; virtual;
123
    function GetCurrentParam: TGLSLShaderParameter; virtual;
124
    procedure SetActiveVarying(const Value: TStrings);
125
    procedure SetTransformFeedBackMode(const Value: TGLTransformFeedBackMode);
126
    procedure DoInitialize(var rci: TGLRenderContextInfo; Sender: TObject); override;
127
    procedure DoFinalize; override;
128
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
129
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
130
  public
131
    constructor Create(AOwner: TComponent); override;
132
    destructor Destroy; override;
133
    procedure Assign(Source: TPersistent); override;
134
    function ShaderSupported: Boolean; override;
135
    function GetActiveAttribs: TGLActiveAttribArray;
136

137
    property Param[const Index: string]: TGLSLShaderParameter read GetParam;
138
    property DirectParam[const Index: Cardinal]: TGLSLShaderParameter read GetDirectParam;
139
    property ActiveVarying: TStrings read FActiveVarying write SetActiveVarying;
140
    property TransformFeedBackMode: TGLTransformFeedBackMode read FTransformFeedBackMode write SetTransformFeedBackMode default tfbmInterleaved;
141
  end;
142

143

144
  { Wrapper around a parameter of a GLSL program. }
145
  TGLSLShaderParameter = class(TGLCustomShaderParameter)
146
  private
147
     
148
    FGLSLProg: TGLProgramHandle;
149
    FParameterID: GLInt;
150
  protected
151
     
152
    function GetAsVector1f: Single; override;
153
    function GetAsVector2f: TVector2f; override;
154
    function GetAsVector3f: TVector3f; override;
155
    function GetAsVector4f: TVector; override;
156

157
    function GetAsVector1i: Integer; override;
158
    function GetAsVector2i: TVector2i; override;
159
    function GetAsVector3i: TVector3i; override;
160
    function GetAsVector4i: TVector4i; override;
161

162
    function GetAsVector1ui: GLuint; override;
163
    function GetAsVector2ui: TVector2ui; override;
164
    function GetAsVector3ui: TVector3ui; override;
165
    function GetAsVector4ui: TVector4ui; override;
166

167
    procedure SetAsVector1f(const Value: Single); override;
168
    procedure SetAsVector2f(const Value: TVector2f); override;
169
    procedure SetAsVector3f(const Value: TVector3f); override;
170
    procedure SetAsVector4f(const Value: TVector4f); override;
171

172
    procedure SetAsVector1i(const Value: Integer); override;
173
    procedure SetAsVector2i(const Value: TVector2i); override;
174
    procedure SetAsVector3i(const Value: TVector3i); override;
175
    procedure SetAsVector4i(const Value: TVector4i); override;
176

177
    procedure SetAsVector1ui(const Value: GLuint); override;
178
    procedure SetAsVector2ui(const Value: TVector2ui); override;
179
    procedure SetAsVector3ui(const Value: TVector3ui); override;
180
    procedure SetAsVector4ui(const Value: TVector4ui); override;
181

182
    function GetAsMatrix2f: TMatrix2f; override;
183
    function GetAsMatrix3f: TMatrix3f; override;
184
    function GetAsMatrix4f: TMatrix4f; override;
185
    procedure SetAsMatrix2f(const Value: TMatrix2f); override;
186
    procedure SetAsMatrix3f(const Value: TMatrix3f); override;
187
    procedure SetAsMatrix4f(const Value: TMatrix4f); override;
188

189
    function GetAsCustomTexture(const TextureIndex: Integer;
190
      TextureTarget: TGLTextureTarget): Cardinal; override;
191
    procedure SetAsCustomTexture(const TextureIndex: Integer;
192
      TextureTarget: TGLTextureTarget; const Value: Cardinal); override;
193

194
    function GetAsUniformBuffer: GLenum; override;
195
    procedure SetAsUniformBuffer( UBO: GLenum); override;
196

197
   public
198
     // Nothing here ...yet.
199
   end;
200

201
  TGLSLShader = class(TGLCustomGLSLShader)
202
  published
203
    property FragmentProgram;
204
    property VertexProgram;
205
    property GeometryProgram;    
206

207
    property OnApply;
208
    property OnApplyEx;
209
    property OnUnApply;
210
    property OnInitialize;
211
    property OnInitializeEx;
212

213
    property ShaderStyle;
214
    property FailedInitAction;
215

216
    property ActiveVarying;
217
    property TransformFeedBackMode;
218
  end;
219

220

221
implementation
222

223
uses
224
  GLState;
225

226
{ TGLCustomGLSLShader }
227

228
procedure TGLCustomGLSLShader.DoApply(var rci: TGLRenderContextInfo; Sender: TObject);
229
begin
230
  FGLSLProg.UseProgramObject;
231
  if Assigned(FOnApply) then
232
    FOnApply(Self);
233
  if Assigned(FOnApplyEx) then
234
    FOnApplyEx(Self, Sender);
235
end;
236

237

238
procedure TGLCustomGLSLShader.DoInitialize(var rci: TGLRenderContextInfo; Sender: TObject);
239
const
240
  cBufferMode: array[tfbmInterleaved..tfbmSeparate] of GLenum = (
241
    GL_INTERLEAVED_ATTRIBS_EXT, GL_SEPARATE_ATTRIBS_EXT);
242
var
243
  i, NumVarying: Integer;
244
  sVaryings: array of AnsiString;
245
  pVaryings: array of PGLChar;
246
begin
247
  try
248
    if not ShaderSupported then
249
      HandleFailedInitialization
250
    else
251
    try
252
      FGLSLProg.AllocateHandle;
253
      if FGLSLProg.IsDataNeedUpdate then
254
      begin
255
        if Name <> '' then
256
          FGLSLProg.Name := Name
257
        else
258
          FGLSLProg.Name := ClassName;
259

260
        FGLSLProg.DetachAllObject;
261
        if VertexProgram.Enabled then
262
          FGLSLProg.AddShader(TGLVertexShaderHandle, VertexProgram.Code.Text, FDebugMode);
263
        if FragmentProgram.Enabled then
264
          FGLSLProg.AddShader(TGLFragmentShaderHandle, FragmentProgram.Code.Text, FDebugMode);
265
        if GeometryProgram.Enabled then
266
          FGLSLProg.AddShader(TGLGeometryShaderHandle, GeometryProgram.Code.Text, FDebugMode);
267

268
        if VertexProgram.Enabled or FragmentProgram.Enabled or GeometryProgram.Enabled then
269
        begin
270
          if GeometryProgram.Enabled then
271
          begin
272
            GL.ProgramParameteri(FGLSLProg.Handle, GL_GEOMETRY_INPUT_TYPE_EXT,
273
              cGLgsInTypes[GeometryProgram.InputPrimitiveType]);
274
            GL.ProgramParameteri(FGLSLProg.Handle, GL_GEOMETRY_OUTPUT_TYPE_EXT,
275
              cGLgsOutTypes[GeometryProgram.OutputPrimitiveType]);
276
            GL.ProgramParameteri(FGLSLProg.Handle, GL_GEOMETRY_VERTICES_OUT_EXT,
277
              GeometryProgram.VerticesOut);
278
          end;
279

280
          NumVarying := FActiveVarying.Count;
281
          if NumVarying > 0 then
282
          begin
283
            // Activate varying
284
            SetLength(sVaryings, NumVarying);
285
            SetLength(pVaryings, NumVarying);
286
            for i := 0 to NumVarying - 1 do
287
            begin
288
              sVaryings[i] := AnsiString(FActiveVarying.Strings[i]) + #0;
289
              pVaryings[i] := PAnsiChar( sVaryings[i] );
290
            end;
291
            GL.TransformFeedbackVaryings(
292
              FGLSLProg.Handle, NumVarying, @pVaryings[0],
293
              cBufferMode[FTransformFeedBackMode] );
294
          end;
295

296
          if (not FGLSLProg.LinkProgram) then
297
            raise EGLSLShaderException.Create(FGLSLProg.InfoLog);
298
        end;
299
        FGLSLProg.NotifyDataUpdated;
300
      end;
301
    except
302
      on E: Exception do
303
      begin
304
        Enabled := False;
305
        HandleFailedInitialization(E.Message);
306
      end;
307
    end;
308

309
  finally
310
    if Enabled then
311
    try
312
      if Assigned(FOnInitialize) then
313
      begin
314
        FGLSLProg.UseProgramObject;
315
        FOnInitialize(Self);
316
        FGLSLProg.EndUseProgramObject;
317
      end;
318
      if Assigned(FOnInitializeEx) then
319
      begin
320
        FGLSLProg.UseProgramObject;
321
        FOnInitializeEx(Self, Sender);
322
        FGLSLProg.EndUseProgramObject;
323
      end;
324
      if (not FGLSLProg.ValidateProgram) then
325
        raise EGLSLShaderException.Create(FGLSLProg.InfoLog);
326
    except
327
      on E: Exception do
328
      begin
329
        Enabled := False;
330
        HandleFailedInitialization(E.Message);
331
      end;
332
    end;
333
  end;
334
end;
335

336

337
function TGLCustomGLSLShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean;
338
begin
339
  Result := False;
340
  if Assigned(FOnUnApply) then
341
    FOnUnApply(Self, Result);
342
  if not Result then
343
    FGLSLProg.EndUseProgramObject;
344
end;
345

346

347
function TGLCustomGLSLShader.ShaderSupported: Boolean;
348
begin
349
  Result := (GL.ARB_shader_objects and GL.ARB_vertex_program and
350
             GL.ARB_vertex_shader and GL.ARB_fragment_shader);
351
end;
352

353
function TGLCustomGLSLShader.GetActiveAttribs: TGLActiveAttribArray;
354
var
355
  LRci: TGLRenderContextInfo;
356
  i, j: Integer;
357
  buff: array[0..127] of AnsiChar;
358
  len: GLsizei;
359
  max: GLInt;
360
  glType: GLEnum;
361
begin
362
  DoInitialize(LRci, Self);
363

364
  SetLength(Result, 16);
365
  j := 0;
366
  if FGLSLProg.Handle<>0 then
367
  begin
368
    GL.GetProgramiv(FGLSLProg.Handle, GL_ACTIVE_ATTRIBUTES, @max);
369
    for i := 0 to 16 - 1 do
370
    if i<max then
371
    begin
372
      GL.GetActiveAttrib(FGLSLProg.Handle, i, Length(buff), @len, @Result[j].Size,
373
        @glType, @buff[0]);
374
      if glType > 0 then
375
        with Result[j] do
376
        begin
377
          case glType of
378
            GL_FLOAT: AType := GLSLType1F;
379
            GL_FLOAT_VEC2: AType := GLSLType2F;
380
            GL_FLOAT_VEC3: AType := GLSLType3F;
381
            GL_FLOAT_VEC4: AType := GLSLType4F;
382
            GL_INT: AType := GLSLType1I;
383
            GL_INT_VEC2: AType := GLSLType2I;
384
            GL_INT_VEC3: AType := GLSLType3I;
385
            GL_INT_VEC4: AType := GLSLType4I;
386
            GL_UNSIGNED_INT: AType := GLSLType1UI;
387
            GL_UNSIGNED_INT_VEC2: AType := GLSLType2UI;
388
            GL_UNSIGNED_INT_VEC3: AType := GLSLType3UI;
389
            GL_UNSIGNED_INT_VEC4: AType := GLSLType4UI;
390
            GL_BOOL: AType := GLSLType1I;
391
            GL_BOOL_VEC2: AType := GLSLType2I;
392
            GL_BOOL_VEC3: AType := GLSLType3I;
393
            GL_BOOL_VEC4: AType := GLSLType4I;
394
            GL_FLOAT_MAT2: AType := GLSLTypeMat2F;
395
            GL_FLOAT_MAT3: AType := GLSLTypeMat3F;
396
            GL_FLOAT_MAT4: AType := GLSLTypeMat4F;
397
          end;
398
          Name := Copy(string(buff), 0, len);
399
          Location := i;
400
          Inc(j);
401
        end;
402
    end;
403
  end;
404
  SetLength(Result, j);
405
end;
406

407
procedure TGLCustomGLSLShader.Assign(Source: TPersistent);
408
begin
409
  inherited Assign(Source);
410

411
  if Source is TGLCustomGLSLShader then
412
  begin
413
    FreeAndNil(FGLSLProg); //just free the handle for it to be recreated on next initialization
414
  end;
415
end;
416

417
procedure TGLCustomGLSLShader.DoFinalize;
418
begin
419
  inherited;
420
  if Assigned(FGLSLProg) then
421
    FGLSLProg.NotifyChangesOfData;
422
end;
423

424
function TGLCustomGLSLShader.GetGLSLProg: TGLProgramHandle;
425
begin
426
  Result := FGLSLProg;
427
end;
428

429
function TGLCustomGLSLShader.GetParam(
430
  const Index: string): TGLSLShaderParameter;
431
begin
432
  FParam.FParameterID := FGLSLProg.GetUniformLocation(Index);
433
  Result := FParam;
434
end;
435

436
function TGLCustomGLSLShader.GetDirectParam(
437
  const Index: Cardinal): TGLSLShaderParameter;
438
begin
439
  FParam.FParameterID := Index;
440
  Result := FParam;
441
end;
442

443
function TGLCustomGLSLShader.GetCurrentParam: TGLSLShaderParameter;
444
begin
445
  Result := FParam;
446
end;
447

448
constructor TGLCustomGLSLShader.Create(AOwner: TComponent);
449
begin
450
  inherited;
451
  FGLSLProg := TGLProgramHandle.Create;
452
  FParam := TGLSLShaderParameter.Create;
453
  FParam.FGLSLProg := FGLSLProg;
454
  FActiveVarying := TStringList.Create;
455
  TStringList(FActiveVarying).OnChange := OnChangeActiveVarying;
456
  FTransformFeedBackMode := tfbmInterleaved;
457
end;
458

459
destructor TGLCustomGLSLShader.Destroy;
460
begin
461
  FreeAndNil(FGLSLProg);
462
  FreeAndNil(FParam);
463
  FreeAndNil(FActiveVarying);
464
  inherited;
465
end;
466

467
procedure TGLCustomGLSLShader.SetActiveVarying(const Value: TStrings);
468
begin
469
  FActiveVarying.Assign(Value);
470
  NotifyChange(Self);
471
end;
472

473
procedure TGLCustomGLSLShader.SetTransformFeedBackMode(const Value: TGLTransformFeedBackMode);
474
begin
475
  if Value <> FTransformFeedBackMode then
476
  begin
477
    FTransformFeedBackMode := Value;
478
    NotifyChange(Self);
479
  end;
480
end;
481

482
procedure TGLCustomGLSLShader.OnChangeActiveVarying(Sender: TObject);
483
begin
484
  NotifyChange(Self);
485
end;
486

487
{ TGLSLShaderParameter }
488

489
function TGLSLShaderParameter.GetAsCustomTexture(
490
  const TextureIndex: Integer; TextureTarget: TGLTextureTarget): Cardinal;
491
begin
492
  GL.GetUniformiv(FGLSLProg.Handle, TextureIndex, @Result);
493
end;
494

495
function TGLSLShaderParameter.GetAsMatrix2f: TMatrix2f;
496
begin
497
  GL.GetUniformfv(FGLSLProg.Handle, FParameterID, @Result);
498
end;
499

500
function TGLSLShaderParameter.GetAsMatrix3f: TMatrix3f;
501
begin
502
  GL.GetUniformfv(FGLSLProg.Handle, FParameterID, @Result);
503
end;
504

505
function TGLSLShaderParameter.GetAsMatrix4f: TMatrix4f;
506
begin
507
  GL.GetUniformfv(FGLSLProg.Handle, FParameterID, @Result);
508
end;
509

510
function TGLSLShaderParameter.GetAsVector1f: Single;
511
begin
512
  GL.GetUniformfv(FGLSLProg.Handle, FParameterID, @Result);
513
end;
514

515
function TGLSLShaderParameter.GetAsVector1i: Integer;
516
begin
517
  GL.GetUniformiv(FGLSLProg.Handle, FParameterID, @Result);
518
end;
519

520
function TGLSLShaderParameter.GetAsVector2f: TVector2f;
521
begin
522
  GL.GetUniformfv(FGLSLProg.Handle, FParameterID, @Result);
523
end;
524

525
function TGLSLShaderParameter.GetAsVector2i: TVector2i;
526
begin
527
  GL.GetUniformiv(FGLSLProg.Handle, FParameterID, @Result);
528
end;
529

530
function TGLSLShaderParameter.GetAsVector3f: TVector3f;
531
begin
532
  GL.GetUniformfv(FGLSLProg.Handle, FParameterID, @Result);
533
end;
534

535
function TGLSLShaderParameter.GetAsVector3i: TVector3i;
536
begin
537
  GL.GetUniformiv(FGLSLProg.Handle, FParameterID, @Result);
538
end;
539

540
function TGLSLShaderParameter.GetAsVector4f: TVector;
541
begin
542
  GL.GetUniformfv(FGLSLProg.Handle, FParameterID, @Result);
543
end;
544

545
function TGLSLShaderParameter.GetAsVector4i: TVector4i;
546
begin
547
  GL.GetUniformiv(FGLSLProg.Handle, FParameterID, @Result);
548
end;
549

550
procedure TGLSLShaderParameter.SetAsCustomTexture(
551
  const TextureIndex: Integer; TextureTarget: TGLTextureTarget;
552
  const Value: Cardinal);
553
begin
554
  CurrentGLContext.GLStates.TextureBinding[TextureIndex, TextureTarget] := Value;
555
  GL.Uniform1i(FParameterID, TextureIndex);
556
end;
557

558
procedure TGLSLShaderParameter.SetAsMatrix2f(const Value: TMatrix2f);
559
begin
560
  GL.UniformMatrix2fv(FParameterID, 1, False, @Value);
561
end;
562

563
procedure TGLSLShaderParameter.SetAsMatrix3f(const Value: TMatrix3f);
564
begin
565
  GL.UniformMatrix3fv(FParameterID, 1, False, @Value);
566
end;
567

568
procedure TGLSLShaderParameter.SetAsMatrix4f(const Value: TMatrix4f);
569
begin
570
  GL.UniformMatrix4fv(FParameterID, 1, False, @Value);
571
end;
572

573
procedure TGLSLShaderParameter.SetAsVector1f(const Value: Single);
574
begin
575
  GL.Uniform1f(FParameterID, Value);
576
end;
577

578
procedure TGLSLShaderParameter.SetAsVector1i(const Value: Integer);
579
begin
580
  GL.Uniform1i(FParameterID, Value);
581
end;
582

583
procedure TGLSLShaderParameter.SetAsVector2f(const Value: TVector2f);
584
begin
585
  GL.Uniform2f(FParameterID, Value.V[0], Value.V[1]);
586
end;
587

588
procedure TGLSLShaderParameter.SetAsVector2i(const Value: TVector2i);
589
begin
590
  GL.Uniform2i(FParameterID, Value.V[0], Value.V[1]);
591
end;
592

593
procedure TGLSLShaderParameter.SetAsVector3f(const Value: TVector3f);
594
begin
595
  GL.Uniform3f(FParameterID, Value.V[0], Value.V[1], Value.V[2]);
596
end;
597

598
procedure TGLSLShaderParameter.SetAsVector3i(const Value: TVector3i);
599
begin
600
  GL.Uniform3i(FParameterID, Value.V[0], Value.V[1], Value.V[2]);
601
end;
602

603
procedure TGLSLShaderParameter.SetAsVector4f(const Value: TVector4f);
604
begin
605
  GL.Uniform4f(FParameterID, Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
606
end;
607

608
procedure TGLSLShaderParameter.SetAsVector4i(const Value: TVector4i);
609
begin
610
  GL.Uniform4i(FParameterID, Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
611
end;
612

613
function TGLSLShaderParameter.GetAsUniformBuffer: GLenum;
614
begin
615
  GL.GetUniformiv(FGLSLProg.Handle, FParameterID, @Result);
616
end;
617

618
function TGLSLShaderParameter.GetAsVector1ui: GLuint;
619
begin
620
  GL.GetUniformuiv(FGLSLProg.Handle, FParameterID, @Result);
621
end;
622

623
procedure TGLSLShaderParameter.SetAsVector1ui(const Value: GLuint);
624
begin
625
  GL.Uniform1ui(FParameterID, Value);
626
end;
627

628
function TGLSLShaderParameter.GetAsVector2ui: TVector2ui;
629
begin
630
  GL.GetUniformiv(FGLSLProg.Handle, FParameterID, @Result);
631
end;
632

633
procedure TGLSLShaderParameter.SetAsVector2ui(const Value: TVector2ui);
634
begin
635
  GL.Uniform2ui(FParameterID, Value.V[0], Value.V[1]);
636
end;
637

638
function TGLSLShaderParameter.GetAsVector3ui: TVector3ui;
639
begin
640
  GL.GetUniformiv(FGLSLProg.Handle, FParameterID, @Result);
641
end;
642

643
procedure TGLSLShaderParameter.SetAsVector3ui(const Value: TVector3ui);
644
begin
645
  GL.Uniform3ui(FParameterID, Value.V[0], Value.V[1], Value.V[2]);
646
end;
647

648
function TGLSLShaderParameter.GetAsVector4ui: TVector4ui;
649
begin
650
  GL.GetUniformiv(FGLSLProg.Handle, FParameterID, @Result);
651
end;
652

653
procedure TGLSLShaderParameter.SetAsVector4ui(const Value: TVector4ui);
654
begin
655
  GL.Uniform4ui(FParameterID, Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
656
end;
657

658
procedure TGLSLShaderParameter.SetAsUniformBuffer(UBO: Cardinal);
659
begin
660
  CurrentGLContext.GLStates.UniformBufferBinding := UBO;
661
  GL.UniformBuffer(FGLSLProg.Handle, FParameterID, UBO);
662
end;
663

664
initialization
665
  RegisterClasses([TGLCustomGLSLShader, TGLSLShader]);
666

667
end.
668