LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
	 History :  
6
     14/03/11 - Yar - Creation
7
   
8
}
9
unit GLSLParameter;
10

11
interface
12

13
{$I GLScene.inc}
14
{$M-}
15

16
uses
17
  Classes,
18
  OpenGLTokens, GLVectorTypes, GLTextureFormat, GLRenderContextInfo;
19

20
type
21

22
  TGLSLDataType = (
23
    GLSLTypeUndefined,
24
    GLSLType1F,
25
    GLSLType2F,
26
    GLSLType3F,
27
    GLSLType4F,
28
    GLSLType1I,
29
    GLSLType2I,
30
    GLSLType3I,
31
    GLSLType4I,
32
    GLSLType1UI,
33
    GLSLType2UI,
34
    GLSLType3UI,
35
    GLSLType4UI,
36
    GLSLTypeMat2F,
37
    GLSLTypeMat3F,
38
    GLSLTypeMat4F,
39
    GLSLTypeVoid);
40

41
  TGLSLSamplerType = (
42
    GLSLSamplerUndefined,
43
    GLSLSampler1D,
44
    GLSLSampler2D,
45
    GLSLSampler3D,
46
    GLSLSamplerCube,
47
    GLSLSampler1DShadow,
48
    GLSLSampler2DShadow,
49
    GLSLSampler1DArray,
50
    GLSLSampler2DArray,
51
    GLSLSampler1DArrayShadow,
52
    GLSLSampler2DArrayShadow,
53
    GLSLSamplerCubeShadow,
54
    GLSLIntSampler1D,
55
    GLSLIntSampler2D,
56
    GLSLIntSampler3D,
57
    GLSLIntSamplerCube,
58
    GLSLIntSampler1DArray,
59
    GLSLIntSampler2DArray,
60
    GLSLUIntSampler1D,
61
    GLSLUIntSampler2D,
62
    GLSLUIntSampler3D,
63
    GLSLUIntSamplerCube,
64
    GLSLUIntSampler1DArray,
65
    GLSLUIntSampler2DArray,
66
    GLSLSamplerRect,
67
    GLSLSamplerRectShadow,
68
    GLSLSamplerBuffer,
69
    GLSLIntSamplerRect,
70
    GLSLIntSamplerBuffer,
71
    GLSLUIntSamplerRect,
72
    GLSLUIntSamplerBuffer,
73
    GLSLSamplerMS,
74
    GLSLIntSamplerMS,
75
    GLSLUIntSamplerMS,
76
    GLSLSamplerMSArray,
77
    GLSLIntSamplerMSArray,
78
    GLSLUIntSamplerMSArray
79
    );
80

81
  TGLgsInTypes = (
82
    gsInPoints,
83
    gsInLines,
84
    gsInAdjLines,
85
    gsInTriangles,
86
    gsInAdjTriangles
87
  );
88

89
  TGLgsOutTypes = (
90
    gsOutPoints,
91
    gsOutLineStrip,
92
    sOutTriangleStrip
93
  );
94

95

96
  IShaderParameter = interface(IInterface)
97
    function GetName: string;
98
    function GetGLSLType: TGLSLDataType;
99
    function GetGLSLSamplerType: TGLSLSamplerType;
100

101
    function GetAutoSetMethod: string;
102
    function GetTextureName: string;
103
    function GetSamplerName: string;
104
    function GetTextureSwizzle: TSwizzleVector;
105
    procedure SetTextureName(const AValue: string);
106
    procedure SetSamplerName(const AValue: string);
107
    procedure SetAutoSetMethod(const AValue: string);
108
    procedure SetTextureSwizzle(const AValue: TSwizzleVector);
109

110
    function GetFloat: Single;
111
    function GetVec2: TVector2f;
112
    function GetVec3: TVector3f;
113
    function GetVec4: TVector4f;
114

115
    function GetInt: TGLint;
116
    function GetIVec2: TVector2i;
117
    function GetIVec3: TVector3i;
118
    function GetIVec4: TVector4i;
119

120
    function GetUInt: TGLuint;
121
    function GetUVec2: TVector2ui;
122
    function GetUVec3: TVector3ui;
123
    function GetUVec4: TVector4ui;
124

125
    procedure SetFloat(const Value: TGLFloat);
126
    procedure SetVec2(const Value: TVector2f);
127
    procedure SetVec3(const Value: TVector3f);
128
    procedure SetVec4(const Value: TVector4f);
129

130
    procedure SetInt(const Value: Integer);
131
    procedure SetIVec2(const Value: TVector2i);
132
    procedure SetIVec3(const Value: TVector3i);
133
    procedure SetIVec4(const Value: TVector4i);
134

135
    procedure SetUInt(const Value: GLuint);
136
    procedure SetUVec2(const Value: TVector2ui);
137
    procedure SetUVec3(const Value: TVector3ui);
138
    procedure SetUVec4(const Value: TVector4ui);
139

140
    function GetMat2: TMatrix2f;
141
    function GetMat3: TMatrix3f;
142
    function GetMat4: TMatrix4f;
143
    procedure SetMat2(const Value: TMatrix2f);
144
    procedure SetMat3(const Value: TMatrix3f);
145
    procedure SetMat4(const Value: TMatrix4f);
146

147
    procedure SetFloatArray(const Values: PGLFloat; Count: Integer);
148
    procedure SetIntArray(const Values: PGLInt; Count: Integer);
149
    procedure SetUIntArray(const Values: PGLUInt; Count: Integer);
150

151
    property Name: string read GetName;
152
    property GLSLType: TGLSLDataType read GetGLSLType;
153
    property GLSLSamplerType: TGLSLSamplerType read GetGLSLSamplerType;
154
{.$IFDEF GLS_DELPHI_OR_CPPB}
155
    { Scalar types.}
156
    property float: TGLFloat read GetFloat write SetFloat;
157
    property int: TGLint read GetInt write SetInt;
158
    property uint: TGLUint read GetUInt write SetUInt;
159

160
    { Float vector types.}
161
    property vec2: TVector2f read GetVec2 write SetVec2;
162
    property vec3: TVector3f read GetVec3 write SetVec3;
163
    property vec4: TVector4f read GetVec4 write SetVec4;
164

165
    { Integer vector  types.}
166
    property ivec2: TVector2i read GetIVec2 write SetIVec2;
167
    property ivec3: TVector3i read GetIVec3 write SetIVec3;
168
    property ivec4: TVector4i read GetIVec4 write SetIVec4;
169

170
    { Unsigned integer vector  types.}
171
    property uvec2: TVector2ui read GetUVec2 write SetUVec2;
172
    property uvec3: TVector3ui read GetUVec3 write SetUVec3;
173
    property uvec4: TVector4ui read GetUVec4 write SetUVec4;
174

175
    { Matrix Types.}
176
    property mat2: TMatrix2f read GetMat2 write SetMat2;
177
    property mat3: TMatrix3f read GetMat3 write SetMat3;
178
    property mat4: TMatrix4f read GetMat4 write SetMat4;
179
{.$ENDIF}
180
    { Bindings.}
181
    property AutoSetMethod: string read GetAutoSetMethod write SetAutoSetMethod;
182
    property TextureName: string read GetTextureName write SetTextureName;
183
    property SamplerName: string read GetSamplerName write SetSamplerName;
184
{.$IFDEF GLS_DELPHI_OR_CPPB}
185
    property TextureSwizzle: TSwizzleVector read GetTextureSwizzle write SetTextureSwizzle;
186
{.$ENDIF}
187
  end;
188

189
const
190
  cGLSLTypeString: array[TGLSLDataType] of AnsiString = (
191
    'undefined',
192
    'float',
193
    'vec2',
194
    'vec3',
195
    'vec4',
196
    'int',
197
    'ivec2',
198
    'ivec3',
199
    'ivec4',
200
    'uint',
201
    'uivec2',
202
    'uivec3',
203
    'uivec4',
204
    'mat2',
205
    'mat3',
206
    'mat4',
207
    'void');
208

209
  cGLSLSamplerString: array[TGLSLSamplerType] of AnsiString = (
210
    'undefined',
211
    'sampler1D',
212
    'sampler2D',
213
    'sampler3D',
214
    'samplerCube',
215
    'sampler1DShadow',
216
    'sampler2DShadow',
217
    'sampler1DArray',
218
    'sampler2DArray',
219
    'sampler1DArrayShadow',
220
    'sampler2DArrayShadow',
221
    'samplerCubeShadow',
222
    'isampler1D',
223
    'isampler2D',
224
    'isampler3D',
225
    'isamplerCube',
226
    'isampler1DArray',
227
    'isampler2DArray',
228
    'usampler1D',
229
    'usampler2D',
230
    'usampler3D',
231
    'usamplerCube',
232
    'usampler1DArray',
233
    'usampler2DArray',
234
    'samplerRect',
235
    'samplerRectShadow',
236
    'samplerBuffer',
237
    'isamplerRect',
238
    'isamplerBuffer',
239
    'usamplerRect',
240
    'usamplerBuffer',
241
    'samplerMS',
242
    'isamplerMS',
243
    'usamplerMS',
244
    'samplerMSArray',
245
    'isamplerMSArray',
246
    'usamplerMSArray');
247

248
const
249
  cGLgsInTypes : array[TGLgsInTypes] of GLenum =
250
    (GL_POINTS, GL_LINES, GL_LINES_ADJACENCY_EXT, GL_TRIANGLES,
251
     GL_TRIANGLES_ADJACENCY_EXT);
252
  cGLgsOutTypes: array[TGLgsOutTypes] of GLenum =
253
    (GL_POINTS, GL_LINE_STRIP, GL_TRIANGLE_STRIP);
254

255
resourcestring
256
  rstrNothing = '*nothing*';
257

258
type
259
  TUniformAutoSetMethod = procedure(Sender: IShaderParameter; var ARci: TGLRenderContextInfo) of object;
260

261
function GLSLTypeEnum(AType: TGLSLDataType): TGLEnum;
262
function GLSLTypeComponentCount(AType: TGLSLDataType): Integer;
263
procedure RegisterUniformAutoSetMethod(AMethodName: string;
264
  AType: TGLSLDataType; AMethod: TUniformAutoSetMethod);
265
procedure FillUniformAutoSetMethodList(AList: TStrings;
266
  TypeFilter: TGLSLDataType); overload;
267
procedure FillUniformAutoSetMethodList(AList: TStrings;
268
  TypeFilter: TGLSLSamplerType); overload;
269
function GetUniformAutoSetMethod(AMethodName: string): TUniformAutoSetMethod;
270
function GetUniformAutoSetMethodName(AMethod: TUniformAutoSetMethod): string;
271

272
implementation
273

274
const
275
  cGLSLTypeComponents: array[TGLSLDataType] of Integer =
276
  (
277
    0,
278
    1,
279
    2,
280
    3,
281
    4,
282
    1,
283
    2,
284
    3,
285
    4,
286
    1,
287
    2,
288
    3,
289
    4,
290
    4,
291
    9,
292
    16,
293
    0
294
  );
295

296
  cGLSLTypeEnum: array[TGLSLDataType] of Integer =
297
  (
298
    0,
299
    GL_FLOAT,
300
    GL_FLOAT,
301
    GL_FLOAT,
302
    GL_FLOAT,
303
    GL_INT,
304
    GL_INT,
305
    GL_INT,
306
    GL_INT,
307
    GL_UNSIGNED_INT,
308
    GL_UNSIGNED_INT,
309
    GL_UNSIGNED_INT,
310
    GL_UNSIGNED_INT,
311
    GL_FLOAT,
312
    GL_FLOAT,
313
    GL_FLOAT,
314
    0
315
  );
316

317
type
318
  TAutoSetMethodRec = record
319
    Name: string;
320
    UniformType: TGLSLDataType;
321
    SamplerType: TGLSLSamplerType;
322
    Method: TUniformAutoSetMethod;
323
  end;
324

325
var
326
  vMethods: array of TAutoSetMethodRec;
327

328
function GLSLTypeEnum(AType: TGLSLDataType): TGLEnum;
329
begin
330
  Result := cGLSLTypeEnum[AType];
331
end;
332

333
function GLSLTypeComponentCount(AType: TGLSLDataType): Integer;
334
begin
335
  Result := cGLSLTypeComponents[AType];
336
end;
337

338
procedure RegisterUniformAutoSetMethod(AMethodName: string;
339
  AType: TGLSLDataType; AMethod: TUniformAutoSetMethod);
340
var
341
  I: Integer;
342
begin
343
  for I := 0 to High(vMethods) do
344
    if vMethods[I].Name = AMethodName then
345
    begin
346
      vMethods[I].UniformType := AType;
347
      vMethods[I].Method := AMethod;
348
      exit;
349
    end;
350
  I := Length(vMethods);
351
  SetLength(vMethods, I+1);
352
  vMethods[I].Name := AMethodName;
353
  vMethods[I].UniformType := AType;
354
  vMethods[I].SamplerType := GLSLSamplerUndefined;
355
  vMethods[I].Method := AMethod;
356
end;
357

358
procedure FillUniformAutoSetMethodList(AList: TStrings; TypeFilter: TGLSLDataType);
359
var
360
  I: Integer;
361
begin
362
  for I := 0 to High(vMethods) do
363
    if vMethods[I].UniformType = TypeFilter then
364
      AList.Add(vMethods[I].Name);
365
end;
366

367
procedure FillUniformAutoSetMethodList(AList: TStrings; TypeFilter: TGLSLSamplerType);
368
var
369
  I: Integer;
370
begin
371
  for I := 0 to High(vMethods) do
372
    if vMethods[I].SamplerType = TypeFilter then
373
      AList.Add(vMethods[I].Name);
374
end;
375

376
function GetUniformAutoSetMethod(AMethodName: string): TUniformAutoSetMethod;
377
var
378
  I: Integer;
379
begin
380
  for I := 0 to High(vMethods) do
381
    if vMethods[I].Name = AMethodName then
382
    begin
383
      Result := vMethods[I].Method;
384
      exit;
385
    end;
386
  Result := nil;
387
end;
388

389
function GetUniformAutoSetMethodName(AMethod: TUniformAutoSetMethod): string;
390
var
391
  I: Integer;
392
begin
393
  for I := 0 to High(vMethods) do
394
    if @vMethods[I].Method = @AMethod then
395
    begin
396
      Result := vMethods[I].Name;
397
      exit;
398
    end;
399
  Result := '';
400
end;
401

402
end.
403