2
// This unit is part of the GLScene Engine https://github.com/glscene
5
Handles extended material and it components:
6
textures, samplers, combiners, shaders and etc.
9
- material can contain different level of applying accordingly to hardware i.e. Feateres scaling.
10
- if automatically or by user selected level failed, material down to lower level.
11
- direct state access can be used for uniforms setting.
12
- economy mode for texture bindig to active units,
13
i.e. if textures less than maximum units may be not one binding occur per frame.
16
13/04/11 - Yar - Added TGLASMVertexProgram, fixed multitexturing
17
11/04/11 - Yar - Added texture internal storing and streaming (yet only 2D images)
18
11/03/11 - Yar - Created
30
GLRenderContextInfo, GLBaseClasses, GLContext, GLVectorTypes,
31
GLMaterial, GLTexture, GLColor, GLCoordinates, GLVectorGeometry, GLGraphics,
32
GLPersistentClasses, GLCrossPlatform, GLState, GLTextureFormat, GLXCollection,
33
GLTextureCombiners, OpenGLTokens, GLSLParameter,
34
GLApplicationFileIO, GLStrings, GLImageUtils, GLUtils, XOpenGL,
40
TGLMaterialComponentName = string;
41
TGLMaterialLibraryEx = class;
42
TGLMatLibComponents = class;
43
TGLLibMaterialEx = class;
44
TGLBaseShaderModel = class;
45
TGLASMVertexProgram = class;
47
TOnAsmProgSetting = procedure(Sender: TGLASMVertexProgram;
48
var ARci: TGLRenderContextInfo) of object;
49
TOnUniformInitialize = procedure(Sender: TGLBaseShaderModel) of object;
50
TOnUniformSetting = procedure(Sender: TGLBaseShaderModel;
51
var ARci: TGLRenderContextInfo) of object;
53
// TGLBaseMaterialCollectionItem
56
TGLBaseMaterialCollectionItem = class(
58
IGLMaterialLibrarySupported)
61
FNameHashKey: Integer;
62
FUserList: TPersistentObjectList;
63
FDefferedInit: Boolean;
66
function GetUserList: TPersistentObjectList;
67
function GetMaterialLibraryEx: TGLMaterialLibraryEx;
70
procedure SetName(const AValue: TGLMaterialComponentName); override;
71
procedure NotifyChange(Sender: TObject); virtual;
72
property UserList: TPersistentObjectList read GetUserList;
73
procedure DoOnPrepare(Sender: TGLContext); virtual; abstract;
76
destructor Destroy; override;
78
procedure RegisterUser(AUser: TGLUpdateAbleObject);
79
procedure UnregisterUser(AUser: TGLUpdateAbleObject);
80
function GetUserCount: Integer;
81
function GetMaterialLibrary: TGLAbstractMaterialLibrary;
83
property MaterialLibrary: TGLMaterialLibraryEx read GetMaterialLibraryEx;
84
property IsValid: Boolean read FIsValid;
87
property Name: TGLMaterialComponentName read GetName write SetName;
88
{ Run-time flag, indicate that resource89
should initialize in case of failure material's level. }
90
property DefferedInit: Boolean read FDefferedInit write FDefferedInit
94
CGLBaseMaterialCollectionItem = class of TGLBaseMaterialCollectionItem;
96
// TGLLibMaterialProperty
99
TGLLibMaterialProperty = class(
101
IGLMaterialLibrarySupported)
105
FNextPassName: TGLLibMaterialName;
106
function GetMaterial: TGLLibMaterialEx;
107
function GetMaterialLibraryEx: TGLMaterialLibraryEx;
108
procedure SetEnabled(AValue: Boolean); virtual;
109
procedure SetNextPass(const AValue: TGLLibMaterialName);
110
procedure Loaded; virtual;
111
property NextPass: TGLLibMaterialName read FNextPassName write SetNextPass;
114
procedure NotifyChange(Sender: TObject); override;
115
function GetMaterialLibrary: TGLAbstractMaterialLibrary;
117
property MaterialLibrary: TGLMaterialLibraryEx read GetMaterialLibraryEx;
120
property Enabled: Boolean read FEnabled write SetEnabled;
126
TGLTextureSampler = class(TGLBaseMaterialCollectionItem)
129
procedure WriteToFiler(AWriter: TWriter); override;
130
procedure ReadFromFiler(AReader: TReader); override;
133
FHandle: TGLSamplerHandle;
134
FMinFilter: TGLMinFilter;
135
FMagFilter: TGLMagFilter;
136
FFilteringQuality: TGLTextureFilteringQuality;
138
FLODBiasFract: Single;
139
FWrap: array[0..2] of TGLSeparateTextureWrap;
140
FBorderColor: TGLColor;
141
FCompareMode: TGLTextureCompareMode;
142
FCompareFunc: TDepthFunction;
143
FDecodeSRGB: Boolean;
144
procedure SetMagFilter(AValue: TGLMagFilter);
145
procedure SetMinFilter(AValue: TGLMinFilter);
146
procedure SetLODBias(AValue: Integer);
147
procedure SetFilteringQuality(AValue: TGLTextureFilteringQuality);
148
function GetWrap(Index: Integer): TGLSeparateTextureWrap;
149
procedure SetWrap(Index: Integer; AValue: TGLSeparateTextureWrap);
150
procedure SetBorderColor(const AValue: TGLColor);
151
procedure SetCompareMode(AValue: TGLTextureCompareMode);
152
procedure SetCompareFunc(AValue: TDepthFunction);
153
procedure SetDecodeSRGB(AValue: Boolean);
156
constructor Create(AOwner: TGLXCollection); override;
157
destructor Destroy; override;
158
procedure Assign(Source: TPersistent); override;
160
procedure NotifyChange(Sender: TObject); override;
162
procedure DoOnPrepare(Sender: TGLContext); override;
163
procedure Apply(var ARci: TGLRenderContextInfo);
164
procedure UnApply(var ARci: TGLRenderContextInfo);
166
class function FriendlyName: string; override;
168
property Handle: TGLSamplerHandle read FHandle;
172
{ Texture magnification filter. }173
property MagFilter: TGLMagFilter read FMagFilter write SetMagFilter
175
{ Texture minification filter. }176
property MinFilter: TGLMinFilter read FMinFilter write SetMinFilter
177
default miLinearMipMapLinear;
178
property FilteringQuality: TGLTextureFilteringQuality read FFilteringQuality
179
write SetFilteringQuality default tfAnisotropic;
180
{ : Texture LOD bias. }181
property LodBias: Integer read FLODBias write SetLODBias default 0;
182
{ : Address mode for the texture. }183
property WrapX: TGLSeparateTextureWrap index 0 read GetWrap write SetWrap
185
property WrapY: TGLSeparateTextureWrap index 1 read GetWrap write SetWrap
187
property WrapZ: TGLSeparateTextureWrap index 2 read GetWrap write SetWrap
189
{ : Texture border color. }190
property BorderColor: TGLColor read FBorderColor
191
write SetBorderColor;
192
{ : Compare mode and function for depth texture. }193
property CompareMode: TGLTextureCompareMode read FCompareMode
194
write SetCompareMode default tcmNone;
195
property CompareFunc: TDepthFunction read FCompareFunc
196
write SetCompareFunc default cfLEqual;
197
{ Force retrieving the undecoded sRGB data from the198
texture and manipulate that directly. }
199
property sRGB_Encode: Boolean read FDecodeSRGB write SetDecodeSRGB
203
// TGLAbstractTexture
206
TGLAbstractTexture = class(TGLBaseMaterialCollectionItem)
209
FHandle: TGLTextureHandle;
210
FInternalFormat: TGLInternalFormat;
214
FSwizzles: TSwizzleVector;
215
FApplicableSampler: TGLTextureSampler;
216
FLastSampler: TGLTextureSampler;
217
function GetTextureTarget: TGLTextureTarget;
218
procedure Apply(var ARci: TGLRenderContextInfo); virtual; abstract;
219
procedure UnApply(var ARci: TGLRenderContextInfo); virtual; abstract;
222
property Handle: TGLTextureHandle read FHandle;
225
property Shape: TGLTextureTarget read GetTextureTarget;
228
TMipmapGenerationMode =
245
TGLTextureImageEx = class(TGLAbstractTexture)
248
procedure WriteToFiler(AWriter: TWriter); override;
249
procedure ReadFromFiler(AReader: TReader); override;
252
FCompression: TGLTextureCompression;
253
FImage: TGLBaseImage;
254
FImageAlpha: TGLTextureImageAlpha;
255
FImageBrightness: Single;
257
FHeightToNormalScale: Single;
259
FApplyCounter: Integer;
260
FInternallyStored: Boolean;
261
FMipGenMode: TMipmapGenerationMode;
262
FUseStreaming: Boolean;
266
procedure SetInternalFormat(const AValue: TGLInternalFormat);
267
procedure SetImageAlpha(const AValue: TGLTextureImageAlpha);
268
procedure SetImageBrightness(const AValue: Single);
269
function StoreBrightness: Boolean;
270
procedure SetImageGamma(const AValue: Single);
271
function StoreGamma: Boolean;
272
procedure SetNormalMapScale(const AValue: Single);
273
function StoreNormalMapScale: Boolean;
274
procedure SetCompression(const AValue: TGLTextureCompression);
275
procedure SetSourceFile(AValue: string);
276
procedure SetInternallyStored(const AValue: Boolean);
277
procedure SetMipGenMode(const AValue: TMipmapGenerationMode);
278
procedure SetUseStreaming(const AValue: Boolean);
279
procedure PrepareImage;
280
procedure FullTransfer;
281
procedure StreamTransfer;
282
procedure CalcLODRange(out AFirstLOD, ALastLOD: Integer);
285
constructor Create(AOwner: TGLXCollection); override;
286
destructor Destroy; override;
287
procedure Assign(Source: TPersistent); override;
289
procedure NotifyChange(Sender: TObject); override;
291
procedure DoOnPrepare(Sender: TGLContext); override;
292
procedure Apply(var ARci: TGLRenderContextInfo); override;
293
procedure UnApply(var ARci: TGLRenderContextInfo); override;
295
class function FriendlyName: string; override;
299
// Factual texture properties
300
property InternalWidth: Integer read FWidth;
301
property InternalHeight: Integer read FHeight;
302
property InternalDepth: Integer read FDepth;
303
property InternalFormat: TGLInternalFormat read FInternalFormat
304
write SetInternalFormat default tfRGBA8;
306
{ Automatic Image Alpha setting.307
Allows to control how and if the image's Alpha channel (transparency)
309
property ImageAlpha: TGLTextureImageAlpha read FImageAlpha write
310
SetImageAlpha default tiaDefault;
311
{ Texture brightness correction.312
This correction is applied upon loading a TGLTextureImage, it's a
313
simple saturating scaling applied to the RGB components of
314
the 32 bits image, before it is passed to OpenGL, and before
315
gamma correction (if any). }
316
property ImageBrightness: Single read FImageBrightness write
317
SetImageBrightness stored StoreBrightness;
318
{ Texture gamma correction.319
The gamma correction is applied upon loading a TGLTextureImage,
320
applied to the RGB components of the 32 bits image, before it is
321
passed to OpenGL, after brightness correction (if any). }
322
property ImageGamma: Single read FImageGamma write SetImageGamma stored
324
{ Texture compression control.325
If True the compressed TextureFormat variant (the OpenGL ICD must
326
support GL_ARB_texture_compression, or this option is ignored). }
327
property Compression: TGLTextureCompression read FCompression write
328
SetCompression default tcDefault;
329
{ Normal Map scaling.330
Force normal map generation from height map and controls
331
the intensity of the bumps. }
332
property HeightToNormalScale: Single read FHeightToNormalScale
333
write SetNormalMapScale stored StoreNormalMapScale;
334
{ Source file path and name. }335
property SourceFile: string read FSourceFile write SetSourceFile;
336
{ Force to store image levels in separate files in ready to transfer format. }337
property InternallyStored: Boolean read FInternallyStored
338
write SetInternallyStored default False;
339
{ Mipmap generation mode. }340
property MipGenMode: TMipmapGenerationMode read FMipGenMode
341
write SetMipGenMode default mgmOnFly;
342
{ Enable streaming loading. }343
property UseStreaming: Boolean read FUseStreaming
344
write SetUseStreaming default False;
347
// TGLFrameBufferAttachment
350
TGLFrameBufferAttachment = class(TGLAbstractTexture)
353
procedure WriteToFiler(AWriter: TWriter); override;
354
procedure ReadFromFiler(AReader: TReader); override;
357
FRenderBufferHandle: TGLRenderbufferHandle;
362
FFixedSamplesLocation: Boolean;
363
procedure SetWidth(AValue: Integer);
364
procedure SetHeight(AValue: Integer);
365
procedure SetDepth(AValue: Integer);
366
procedure SetInternalFormat(const AValue: TGLInternalFormat);
367
procedure SetOnlyWrite(AValue: Boolean);
368
procedure SetLayered(AValue: Boolean);
369
procedure SetCubeMap(AValue: Boolean);
370
procedure SetSamples(AValue: Integer);
371
procedure SetFixedSamplesLocation(AValue: Boolean);
374
constructor Create(AOwner: TGLXCollection); override;
375
destructor Destroy; override;
376
procedure Assign(Source: TPersistent); override;
378
procedure NotifyChange(Sender: TObject); override;
380
procedure DoOnPrepare(Sender: TGLContext); override;
381
procedure Apply(var ARci: TGLRenderContextInfo); override;
382
procedure UnApply(var ARci: TGLRenderContextInfo); override;
384
class function FriendlyName: string; override;
387
property InternalWidth: Integer read FWidth
388
write SetWidth default 256;
389
property InternalHeight: Integer read FHeight
390
write SetHeight default 256;
391
property InternalDepth: Integer read FDepth
392
write SetDepth default 0;
393
property InternalFormat: TGLInternalFormat read FInternalFormat
394
write SetInternalFormat default tfRGBA8;
395
{ This flag makes use render buffer as target which makes396
it impossible to read it as texture, but improves efficiency. }
397
property OnlyWrite: Boolean read FOnlyWrite
398
write SetOnlyWrite default False;
399
{ Force targe be texture array. }400
property Layered: Boolean read FLayered
401
write SetLayered default False;
402
{ Force target be cube map. }403
property CubeMap: Boolean read FCubeMap
404
write SetCubeMap default False;
405
{ Number of samples. Positive value makes texture be multisample. }406
property Samples: Integer read FSamples
407
write SetSamples default -1;
408
{ FixedSamplesLocation flag makes image will use identical409
sample locations and the same number of samples for all texels in
410
the image, and the sample locations will not depend on the
411
internalformat or size of the image. }
412
property FixedSamplesLocation: Boolean read FFixedSamplesLocation
413
write SetFixedSamplesLocation default False;
416
// TGLTextureSwizzling
418
{ Swizzle the components of a texture fetches in419
shader or fixed-function pipeline. }
420
TGLTextureSwizzling = class(TGLUpdateAbleObject)
423
FSwizzles: TSwizzleVector;
424
function GetSwizzle(AIndex: Integer): TGLTextureSwizzle;
425
procedure SetSwizzle(AIndex: Integer; AValue: TGLTextureSwizzle);
426
function StoreSwizzle(AIndex: Integer): Boolean;
428
constructor Create(AOwner: TPersistent); override;
429
procedure Assign(Source: TPersistent); override;
431
procedure WriteToFiler(AWriter: TWriter);
432
procedure ReadFromFiler(AReader: TReader);
435
property RedFrom: TGLTextureSwizzle index 0 read GetSwizzle
436
write SetSwizzle stored StoreSwizzle;
437
property GreenFrom: TGLTextureSwizzle index 1 read GetSwizzle
438
write SetSwizzle stored StoreSwizzle;
439
property BlueFrom: TGLTextureSwizzle index 2 read GetSwizzle
440
write SetSwizzle stored StoreSwizzle;
441
property AlphaFrom: TGLTextureSwizzle index 3 read GetSwizzle
442
write SetSwizzle stored StoreSwizzle;
445
// TGLTextureProperties
448
TGLTextureProperties = class(TGLLibMaterialProperty)
451
FLibTextureName: TGLMaterialComponentName;
452
FLibSamplerName: TGLMaterialComponentName;
453
FLibTexture: TGLAbstractTexture;
454
FLibSampler: TGLTextureSampler;
455
FTextureOffset, FTextureScale: TGLCoordinates;
456
FTextureRotate: Single;
457
FTextureMatrixIsIdentity: Boolean;
458
FTextureOverride: Boolean;
459
FTextureMatrix: TMatrix;
460
FMappingMode: TGLTextureMappingMode;
462
FMapSCoordinates: TGLCoordinates4;
463
FMapTCoordinates: TGLCoordinates4;
464
FMapRCoordinates: TGLCoordinates4;
465
FMapQCoordinates: TGLCoordinates4;
466
FSwizzling: TGLTextureSwizzling;
467
function GetLibTextureName: TGLMaterialComponentName;
468
function GetLibSamplerName: TGLMaterialComponentName;
469
procedure SetLibTextureName(const AValue: TGLMaterialComponentName);
470
procedure SetLibSamplerName(const AValue: TGLMaterialComponentName);
471
function GetTextureOffset: TGLCoordinates;
472
procedure SetTextureOffset(const AValue: TGLCoordinates);
473
function StoreTextureOffset: Boolean;
474
function GetTextureScale: TGLCoordinates;
475
procedure SetTextureScale(const AValue: TGLCoordinates);
476
function StoreTextureScale: Boolean;
477
procedure SetTextureMatrix(const AValue: TMatrix);
478
procedure SetTextureRotate(AValue: Single);
479
function StoreTextureRotate: Boolean;
480
procedure SetMappingMode(const AValue: TGLTextureMappingMode);
481
function GetMappingSCoordinates: TGLCoordinates4;
482
procedure SetMappingSCoordinates(const AValue: TGLCoordinates4);
483
function StoreMappingSCoordinates: Boolean;
484
function GetMappingTCoordinates: TGLCoordinates4;
485
procedure SetMappingTCoordinates(const AValue: TGLCoordinates4);
486
function StoreMappingTCoordinates: Boolean;
487
function GetMappingRCoordinates: TGLCoordinates4;
488
procedure SetMappingRCoordinates(const AValue: TGLCoordinates4);
489
function StoreMappingRCoordinates: Boolean;
490
function GetMappingQCoordinates: TGLCoordinates4;
491
procedure SetMappingQCoordinates(const AValue: TGLCoordinates4);
492
function StoreMappingQCoordinates: Boolean;
493
procedure SetSwizzling(const AValue: TGLTextureSwizzling);
494
function StoreSwizzling: Boolean;
495
procedure SetEnvColor(const AValue: TGLColor);
497
procedure CalculateTextureMatrix;
498
procedure ApplyMappingMode;
499
procedure UnApplyMappingMode;
501
procedure Loaded; override;
504
constructor Create(AOwner: TPersistent); override;
505
destructor Destroy; override;
506
procedure Assign(Source: TPersistent); override;
508
procedure NotifyChange(Sender: TObject); override;
509
procedure Notification(Sender: TObject; Operation: TOperation); override;
511
function IsValid: Boolean;
512
procedure Apply(var ARci: TGLRenderContextInfo);
513
procedure UnApply(var ARci: TGLRenderContextInfo);
515
property TextureMatrix: TMatrix read FTextureMatrix write SetTextureMatrix;
518
property LibTextureName: TGLMaterialComponentName read GetLibTextureName
519
write SetLibTextureName;
520
property LibSamplerName: TGLMaterialComponentName read GetLibSamplerName
521
write SetLibSamplerName;
522
property TextureOffset: TGLCoordinates read GetTextureOffset write
523
SetTextureOffset stored StoreTextureOffset;
524
{ Texture coordinates scaling.525
Scaling is applied before applying the offset, and is applied
526
to the texture coordinates, meaning that a scale factor of (2, 2, 2)
527
will make your texture look twice <i>smaller</i>. }
528
property TextureScale: TGLCoordinates read GetTextureScale write
529
SetTextureScale stored StoreTextureScale;
530
{ Texture coordinates rotating.531
Rotating is applied after applying offset and scale,
532
and rotate ST direction around R axis. }
533
property TextureRotate: Single read FTextureRotate write
534
SetTextureRotate stored StoreTextureRotate;
535
{ Texture Environment color. }536
property EnvColor: TGLColor read FEnvColor write SetEnvColor;
537
{ Texture coordinates mapping mode.538
This property controls automatic texture coordinates generation. }
539
property MappingMode: TGLTextureMappingMode read FMappingMode write
540
SetMappingMode default tmmUser;
541
{ Texture mapping coordinates mode for S, T, R and Q axis.542
This property stores the coordinates for automatic texture
543
coordinates generation. }
544
property MappingSCoordinates: TGLCoordinates4 read GetMappingSCoordinates
545
write SetMappingSCoordinates stored StoreMappingSCoordinates;
546
property MappingTCoordinates: TGLCoordinates4 read GetMappingTCoordinates
547
write SetMappingTCoordinates stored StoreMappingTCoordinates;
548
property MappingRCoordinates: TGLCoordinates4 read GetMappingRCoordinates
549
write SetMappingRCoordinates stored StoreMappingRCoordinates;
550
property MappingQCoordinates: TGLCoordinates4 read GetMappingQCoordinates
551
write SetMappingQCoordinates stored StoreMappingQCoordinates;
552
{ Texture color fetching parameters. }553
property Swizzling: TGLTextureSwizzling read FSwizzling write
554
SetSwizzling stored StoreSwizzling;
557
// TGLFixedFunctionProperties
559
TGLFixedFunctionProperties = class(TGLLibMaterialProperty)
562
FFrontProperties: TGLFaceProperties;
563
FBackProperties: TGLFaceProperties;
564
FDepthProperties: TGLDepthProperties;
565
FBlendingMode: TBlendingMode;
566
FBlendingParams: TGLBlendingParameters;
567
FTexProp: TGLTextureProperties;
568
FMaterialOptions: TMaterialOptions;
569
FFaceCulling: TFaceCulling;
570
FPolygonMode: TPolygonMode;
571
FTextureMode: TGLTextureMode;
572
function GetBackProperties: TGLFaceProperties;
573
procedure SetBackProperties(AValues: TGLFaceProperties);
574
procedure SetFrontProperties(AValues: TGLFaceProperties);
575
procedure SetDepthProperties(AValues: TGLDepthProperties);
576
procedure SetBlendingMode(const AValue: TBlendingMode);
577
procedure SetMaterialOptions(const AValue: TMaterialOptions);
578
procedure SetFaceCulling(const AValue: TFaceCulling);
579
procedure SetPolygonMode(AValue: TPolygonMode);
580
procedure SetBlendingParams(const AValue: TGLBlendingParameters);
581
procedure SetTexProp(AValue: TGLTextureProperties);
582
procedure SetTextureMode(AValue: TGLTextureMode);
585
constructor Create(AOwner: TPersistent); override;
586
destructor Destroy; override;
587
procedure Assign(Source: TPersistent); override;
589
procedure Apply(var ARci: TGLRenderContextInfo);
590
procedure UnApply(var ARci: TGLRenderContextInfo);
591
{ Returns True if the material is blended. }592
function Blended: Boolean;
596
property MaterialOptions: TMaterialOptions read FMaterialOptions write
597
SetMaterialOptions default [];
599
property BackProperties: TGLFaceProperties read GetBackProperties write
601
property FrontProperties: TGLFaceProperties read FFrontProperties write
603
property DepthProperties: TGLDepthProperties read FDepthProperties write
605
property BlendingMode: TBlendingMode read FBlendingMode write SetBlendingMode
607
property BlendingParams: TGLBlendingParameters read FBlendingParams write
610
property FaceCulling: TFaceCulling read FFaceCulling write SetFaceCulling
611
default fcBufferDefault;
612
property PolygonMode: TPolygonMode read FPolygonMode write SetPolygonMode
614
property Texture: TGLTextureProperties read FTexProp write SetTexProp;
615
{ Texture application mode. }616
property TextureMode: TGLTextureMode read FTextureMode write SetTextureMode
618
{ Next pass of FFP. }622
// TGLTextureCombiner
625
TGLTextureCombiner = class(TGLBaseMaterialCollectionItem)
628
procedure WriteToFiler(AWriter: TWriter); override;
629
procedure ReadFromFiler(AReader: TReader); override;
632
FHandle: TGLVirtualHandle;
633
FScript: TStringList;
634
FCommandCache: TCombinerCache;
635
procedure SetScript(AValue: TStringList);
636
procedure DoAllocate(Sender: TGLVirtualHandle; var handle: TGLUint);
637
procedure DoDeallocate(Sender: TGLVirtualHandle; var handle: TGLUint);
640
constructor Create(AOwner: TGLXCollection); override;
641
destructor Destroy; override;
642
procedure Assign(Source: TPersistent); override;
644
procedure NotifyChange(Sender: TObject); override;
646
procedure DoOnPrepare(Sender: TGLContext); override;
648
class function FriendlyName: string; override;
651
property Script: TStringList read FScript write SetScript;
654
// TGLARBVertexProgram
657
TGLASMVertexProgram = class(TGLBaseMaterialCollectionItem)
660
procedure WriteToFiler(AWriter: TWriter); override;
661
procedure ReadFromFiler(AReader: TReader); override;
664
FHandle: TGLARBVertexProgramHandle;
665
FSource: TStringList;
668
procedure SetSource(AValue: TStringList);
669
procedure SetSourceFile(AValue: string);
670
function GetHandle: TGLARBVertexProgramHandle;
673
constructor Create(AOwner: TGLXCollection); override;
674
destructor Destroy; override;
675
procedure Assign(Source: TPersistent); override;
677
procedure DoOnPrepare(Sender: TGLContext); override;
679
class function FriendlyName: string; override;
681
procedure NotifyChange(Sender: TObject); override;
682
property Handle: TGLARBVertexProgramHandle read GetHandle;
685
property Source: TStringList read FSource write SetSource;
686
property SourceFile: string read FSourceFile write SetSourceFile;
687
property InfoLog: string read FInfoLog;
690
TLightDir2TexEnvColor = (
698
// TGLMultitexturingProperties
701
TGLMultitexturingProperties = class(TGLLibMaterialProperty)
703
FLibCombiner: TGLTextureCombiner;
704
FLibAsmProg: TGLASMVertexProgram;
705
FLibCombinerName: TGLMaterialComponentName;
706
FLibAsmProgName: TGLMaterialComponentName;
707
FTexProps: array[0..3] of TGLTextureProperties;
708
FTextureMode: TGLTextureMode;
709
FLightDir: TLightDir2TexEnvColor;
710
FLightSourceIndex: Integer;
711
function GetLibCombinerName: string;
712
function GetLibAsmProgName: string;
713
procedure SetLibCombinerName(const AValue: string);
714
procedure SetLibAsmProgName(const AValue: string);
715
function GetTexProps(AIndex: Integer): TGLTextureProperties;
716
procedure SetTexProps(AIndex: Integer; AValue: TGLTextureProperties);
717
procedure SetTextureMode(AValue: TGLTextureMode);
718
procedure SetLightSourceIndex(AValue: Integer);
720
procedure Loaded; override;
723
constructor Create(AOwner: TPersistent); override;
724
destructor Destroy; override;
726
procedure Notification(Sender: TObject; Operation: TOperation); override;
728
function IsValid: Boolean;
729
procedure Apply(var ARci: TGLRenderContextInfo);
730
procedure UnApply(var ARci: TGLRenderContextInfo);
733
property LibCombinerName: string read GetLibCombinerName
734
write SetLibCombinerName;
735
property LibAsmProgName: string read GetLibAsmProgName
736
write SetLibAsmProgName;
737
property Texture0: TGLTextureProperties index 0 read GetTexProps write
739
property Texture1: TGLTextureProperties index 1 read GetTexProps write
741
property Texture2: TGLTextureProperties index 2 read GetTexProps write
743
property Texture3: TGLTextureProperties index 3 read GetTexProps write
745
{ Texture application mode. }746
property TextureMode: TGLTextureMode read FTextureMode write SetTextureMode
748
{ Pass light source direction to enviroment color of choosen texture.749
Vector in model space. }
750
property LightDirTo: TLightDir2TexEnvColor read FLightDir
751
write FLightDir default l2eNone;
752
{ Specify index of light source for LightDirTo. }753
property LightSourceIndex: Integer read FLightSourceIndex
754
write SetLightSourceIndex default 0;
755
{ Next pass of combiner. }771
TGLShaderEx = class(TGLBaseMaterialCollectionItem)
774
procedure WriteToFiler(AWriter: TWriter); override;
775
procedure ReadFromFiler(AReader: TReader); override;
778
FHandle: array[TGLShaderType] of TGLShaderHandle;
779
FSource: TStringList;
781
FShaderType: TGLShaderType;
783
FGeometryInput: TGLgsInTypes;
784
FGeometryOutput: TGLgsOutTypes;
785
FGeometryVerticesOut: TGLint;
786
procedure SetSource(AValue: TStringList);
787
procedure SetSourceFile(AValue: string);
788
procedure SetShaderType(AValue: TGLShaderType);
789
procedure SetGeometryInput(AValue: TGLgsInTypes);
790
procedure SetGeometryOutput(AValue: TGLgsOutTypes);
791
procedure SetGeometryVerticesOut(AValue: TGLint);
792
function GetHandle: TGLShaderHandle;
795
constructor Create(AOwner: TGLXCollection); override;
796
destructor Destroy; override;
797
procedure Assign(Source: TPersistent); override;
799
procedure DoOnPrepare(Sender: TGLContext); override;
801
class function FriendlyName: string; override;
803
procedure NotifyChange(Sender: TObject); override;
804
property Handle: TGLShaderHandle read GetHandle;
807
property Source: TStringList read FSource write SetSource;
808
property SourceFile: string read FSourceFile write SetSourceFile;
809
property ShaderType: TGLShaderType read FShaderType
810
write SetShaderType default shtVertex;
811
property InfoLog: string read FInfoLog;
812
property GeometryInput: TGLgsInTypes read FGeometryInput
813
write SetGeometryInput default gsInPoints;
814
property GeometryOutput: TGLgsOutTypes read FGeometryOutput
815
write SetGeometryOutput default gsOutPoints;
816
property GeometryVerticesOut: TGLint read FGeometryVerticesOut
817
write SetGeometryVerticesOut default 1;
820
// TGLAbstractShaderUniform
823
TGLAbstractShaderUniform = class(TGLUpdateAbleObject, IShaderParameter)
827
FNameHashCode: Integer;
828
FType: TGLSLDataType;
829
FSamplerType: TGLSLSamplerType;
831
function GetName: string;
832
function GetGLSLType: TGLSLDataType;
833
function GetGLSLSamplerType: TGLSLSamplerType;
835
function GetAutoSetMethod: string; virtual;
836
function GetTextureName: string; virtual;
837
function GetSamplerName: string; virtual;
838
function GetTextureSwizzle: TSwizzleVector; virtual;
839
procedure SetTextureName(const AValue: string); virtual;
840
procedure SetSamplerName(const AValue: string); virtual;
841
procedure SetAutoSetMethod(const AValue: string); virtual;
842
procedure SetTextureSwizzle(const AValue: TSwizzleVector); virtual;
844
function GetFloat: Single; virtual;
845
function GetVec2: TVector2f; virtual;
846
function GetVec3: TVector3f; virtual;
847
function GetVec4: TVector; virtual;
849
function GetInt: TGLint; virtual;
850
function GetIVec2: TVector2i; virtual;
851
function GetIVec3: TVector3i; virtual;
852
function GetIVec4: TVector4i; virtual;
854
function GetUInt: TGLuint; virtual;
855
function GetUVec2: TVector2ui; virtual;
856
function GetUVec3: TVector3ui; virtual;
857
function GetUVec4: TVector4ui; virtual;
859
procedure SetFloat(const Value: TGLFloat); virtual;
860
procedure SetVec2(const Value: TVector2f); virtual;
861
procedure SetVec3(const Value: TVector3f); virtual;
862
procedure SetVec4(const Value: TVector4f); virtual;
864
procedure SetInt(const Value: Integer); virtual;
865
procedure SetIVec2(const Value: TVector2i); virtual;
866
procedure SetIVec3(const Value: TVector3i); virtual;
867
procedure SetIVec4(const Value: TVector4i); virtual;
869
procedure SetUInt(const Value: GLuint); virtual;
870
procedure SetUVec2(const Value: TVector2ui); virtual;
871
procedure SetUVec3(const Value: TVector3ui); virtual;
872
procedure SetUVec4(const Value: TVector4ui); virtual;
874
function GetMat2: TMatrix2f; virtual;
875
function GetMat3: TMatrix3f; virtual;
876
function GetMat4: TMatrix4f; virtual;
877
procedure SetMat2(const Value: TMatrix2f); virtual;
878
procedure SetMat3(const Value: TMatrix3f); virtual;
879
procedure SetMat4(const Value: TMatrix4f); virtual;
881
procedure SetFloatArray(const Values: PGLFloat; Count: Integer); virtual;
882
procedure SetIntArray(const Values: PGLInt; Count: Integer); virtual;
883
procedure SetUIntArray(const Values: PGLUInt; Count: Integer); virtual;
885
procedure WriteToFiler(AWriter: TWriter); virtual;
886
procedure ReadFromFiler(AReader: TReader); virtual;
887
procedure Apply(var ARci: TGLRenderContextInfo); virtual;
890
CGLAbstractShaderUniform = class of TGLAbstractShaderUniform;
895
TGLShaderUniform = class(TGLAbstractShaderUniform, IShaderParameter)
899
FStoreProgram: TGLuint;
900
FAutoSet: TUniformAutoSetMethod;
901
function GetProgram: TGLuint;
902
{$IFDEF GLS_INLINE} inline;904
procedure PushProgram;
905
{$IFDEF GLS_INLINE} inline;907
procedure PopProgram;
908
{$IFDEF GLS_INLINE} inline;911
function GetFloat: Single; override;
912
function GetVec2: TVector2f; override;
913
function GetVec3: TVector3f; override;
914
function GetVec4: TVector; override;
916
function GetInt: TGLint; override;
917
function GetIVec2: TVector2i; override;
918
function GetIVec3: TVector3i; override;
919
function GetIVec4: TVector4i; override;
921
function GetUInt: TGLuint; override;
922
function GetUVec2: TVector2ui; override;
923
function GetUVec3: TVector3ui; override;
924
function GetUVec4: TVector4ui; override;
926
procedure SetFloat(const Value: TGLFloat); override;
927
procedure SetVec2(const Value: TVector2f); override;
928
procedure SetVec3(const Value: TVector3f); override;
929
procedure SetVec4(const Value: TVector4f); override;
931
procedure SetInt(const Value: Integer); override;
932
procedure SetIVec2(const Value: TVector2i); override;
933
procedure SetIVec3(const Value: TVector3i); override;
934
procedure SetIVec4(const Value: TVector4i); override;
936
procedure SetUInt(const Value: GLuint); override;
937
procedure SetUVec2(const Value: TVector2ui); override;
938
procedure SetUVec3(const Value: TVector3ui); override;
939
procedure SetUVec4(const Value: TVector4ui); override;
941
function GetMat2: TMatrix2f; override;
942
function GetMat3: TMatrix3f; override;
943
function GetMat4: TMatrix4f; override;
944
procedure SetMat2(const Value: TMatrix2f); override;
945
procedure SetMat3(const Value: TMatrix3f); override;
946
procedure SetMat4(const Value: TMatrix4f); override;
948
function GetAutoSetMethod: string; override;
949
procedure SetAutoSetMethod(const AValue: string); override;
951
procedure WriteToFiler(AWriter: TWriter); override;
952
procedure ReadFromFiler(AReader: TReader); override;
955
procedure SetFloatArray(const Values: PGLFloat; Count: Integer); override;
956
procedure SetIntArray(const Values: PGLInt; Count: Integer); override;
957
procedure SetUIntArray(const Values: PGLUInt; Count: Integer); override;
959
procedure Assign(Source: TPersistent); override;
960
procedure Apply(var ARci: TGLRenderContextInfo); override;
962
property Name: string read GetName;
963
property Location: TGLint read FLocation;
964
property GLSLType: TGLSLDataType read GetGLSLType;
967
// TGLShaderUniformDSA
970
TGLShaderUniformDSA = class(TGLShaderUniform)
973
procedure SetFloat(const Value: TGLFloat); override;
974
procedure SetVec2(const Value: TVector2f); override;
975
procedure SetVec3(const Value: TVector3f); override;
976
procedure SetVec4(const Value: TVector4f); override;
978
procedure SetInt(const Value: Integer); override;
979
procedure SetIVec2(const Value: TVector2i); override;
980
procedure SetIVec3(const Value: TVector3i); override;
981
procedure SetIVec4(const Value: TVector4i); override;
983
procedure SetUInt(const Value: GLuint); override;
984
procedure SetUVec2(const Value: TVector2ui); override;
985
procedure SetUVec3(const Value: TVector3ui); override;
986
procedure SetUVec4(const Value: TVector4ui); override;
988
procedure SetMat2(const Value: TMatrix2f); override;
989
procedure SetMat3(const Value: TMatrix3f); override;
990
procedure SetMat4(const Value: TMatrix4f); override;
993
procedure SetFloatArray(const Values: PGLFloat; Count: Integer); override;
994
procedure SetIntArray(const Values: PGLInt; Count: Integer); override;
995
procedure SetUIntArray(const Values: PGLUInt; Count: Integer); override;
1001
TGLShaderUniformTexture = class(TGLShaderUniform)
1004
FLibTexture: TGLAbstractTexture;
1005
FLibSampler: TGLTextureSampler;
1006
FTarget: TGLTextureTarget;
1007
FSwizzling: TSwizzleVector;
1010
FLibTexureName: TGLMaterialComponentName;
1011
FLibSamplerName: TGLMaterialComponentName;
1012
function GetTextureName: string; override;
1013
function GetSamplerName: string; override;
1014
function GetTextureSwizzle: TSwizzleVector; override;
1015
procedure SetTextureName(const AValue: string); override;
1016
procedure SetSamplerName(const AValue: string); override;
1017
procedure SetTextureSwizzle(const AValue: TSwizzleVector); override;
1019
procedure WriteToFiler(AWriter: TWriter); override;
1020
procedure ReadFromFiler(AReader: TReader); override;
1024
constructor Create(AOwner: TPersistent); override;
1025
destructor Destroy; override;
1026
procedure Assign(Source: TPersistent); override;
1027
procedure Notification(Sender: TObject; Operation: TOperation); override;
1029
procedure Apply(var ARci: TGLRenderContextInfo); override;
1031
property LibTextureName: TGLMaterialComponentName read GetTextureName
1032
write SetTextureName;
1033
property LibSamplerName: TGLMaterialComponentName read GetSamplerName
1034
write SetSamplerName;
1035
property GLSLSampler: TGLSLSamplerType read GetGLSLSamplerType;
1036
property Swizzling: TSwizzleVector read GetTextureSwizzle write
1040
// TGLBaseShaderModel
1043
TGLBaseShaderModel = class(TGLLibMaterialProperty)
1046
FHandle: TGLProgramHandle;
1047
FLibShaderName: array[TGLShaderType] of string;
1048
FShaders: array[TGLShaderType] of TGLShaderEx;
1051
FUniforms: TPersistentObjectList;
1054
function GetLibShaderName(AType: TGLShaderType): string;
1055
procedure SetLibShaderName(AType: TGLShaderType; const AValue: string);
1057
function GetUniform(const AName: string): IShaderParameter;
1058
class procedure ReleaseUniforms(AList: TPersistentObjectList);
1060
property LibVertexShaderName: TGLMaterialComponentName index shtVertex
1061
read GetLibShaderName write SetLibShaderName;
1062
property LibFragmentShaderName: TGLMaterialComponentName index shtFragment
1063
read GetLibShaderName write SetLibShaderName;
1064
property LibGeometryShaderName: TGLMaterialComponentName index shtGeometry
1065
read GetLibShaderName write SetLibShaderName;
1066
property LibTessEvalShaderName: TGLMaterialComponentName index shtEvaluation
1067
read GetLibShaderName write SetLibShaderName;
1068
property LibTessControlShaderName: TGLMaterialComponentName index shtControl
1069
read GetLibShaderName write SetLibShaderName;
1071
procedure DefineProperties(Filer: TFiler); override;
1072
procedure ReadUniforms(AStream: TStream);
1073
procedure WriteUniforms(AStream: TStream);
1074
procedure Loaded; override;
1075
class function IsSupported: Boolean; virtual; abstract;
1079
constructor Create(AOwner: TPersistent); override;
1080
destructor Destroy; override;
1081
procedure Assign(Source: TPersistent); override;
1083
procedure NotifyChange(Sender: TObject); override;
1084
procedure Notification(Sender: TObject; Operation: TOperation); override;
1086
procedure DoOnPrepare(Sender: TGLContext);
1087
procedure Apply(var ARci: TGLRenderContextInfo); virtual;
1088
procedure UnApply(var ARci: TGLRenderContextInfo); virtual;
1090
procedure GetUniformNames(Proc: TGetStrProc);
1092
property Handle: TGLProgramHandle read FHandle;
1093
property IsValid: Boolean read FIsValid;
1094
property Uniforms[const AName: string]: IShaderParameter read GetUniform;
1097
// Compilation info log for design time
1098
property InfoLog: string read FInfoLog;
1099
// Turn on autofill of uniforms
1100
property AutoFillOfUniforms: Boolean read FAutoFill
1101
write FAutoFill stored False;
1105
TGLShaderModel3 = class(TGLBaseShaderModel)
1108
class function IsSupported: Boolean; override;
1111
property LibVertexShaderName;
1112
property LibFragmentShaderName;
1115
TGLShaderModel4 = class(TGLBaseShaderModel)
1118
class function IsSupported: Boolean; override;
1121
property LibVertexShaderName;
1122
property LibGeometryShaderName;
1123
property LibFragmentShaderName;
1126
TGLShaderModel5 = class(TGLBaseShaderModel)
1129
procedure Apply(var ARci: TGLRenderContextInfo); override;
1130
procedure UnApply(var ARci: TGLRenderContextInfo); override;
1131
class function IsSupported: Boolean; override;
1134
property LibTessControlShaderName;
1135
property LibTessEvalShaderName;
1136
property LibVertexShaderName;
1137
property LibGeometryShaderName;
1138
property LibFragmentShaderName;
1144
TGLLibMaterialEx = class(TGLAbstractLibMaterial)
1147
FHandle: TGLVirtualHandle;
1148
FApplicableLevel: TGLMaterialLevel;
1149
FSelectedLevel: TGLMaterialLevel;
1150
FFixedFunc: TGLFixedFunctionProperties;
1151
FMultitexturing: TGLMultitexturingProperties;
1152
FSM3: TGLShaderModel3;
1153
FSM4: TGLShaderModel4;
1154
FSM5: TGLShaderModel5;
1155
FOnAsmProgSetting: TOnAsmProgSetting;
1156
FOnSM3UniformInit: TOnUniformInitialize;
1157
FOnSM3UniformSetting: TOnUniformSetting;
1158
FOnSM4UniformInit: TOnUniformInitialize;
1159
FOnSM4UniformSetting: TOnUniformSetting;
1160
FOnSM5UniformInit: TOnUniformInitialize;
1161
FOnSM5UniformSetting: TOnUniformSetting;
1162
FNextPass: TGLLibMaterialEx;
1163
FStoreAmalgamating: Boolean;
1164
procedure SetLevel(AValue: TGLMaterialLevel);
1165
procedure SetFixedFunc(AValue: TGLFixedFunctionProperties);
1166
procedure SetMultitexturing(AValue: TGLMultitexturingProperties);
1167
procedure SetSM3(AValue: TGLShaderModel3);
1168
procedure SetSM4(AValue: TGLShaderModel4);
1169
procedure SetSM5(AValue: TGLShaderModel5);
1170
procedure DoAllocate(Sender: TGLVirtualHandle; var handle: TGLUint);
1171
procedure DoDeallocate(Sender: TGLVirtualHandle; var handle: TGLUint);
1173
procedure Loaded; override;
1174
procedure RemoveDefferedInit;
1175
procedure DoOnPrepare(Sender: TGLContext);
1178
constructor Create(ACollection: TCollection); override;
1179
destructor Destroy; override;
1181
procedure Assign(Source: TPersistent); override;
1182
procedure NotifyChange(Sender: TObject); override;
1184
procedure Apply(var ARci: TGLRenderContextInfo); override;
1185
function UnApply(var ARci: TGLRenderContextInfo): Boolean; override;
1187
function Blended: Boolean; override;
1190
property ApplicableLevel: TGLMaterialLevel read FApplicableLevel write
1193
property SelectedLevel: TGLMaterialLevel read FSelectedLevel;
1194
property FixedFunction: TGLFixedFunctionProperties
1195
read FFixedFunc write SetFixedFunc;
1196
property Multitexturing: TGLMultitexturingProperties
1197
read FMultitexturing write SetMultitexturing;
1198
property ShaderModel3: TGLShaderModel3 read FSM3 write SetSM3;
1199
property ShaderModel4: TGLShaderModel4 read FSM4 write SetSM4;
1200
property ShaderModel5: TGLShaderModel5 read FSM5 write SetSM5;
1202
// Asm vertex program event
1203
property OnAsmProgSetting: TOnAsmProgSetting read FOnAsmProgSetting
1204
write FOnAsmProgSetting;
1205
// Shader model 3 event
1206
property OnSM3UniformInitialize: TOnUniformInitialize read FOnSM3UniformInit
1207
write FOnSM3UniformInit;
1208
property OnSM3UniformSetting: TOnUniformSetting read FOnSM3UniformSetting
1209
write FOnSM3UniformSetting;
1210
// Shader model 4 event
1211
property OnSM4UniformInitialize: TOnUniformInitialize read FOnSM4UniformInit
1212
write FOnSM4UniformInit;
1213
property OnSM4UniformSetting: TOnUniformSetting read FOnSM4UniformSetting
1214
write FOnSM4UniformSetting;
1215
// Shader model 5 event
1216
property OnSM5UniformInitialize: TOnUniformInitialize read FOnSM5UniformInit
1217
write FOnSM5UniformInit;
1218
property OnSM5UniformSetting: TOnUniformSetting read FOnSM5UniformSetting
1219
write FOnSM5UniformSetting;
1222
// TGLLibMaterialsEx
1225
TGLLibMaterialsEx = class(TGLAbstractLibMaterials)
1227
procedure SetItems(AIndex: Integer; const AValue: TGLLibMaterialEx);
1228
function GetItems(AIndex: Integer): TGLLibMaterialEx;
1231
constructor Create(AOwner: TComponent);
1233
function MaterialLibrary: TGLMaterialLibraryEx;
1235
function IndexOf(const Item: TGLLibMaterialEx): Integer;
1236
function Add: TGLLibMaterialEx;
1237
function FindItemID(ID: Integer): TGLLibMaterialEx;
1238
property Items[index: Integer]: TGLLibMaterialEx read GetItems
1239
write SetItems; default;
1240
function GetLibMaterialByName(const AName: TGLLibMaterialName):
1244
// TGLMatLibComponents
1247
TGLMatLibComponents = class(TGLXCollection)
1250
function GetItems(index: Integer): TGLBaseMaterialCollectionItem;
1253
function GetNamePath: string; override;
1254
class function ItemsClass: TGLXCollectionItemClass; override;
1255
property Items[index: Integer]: TGLBaseMaterialCollectionItem
1256
read GetItems; default;
1258
function GetItemByName(const AName: TGLMaterialComponentName):
1259
TGLBaseMaterialCollectionItem;
1260
function GetTextureByName(const AName: TGLMaterialComponentName):
1262
function GetAttachmentByName(const AName: TGLMaterialComponentName):
1263
TGLFrameBufferAttachment;
1264
function GetSamplerByName(const AName: TGLMaterialComponentName):
1266
function GetCombinerByName(const AName: TGLMaterialComponentName):
1268
function GetShaderByName(const AName: TGLMaterialComponentName):
1270
function GetAsmProgByName(const AName: TGLMaterialComponentName):
1271
TGLASMVertexProgram;
1272
function MakeUniqueName(const AName: TGLMaterialComponentName):
1273
TGLMaterialComponentName;
1276
// TGLMaterialLibraryEx
1279
TGLMaterialLibraryEx = class(TGLAbstractMaterialLibrary)
1282
FComponents: TGLMatLibComponents;
1285
procedure Loaded; override;
1286
function GetMaterials: TGLLibMaterialsEx;
1287
procedure SetMaterials(AValue: TGLLibMaterialsEx);
1288
function StoreMaterials: Boolean;
1289
procedure SetComponents(AValue: TGLMatLibComponents);
1291
procedure DefineProperties(Filer: TFiler); override;
1292
procedure WriteComponents(AStream: TStream);
1293
procedure ReadComponents(AStream: TStream);
1296
constructor Create(AOwner: TComponent); override;
1297
destructor Destroy; override;
1299
procedure GetNames(Proc: TGetStrProc;
1300
AClass: CGLBaseMaterialCollectionItem); overload;
1302
function AddTexture(const AName: TGLMaterialComponentName):
1304
function AddAttachment(const AName: TGLMaterialComponentName):
1305
TGLFrameBufferAttachment;
1306
function AddSampler(const AName: TGLMaterialComponentName):
1308
function AddCombiner(const AName: TGLMaterialComponentName):
1310
function AddShader(const AName: TGLMaterialComponentName): TGLShaderEx;
1311
function AddAsmProg(const AName: TGLMaterialComponentName):
1312
TGLASMVertexProgram;
1314
procedure SetLevelForAll(const ALevel: TGLMaterialLevel);
1317
{ The materials collection. }1318
property Materials: TGLLibMaterialsEx read GetMaterials write SetMaterials
1319
stored StoreMaterials;
1320
property Components: TGLMatLibComponents read FComponents
1321
write SetComponents;
1322
property TexturePaths;
1325
procedure RegisterGLMaterialExNameChangeEvent(AEvent: TNotifyEvent);
1326
procedure DeRegisterGLMaterialExNameChangeEvent(AEvent: TNotifyEvent);
1331
cTextureMagFilter: array[maNearest..maLinear] of TGLEnum =
1332
(GL_NEAREST, GL_LINEAR);
1333
cTextureMinFilter: array[miNearest..miLinearMipmapLinear] of TGLEnum =
1334
(GL_NEAREST, GL_LINEAR, GL_NEAREST_MIPMAP_NEAREST,
1335
GL_LINEAR_MIPMAP_NEAREST, GL_NEAREST_MIPMAP_LINEAR,
1336
GL_LINEAR_MIPMAP_LINEAR);
1337
cTextureWrapMode: array[twRepeat..twMirrorClampToBorder] of TGLenum =
1338
(GL_REPEAT, GL_CLAMP_TO_EDGE, GL_CLAMP_TO_BORDER,
1339
GL_MIRRORED_REPEAT, GL_MIRROR_CLAMP_TO_EDGE_ATI,
1340
GL_MIRROR_CLAMP_TO_BORDER_EXT);
1341
cTextureCompareMode: array[tcmNone..tcmCompareRtoTexture] of TGLenum =
1342
(GL_NONE, GL_COMPARE_R_TO_TEXTURE);
1343
cSamplerToTexture: array[TGLSLSamplerType] of TGLTextureTarget =
1376
ttTexture2DMultisample,
1377
ttTexture2DMultisample,
1378
ttTexture2DMultisample,
1379
ttTexture2DMultisampleArray,
1380
ttTexture2DMultisampleArray,
1381
ttTexture2DMultisample
1384
cTextureSwizzle: array[TGLTextureSwizzle] of TGLEnum =
1395
cTextureMode: array[TGLTextureMode] of TGLEnum =
1396
(GL_DECAL, GL_MODULATE, GL_BLEND, GL_REPLACE, GL_ADD);
1399
cShaderTypeName: array[TGLShaderType] of string =
1400
('vertex', 'control', 'evaluation', 'geomtery', 'fragment');1403
TFriendlyImage = class(TGLBaseImage);
1405
TStandartUniformAutoSetExecutor = class
1408
procedure SetModelMatrix(Sender: IShaderParameter; var ARci:
1409
TGLRenderContextInfo);
1410
procedure SetViewMatrix(Sender: IShaderParameter; var ARci:
1411
TGLRenderContextInfo);
1412
procedure SetProjectionMatrix(Sender: IShaderParameter; var ARci:
1413
TGLRenderContextInfo);
1414
procedure SetInvModelMatrix(Sender: IShaderParameter; var ARci:
1415
TGLRenderContextInfo);
1416
procedure SetModelViewMatrix(Sender: IShaderParameter; var ARci:
1417
TGLRenderContextInfo);
1418
procedure SetNormalModelMatrix(Sender: IShaderParameter; var ARci:
1419
TGLRenderContextInfo);
1420
procedure SetInvModelViewMatrix(Sender: IShaderParameter; var ARci:
1421
TGLRenderContextInfo);
1422
procedure SetViewProjectionMatrix(Sender: IShaderParameter; var ARci:
1423
TGLRenderContextInfo);
1424
procedure SetWorldViewProjectionMatrix(Sender: IShaderParameter; var ARci:
1425
TGLRenderContextInfo);
1426
procedure SetCameraPosition(Sender: IShaderParameter; var ARci:
1427
TGLRenderContextInfo);
1429
procedure SetLightSource0Position(Sender: IShaderParameter; var ARci:
1430
TGLRenderContextInfo);
1432
procedure SetMaterialFrontAmbient(Sender: IShaderParameter; var ARci:
1433
TGLRenderContextInfo);
1434
procedure SetMaterialFrontDiffuse(Sender: IShaderParameter; var ARci:
1435
TGLRenderContextInfo);
1436
procedure SetMaterialFrontSpecular(Sender: IShaderParameter; var ARci:
1437
TGLRenderContextInfo);
1438
procedure SetMaterialFrontEmission(Sender: IShaderParameter; var ARci:
1439
TGLRenderContextInfo);
1440
procedure SetMaterialFrontShininess(Sender: IShaderParameter; var ARci:
1441
TGLRenderContextInfo);
1442
procedure SetMaterialBackAmbient(Sender: IShaderParameter; var ARci:
1443
TGLRenderContextInfo);
1444
procedure SetMaterialBackDiffuse(Sender: IShaderParameter; var ARci:
1445
TGLRenderContextInfo);
1446
procedure SetMaterialBackSpecular(Sender: IShaderParameter; var ARci:
1447
TGLRenderContextInfo);
1448
procedure SetMaterialBackShininess(Sender: IShaderParameter; var ARci:
1449
TGLRenderContextInfo);
1450
procedure SetMaterialBackEmission(Sender: IShaderParameter; var ARci:
1451
TGLRenderContextInfo);
1455
vGLMaterialExNameChangeEvent: TNotifyEvent;
1456
vStandartUniformAutoSetExecutor: TStandartUniformAutoSetExecutor;
1457
vStoreBegin: procedure(mode: TGLEnum);
1458
{$IFDEF MSWINDOWS}stdcall;1459
{$ENDIF}{$IFDEF UNIX}cdecl;1462
procedure RegisterGLMaterialExNameChangeEvent(AEvent: TNotifyEvent);
1464
vGLMaterialExNameChangeEvent := AEvent;
1467
procedure DeRegisterGLMaterialExNameChangeEvent(AEvent: TNotifyEvent);
1469
vGLMaterialExNameChangeEvent := nil;
1472
function ComputeNameHashKey(
1473
const AName: string): Integer;
1480
Result := (Result shl 1) + Byte(AName[i]);
1483
procedure Div2(var Value: Integer);
1484
{$IFDEF GLS_INLINE} inline;1487
Value := Value div 2;
1492
function CalcTextureLevelNumber(ATarget: TGLTextureTarget; w, h, d: Integer):
1501
ttTexture1D, ttTexture1DArray, ttTextureCube, ttTextureCubeArray:
1507
ttTexture2D, ttTexture2DArray:
1512
until (w <= 1) and (h <= 1);
1520
until (w <= 1) and (h <= 1) and (d <= 1);
1522
ttTextureRect, ttTextureBuffer,
1523
ttTexture2DMultisample, ttTexture2DMultisampleArray:
1528
{$IFDEF GLS_REGION}{$REGION 'TGLBaseMaterialCollectionItem'}{$ENDIF}1530
destructor TGLBaseMaterialCollectionItem.Destroy;
1534
if Assigned(FUserList) then
1537
for I := FUserList.Count - 1 downto 0 do
1538
TGLLibMaterialProperty(FUserList[I]).Notification(Self, opRemove);
1539
FreeAndNil(FUserList);
1544
function TGLBaseMaterialCollectionItem.GetMaterialLibrary:
1545
TGLAbstractMaterialLibrary;
1547
Result := TGLAbstractMaterialLibrary(TGLMatLibComponents(Owner).Owner);
1550
function TGLBaseMaterialCollectionItem.GetMaterialLibraryEx:
1551
TGLMaterialLibraryEx;
1553
Result := TGLMaterialLibraryEx(TGLMatLibComponents(Owner).Owner);
1556
function TGLBaseMaterialCollectionItem.GetUserCount: Integer;
1558
if Assigned(FUserList) then
1559
Result := FUserList.Count
1564
function TGLBaseMaterialCollectionItem.GetUserList: TPersistentObjectList;
1566
if FUserList = nil then
1568
FUserList := TPersistentObjectList.Create;
1569
FNotifying := False;
1571
Result := FUserList;
1574
procedure TGLBaseMaterialCollectionItem.NotifyChange(Sender: TObject);
1581
if GetUserCount > 0 then
1582
for I := 0 to FUserList.Count - 1 do
1583
TGLUpdateAbleObject(FUserList[I]).NotifyChange(Self);
1584
FNotifying := False;
1587
procedure TGLBaseMaterialCollectionItem.RegisterUser(
1588
AUser: TGLUpdateAbleObject);
1590
if not FNotifying and (UserList.IndexOf(AUser) < 0) then
1591
UserList.Add(AUser);
1594
procedure TGLBaseMaterialCollectionItem.UnregisterUser(
1595
AUser: TGLUpdateAbleObject);
1597
if not FNotifying then
1598
UserList.Remove(AUser);
1601
procedure TGLBaseMaterialCollectionItem.SetName(const AValue: string);
1603
if AValue <> Name then
1605
if not IsValidIdent(AValue) then
1607
if IsDesignTime then
1608
InformationDlg(AValue + ' - is not valid component name');
1611
if not (csLoading in MaterialLibrary.ComponentState) then
1613
if TGLMatLibComponents(Owner).GetItemByName(AValue) <> Self then
1614
inherited SetName(TGLMatLibComponents(Owner).MakeUniqueName(AValue))
1616
inherited SetName(AValue);
1619
inherited SetName(AValue);
1620
FNameHashKey := ComputeNameHashKey(Name);
1624
if Assigned(vGLMaterialExNameChangeEvent) then
1625
vGLMaterialExNameChangeEvent(Self);
1629
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}1631
{$IFDEF GLS_REGION}{$REGION 'TGLFixedFunctionProperties'}{$ENDIF}1633
procedure TGLFixedFunctionProperties.Apply(var ARci: TGLRenderContextInfo);
1635
with ARci.GLStates do
1637
Disable(stColorMaterial);
1638
PolygonMode := FPolygonMode;
1640
// Fixed functionality state
1641
if not ARci.GLStates.ForwardContext then
1644
if (moNoLighting in MaterialOptions) or not ARci.bufferLighting then
1646
Disable(stLighting);
1647
FFrontProperties.ApplyNoLighting(ARci, cmFront);
1652
FFrontProperties.Apply(ARci, cmFront);
1655
if FPolygonMode = pmLines then
1656
Disable(stLineStipple);
1659
if (moIgnoreFog in MaterialOptions) or not ARci.bufferFog then
1665
// Apply FaceCulling and BackProperties (if needs be)
1666
case FFaceCulling of
1669
if ARci.bufferFaceCull then
1672
Disable(stCullFace);
1673
BackProperties.Apply(ARci, cmBack);
1675
fcCull: Enable(stCullFace);
1678
Disable(stCullFace);
1679
BackProperties.Apply(ARci, cmBack);
1682
// note: Front + Back with different PolygonMode are no longer supported.
1683
// Currently state cache just ignores back facing mode changes, changes to
1684
// front affect both front + back PolygonMode
1686
// Apply Blending mode
1687
if not ARci.ignoreBlendingRequests then
1688
case FBlendingMode of
1692
Disable(stAlphaTest);
1697
Enable(stAlphaTest);
1698
SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
1699
SetGLAlphaFunction(cfGreater, 0);
1704
Enable(stAlphaTest);
1705
SetBlendFunc(bfSrcAlpha, bfOne);
1706
SetGLAlphaFunction(cfGreater, 0);
1711
Enable(stAlphaTest);
1712
SetGLAlphaFunction(cfGEqual, 0.5);
1717
Enable(stAlphaTest);
1718
SetGLAlphaFunction(cfGEqual, 1.0);
1723
Enable(stAlphaTest);
1724
SetBlendFunc(bfDstColor, bfZero);
1725
SetGLAlphaFunction(cfGreater, 0);
1729
FBlendingParams.Apply(ARci);
1733
// Apply depth properties
1734
if not ARci.ignoreDepthRequests then
1735
FDepthProperties.Apply(ARci);
1738
if ARci.currentMaterialLevel = mlFixedFunction then
1740
if FTexProp.Enabled and FTexProp.IsValid then
1742
ARci.GLStates.ActiveTexture := 0;
1743
FTexProp.Apply(ARci);
1744
GL.TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE,
1745
cTextureMode[FTextureMode]);
1752
procedure TGLFixedFunctionProperties.Assign(Source: TPersistent);
1754
LFFP: TGLFixedFunctionProperties;
1756
if Source is TGLFixedFunctionProperties then
1758
LFFP := TGLFixedFunctionProperties(Source);
1759
if Assigned(LFFP.FBackProperties) then
1760
BackProperties.Assign(LFFP.BackProperties)
1762
FreeAndNil(FBackProperties);
1763
FFrontProperties.Assign(LFFP.FFrontProperties);
1764
FPolygonMode := LFFP.FPolygonMode;
1765
FBlendingMode := LFFP.FBlendingMode;
1766
FMaterialOptions := LFFP.FMaterialOptions;
1767
FFaceCulling := LFFP.FFaceCulling;
1768
FDepthProperties.Assign(LFFP.FDepthProperties);
1769
FTexProp.Assign(LFFP.FTexProp);
1770
FTextureMode := LFFP.TextureMode;
1776
function TGLFixedFunctionProperties.Blended: Boolean;
1778
Result := not (FBlendingMode in [bmOpaque, bmAlphaTest50, bmAlphaTest100, bmCustom]);
1781
constructor TGLFixedFunctionProperties.Create(AOwner: TPersistent);
1784
FFrontProperties := TGLFaceProperties.Create(Self);
1785
FFaceCulling := fcBufferDefault;
1786
FPolygonMode := pmFill;
1787
FBlendingParams := TGLBlendingParameters.Create(Self);
1788
FDepthProperties := TGLDepthProperties.Create(Self);
1789
FTexProp := TGLTextureProperties.Create(Self);
1790
FTextureMode := tmDecal;
1794
destructor TGLFixedFunctionProperties.Destroy;
1796
FFrontProperties.Destroy;
1797
FBackProperties.Free;
1798
FDepthProperties.Destroy;
1799
FBlendingParams.Destroy;
1804
function TGLFixedFunctionProperties.GetBackProperties: TGLFaceProperties;
1806
if not Assigned(FBackProperties) then
1807
FBackProperties := TGLFaceProperties.Create(Self);
1808
Result := FBackProperties;
1811
procedure TGLFixedFunctionProperties.SetBackProperties(AValues:
1814
BackProperties.Assign(AValues);
1818
procedure TGLFixedFunctionProperties.SetBlendingMode(const AValue:
1821
if AValue <> FBlendingMode then
1823
FBlendingMode := AValue;
1828
procedure TGLFixedFunctionProperties.SetBlendingParams(const AValue:
1829
TGLBlendingParameters);
1831
FBlendingParams.Assign(AValue);
1835
procedure TGLFixedFunctionProperties.SetDepthProperties(AValues:
1836
TGLDepthProperties);
1838
FDepthProperties.Assign(AValues);
1842
procedure TGLFixedFunctionProperties.SetTexProp(AValue: TGLTextureProperties);
1844
FTexProp.Assign(AValue);
1847
procedure TGLFixedFunctionProperties.SetTextureMode(AValue: TGLTextureMode);
1849
if AValue <> FTextureMode then
1851
FTextureMode := AValue;
1856
procedure TGLFixedFunctionProperties.SetFaceCulling(const AValue: TFaceCulling);
1858
if AValue <> FFaceCulling then
1860
FFaceCulling := AValue;
1865
procedure TGLFixedFunctionProperties.SetFrontProperties(AValues:
1868
FFrontProperties.Assign(AValues);
1872
procedure TGLFixedFunctionProperties.SetMaterialOptions(const AValue:
1875
if AValue <> FMaterialOptions then
1877
FMaterialOptions := AValue;
1882
procedure TGLFixedFunctionProperties.SetPolygonMode(AValue: TPolygonMode);
1884
if AValue <> FPolygonMode then
1886
FPolygonMode := AValue;
1891
procedure TGLFixedFunctionProperties.UnApply(var ARci: TGLRenderContextInfo);
1893
if FTexProp.Enabled and FTexProp.IsValid then
1894
FTexProp.UnApply(ARci);
1897
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}1899
{$IFDEF GLS_REGION}{$REGION 'TGLAbstractTexture'}{$ENDIF}1901
function TGLAbstractTexture.GetTextureTarget: TGLTextureTarget;
1903
Result := FHandle.Target;
1906
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}1908
{$IFDEF GLS_REGION}{$REGION 'TGLTextureImageEx'}{$ENDIF}1910
procedure TGLTextureImageEx.Apply(var ARci: TGLRenderContextInfo);
1915
with ARci.GLStates do
1917
TextureBinding[ActiveTexture, FHandle.Target] := FHandle.Handle;
1918
ActiveTextureEnabled[FHandle.Target] := True;
1921
if not IsDesignTime then
1923
if not FUseStreaming and Assigned(FImage) then
1926
if FApplyCounter > 16 then
1930
if FUseStreaming then
1936
else with ARci.GLStates do
1937
TextureBinding[ActiveTexture, FHandle.Target] := 0;
1940
procedure TGLTextureImageEx.Assign(Source: TPersistent);
1942
LTexture: TGLTextureImageEx;
1944
if Source is TGLTextureImageEx then
1946
LTexture := TGLTextureImageEx(Source);
1947
FCompression := LTexture.FCompression;
1948
if Assigned(LTexture.FImage) then
1950
if not Assigned(FImage) then
1951
FImage := TGLImage.Create;
1952
FImage.Assign(LTexture.FImage);
1956
FImageAlpha := LTexture.FImageAlpha;
1957
FImageBrightness := LTexture.FImageBrightness;
1958
FImageGamma := LTexture.FImageGamma;
1959
FHeightToNormalScale := LTexture.FHeightToNormalScale;
1960
FSourceFile := LTexture.FSourceFile;
1966
constructor TGLTextureImageEx.Create(AOwner: TGLXCollection);
1969
FDefferedInit := False;
1970
FHandle := TGLTextureHandle.Create;
1971
FHandle.OnPrapare := DoOnPrepare;
1972
FCompression := tcDefault;
1973
FImageAlpha := tiaDefault;
1974
FImageBrightness := 1.0;
1976
FHeightToNormalScale := 1.0;
1977
FInternalFormat := tfRGBA8;
1978
FInternallyStored := False;
1979
FMipGenMode := mgmOnFly;
1980
FUseStreaming := False;
1981
Name := TGLMatLibComponents(AOwner).MakeUniqueName('Texture');1984
destructor TGLTextureImageEx.Destroy;
1991
procedure TGLTextureImageEx.NotifyChange(Sender: TObject);
1993
FHandle.NotifyChangesOfData;
1997
procedure TGLTextureImageEx.DoOnPrepare(Sender: TGLContext);
1999
LTarget: TGLTextureTarget;
2002
if IsDesignTime and FDefferedInit then
2005
FHandle.AllocateHandle;
2006
if not FHandle.IsDataNeedUpdate then
2013
LTarget := FImage.GetTextureTarget;
2016
if not IsTargetSupported(LTarget)
2017
or not IsFormatSupported(FInternalFormat) then
2020
if (FHandle.Target <> LTarget)
2021
and (FHandle.Target <> ttNoShape) then
2023
FHandle.DestroyHandle;
2024
FHandle.AllocateHandle;
2026
FHandle.Target := LTarget;
2028
// Check streaming support
2029
if not IsDesignTime then
2031
FUseStreaming := FUseStreaming and TGLUnpackPBOHandle.IsSupported;
2032
FUseStreaming := FUseStreaming and IsServiceContextAvaible;
2033
FUseStreaming := FUseStreaming and (LTarget = ttTexture2D);
2036
with Sender.GLStates do
2038
ActiveTextureEnabled[FHandle.Target] := True;
2039
TextureBinding[ActiveTexture, FHandle.Target] := FHandle.Handle;
2040
UnpackRowLength := 0;
2041
UnpackSkipRows := 0;
2042
UnpackSkipPixels := 0;
2043
rowSize := FImage.LevelWidth[0] * FImage.ElementSize;
2044
if (rowSize mod 8 = 0) and (FImage.ElementSize > 4) then
2045
UnpackAlignment := 8
2047
if rowSize mod 4 = 0 then
2048
UnpackAlignment := 4
2049
else if rowSize mod 2 = 0 then
2050
UnpackAlignment := 2
2052
UnpackAlignment := 1;
2055
if not IsDesignTime and FUseStreaming then
2057
TFriendlyImage(FImage).StartStreaming;
2058
FLastTime := GLSTime;
2060
FHandle.NotifyDataUpdated;
2065
Sender.GLStates.ActiveTextureEnabled[FHandle.Target] := False;
2074
procedure TGLTextureImageEx.FullTransfer;
2076
LCompression: TGLTextureCompression;
2081
if ARB_texture_compression then
2083
if Compression = tcDefault then
2084
if vDefaultTextureCompression = tcDefault then
2085
LCompression := tcNone
2087
LCompression := vDefaultTextureCompression
2089
LCompression := Compression;
2092
LCompression := tcNone;
2094
if LCompression <> tcNone then
2095
with CurrentGLContext.GLStates do
2097
case LCompression of
2098
tcStandard: TextureCompressionHint := hintDontCare;
2099
tcHighQuality: TextureCompressionHint := hintNicest;
2100
tcHighSpeed: TextureCompressionHint := hintFastest;
2102
Assert(False, glsErrorEx + glsUnknownType);
2104
if not GetGenericCompressedFormat(
2108
glFormat := InternalFormatToOpenGLFormat(FInternalFormat);
2111
glFormat := InternalFormatToOpenGLFormat(FInternalFormat);
2113
FImage.RegisterAsOpenGLTexture(
2115
FMipGenMode = mgmOnFly,
2121
if GetError <> GL_NO_ERROR then
2124
CurrentGLContext.GLStates.ActiveTextureEnabled[FHandle.Target] := False;
2125
GLSLogger.LogErrorFmt('Unable to create texture "%s"', [Self.Name]);2129
FHandle.NotifyDataUpdated;
2133
procedure TGLTextureImageEx.CalcLODRange(out AFirstLOD, ALastLOD: Integer);
2135
I, MaxLODSize, MinLODSize, MaxLODZSize: Integer;
2137
case FHandle.Target of
2140
MaxLODSize := CurrentGLContext.GLStates.Max3DTextureSize;
2141
MaxLODZSize := MaxLODSize;
2146
MaxLODSize := CurrentGLContext.GLStates.MaxCubeTextureSize;
2153
ttTexture2DMultisampleArray:
2155
MaxLODSize := CurrentGLContext.GLStates.MaxTextureSize;
2156
MaxLODZSize := CurrentGLContext.GLStates.MaxArrayTextureSize;
2161
MaxLODSize := CurrentGLContext.GLStates.MaxTextureSize;
2170
for I := 0 to High(TGLImagePiramid) do
2172
if (FImage.LevelWidth[I] <= MaxLODSize)
2173
and (FImage.LevelHeight[I] <= MaxLODSize)
2174
and (FImage.LevelDepth[I] <= MaxLODZSize) then
2179
AFirstLOD := MinInteger(AFirstLOD, FImage.LevelCount - 1);
2180
ALastLOD := AFirstLOD;
2182
for I := AFirstLOD to High(TGLImagePiramid) do
2184
if (FImage.LevelWidth[I] < MinLODSize)
2185
or (FImage.LevelHeight[I] < MinLODSize) then
2189
ALastLOD := MinInteger(ALastLOD, FImage.LevelCount - 1);
2192
procedure TGLTextureImageEx.StreamTransfer;
2194
LImage: TFriendlyImage;
2195
bContinueStreaming: Boolean;
2196
OldBaseLevel, level: Integer;
2198
glInternalFormat: TGLEnum;
2199
transferMethod: 0..3;
2201
LImage := TFriendlyImage(FImage);
2202
OldBaseLevel := FBaseLevel;
2203
CalcLODRange(FBaseLevel, FMaxLevel);
2205
// Select transfer method
2206
if FImage.IsCompressed then
2209
transferMethod := 0;
2210
if GL.EXT_direct_state_access then
2211
transferMethod := transferMethod + 2;
2213
bContinueStreaming := False;
2214
for level := FMaxLevel downto FBaseLevel do
2217
case LImage.LevelStreamingState[level] of
2221
if FBaseLevel < Level then
2222
FBaseLevel := FMaxLevel;
2223
LImage.LevelStreamingState[Level] := ssLoading;
2225
bContinueStreaming := True;
2231
bContinueStreaming := True;
2232
if FBaseLevel < Level then
2233
FBaseLevel := FMaxLevel;
2239
LImage.LevelPixelBuffer[Level].AllocateHandle;
2240
LImage.LevelPixelBuffer[Level].Bind;
2241
glInternalFormat := InternalFormatToOpenGLFormat(FInternalFormat);
2242
case transferMethod of
2243
0: TexImage2D(GL_TEXTURE_2D, Level, glInternalFormat, FImage.LevelWidth[level], FImage.LevelHeight[level], 0, FImage.ColorFormat, FImage.DataType, nil);
2244
1: CompressedTexImage2D(GL_TEXTURE_2D, Level, glInternalFormat, FImage.LevelWidth[level], FImage.LevelHeight[level], 0, FImage.LevelSizeInByte[Level], nil);
2245
2: TextureImage2D(FHandle.Handle, GL_TEXTURE_2D, Level, glInternalFormat, FImage.LevelWidth[level], FImage.LevelHeight[level], 0, FImage.ColorFormat, FImage.DataType, nil);
2246
3: CompressedTextureImage2D(FHandle.Handle, GL_TEXTURE_2D, Level, glInternalFormat, FImage.LevelWidth[level], FImage.LevelHeight[level], 0, FImage.LevelSizeInByte[Level], nil);
2248
LImage.LevelPixelBuffer[Level].UnBind;
2249
LImage.LevelStreamingState[Level] := ssTransfered;
2250
GLSLogger.LogDebug(Format('Texture "%s" level %d loaded', [Name, Level]));2255
if LImage.LevelPixelBuffer[Level].IsAllocatedForContext then
2256
LImage.LevelPixelBuffer[Level].DestroyHandle;
2257
FBaseLevel := Level;
2261
if bContinueStreaming then
2265
if bContinueStreaming then
2268
TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAX_LEVEL, FMaxLevel);
2269
TexParameteri(GL_TEXTURE_2D, GL_TEXTURE_BASE_LEVEL, FBaseLevel);
2273
// Smooth transition between levels
2274
if Assigned(FApplicableSampler) then
2275
with FApplicableSampler do
2278
if FLODBiasFract > 0 then
2279
FLODBiasFract := FLODBiasFract - 0.05 * (newTime - FLastTime)
2280
else if FLODBiasFract < 0 then
2282
FLastTime := newTime;
2283
if OldBaseLevel > FBaseLevel then
2284
FLODBiasFract := FLODBiasFract + (OldBaseLevel - FBaseLevel);
2286
if FApplicableSampler.IsValid then
2287
GL.SamplerParameterf(FApplicableSampler.Handle.Handle,
2288
GL_TEXTURE_LOD_BIAS, FLODBias + FLODBiasFract)
2290
// To refrash texture parameters when sampler object not supported
2291
FLastSampler := nil;
2295
class function TGLTextureImageEx.FriendlyName: string;
2297
Result := 'Texture Image';
2300
procedure TGLTextureImageEx.PrepareImage;
2302
cAlphaProc: array[TGLTextureImageAlpha] of TImageAlphaProc =
2305
ImageAlphaFromIntensity,
2306
ImageAlphaSuperBlackTransparent,
2307
ImageAlphaLuminance,
2308
ImageAlphaLuminanceSqrt,
2310
ImageAlphaTopLeftPointColorTransparent,
2311
ImageAlphaInverseLuminance,
2312
ImageAlphaInverseLuminanceSqrt,
2313
ImageAlphaBottomRightPointColorTransparent
2317
ext, filename: string;
2318
BaseImageClass: TGLBaseImageClass;
2319
LPicture: TGLPicture;
2320
LGraphic: TGLGraphic;
2323
glColorFormat, glDataType: TGLEnum;
2324
bReadFromSource: Boolean;
2328
procedure ReplaceImageClass;
2330
if not (FImage is TGLImage) then
2332
LImage := TGLImage.Create;
2333
LImage.Assign(FImage);
2338
LImage := TGLImage(FImage);
2342
if not Assigned(FImage) then
2346
bReadFromSource := True;
2348
if FInternallyStored and not IsDesignTime then
2350
filename := Name+'.image';
2351
if FileStreamExists(filename) then
2353
FImage := TGLImage.Create;
2354
FImage.ResourceName := filename;
2355
TFriendlyImage(FImage).LoadHeader;
2356
if not FUseStreaming then
2358
ReallocMem(TFriendlyImage(FImage).fData, FImage.DataSize);
2359
for level := FImage.LevelCount - 1 downto 0 do
2361
LStream := CreateFileStream(filename + IntToHex(level, 2), fmOpenRead);
2362
ptr := PByte(TFriendlyImage(FImage).GetLevelAddress(level));
2363
LStream.Read(ptr^, FImage.LevelSizeInByte[level]);
2367
bReadFromSource := False;
2371
FInternallyStored := False;
2372
FUseStreaming := False;
2376
if bReadFromSource then
2378
if (Length(FSourceFile) > 0) and FileStreamExists(FSourceFile) then
2380
// At first check moder image file loaders
2381
ext := ExtractFileExt(FSourceFile);
2382
System.Delete(ext, 1, 1);
2383
BaseImageClass := GetRasterFileFormats.FindExt(ext);
2385
if Assigned(BaseImageClass) then
2387
FImage := BaseImageClass.Create;
2388
FImage.LoadFromFile(FSourceFile);
2392
// Check old loaders
2393
FImage := TGLImage.Create;
2394
if ApplicationFileIODefined then
2396
LGraphic := CreateGraphicFromFile(FSourceFile);
2397
FImage.Assign(LGraphic);
2402
LPicture := TGLPicture.Create;
2403
LPicture.LoadFromFile(FSourceFile);
2404
FImage.Assign(LPicture.Graphic);
2409
if FInternalFormat <> FImage.InternalFormat then
2412
FindCompatibleDataFormat(FInternalFormat, glColorFormat, glDataType);
2413
TGLImage(FImage).SetColorFormatDataType(glColorFormat, glDataType);
2414
TFriendlyImage(FImage).fInternalFormat := FInternalFormat;
2417
if (ImageAlpha <> tiaDefault)
2418
or (FImageBrightness <> 1.0)
2419
or (FImageGamma <> 1.0) then
2422
for level := 0 to FImage.LevelCount - 1 do
2424
AlphaGammaBrightCorrection(
2425
TFriendlyImage(FImage).GetLevelAddress(level),
2428
FImage.LevelWidth[level],
2429
FImage.LevelHeight[level],
2430
cAlphaProc[ImageAlpha],
2435
else if FHeightToNormalScale <> 1.0 then
2438
// HeightToNormalMap();
2439
{$Message Hint 'TGLTextureImageEx.HeightToNormalScale not yet implemented' }2446
mgmLeaveExisting, mgmOnFly: ;
2449
FImage.GenerateMipmap(ImageBoxFilter);
2452
FImage.GenerateMipmap(ImageTriangleFilter);
2455
FImage.GenerateMipmap(ImageHermiteFilter);
2458
FImage.GenerateMipmap(ImageBellFilter);
2461
FImage.GenerateMipmap(ImageSplineFilter);
2464
FImage.GenerateMipmap(ImageLanczos3Filter);
2467
FImage.GenerateMipmap(ImageMitchellFilter);
2470
// Store cooked image
2471
if FInternallyStored and IsDesignTime then
2473
filename := Name+'.image';
2474
FImage.ResourceName := filename;
2475
TFriendlyImage(FImage).SaveHeader;
2476
for level := FImage.LevelCount - 1 downto 0 do
2478
LStream := CreateFileStream(filename + IntToHex(level, 2),
2479
fmOpenWrite or fmCreate);
2480
ptr := PByte(TFriendlyImage(FImage).GetLevelAddress(level));
2481
LStream.Write(ptr^, FImage.LevelSizeInByte[level]);
2488
begin // no SourceFile
2489
FImage := TGLImage.Create;
2490
FImage.SetErrorImage;
2491
GLSLogger.LogErrorFmt('Source file of texture "%s" image not found',2494
end; // if bReadFromSource
2500
FImage := TGLImage.Create;
2501
FImage.SetErrorImage;
2502
if IsDesignTime then
2503
InformationDlg(Self.Name + ' - ' + E.ClassName + ': ' + E.Message)
2505
GLSLogger.LogError(Self.Name + ' - ' + E.ClassName + ': ' +
2509
end; // of not Assigned
2512
procedure TGLTextureImageEx.ReadFromFiler(AReader: TReader);
2514
archiveVersion: Integer;
2518
archiveVersion := ReadInteger;
2519
if archiveVersion = 0 then
2521
Name := ReadWideString;
2522
FDefferedInit := ReadBoolean;
2523
FInternalFormat := TGLInternalFormat(ReadInteger);
2524
FCompression := TGLTextureCompression(ReadInteger);
2525
FImageAlpha := TGLTextureImageAlpha(ReadInteger);
2526
FImageBrightness := ReadFloat;
2527
FImageBrightness := ReadFloat;
2528
FImageGamma := ReadFloat;
2529
FHeightToNormalScale := ReadFloat;
2530
FSourceFile := ReadWideString;
2531
FInternallyStored := ReadBoolean;
2532
FMipGenMode := TMipmapGenerationMode(ReadInteger);
2533
FUseStreaming := ReadBoolean;
2536
RaiseFilerException(archiveVersion);
2540
procedure TGLTextureImageEx.SetCompression(const AValue: TGLTextureCompression);
2542
if AValue <> FCompression then
2544
FCompression := AValue;
2549
procedure TGLTextureImageEx.SetImageAlpha(const AValue: TGLTextureImageAlpha);
2551
if FImageAlpha <> AValue then
2553
FImageAlpha := AValue;
2559
procedure TGLTextureImageEx.SetImageBrightness(const AValue: Single);
2561
if FImageBrightness <> AValue then
2563
FImageBrightness := AValue;
2569
procedure TGLTextureImageEx.SetImageGamma(const AValue: Single);
2571
if FImageGamma <> AValue then
2573
FImageGamma := AValue;
2579
procedure TGLTextureImageEx.SetInternalFormat(const AValue: TGLInternalFormat);
2581
if AValue <> FInternalFormat then
2583
FInternalFormat := AValue;
2589
procedure TGLTextureImageEx.SetInternallyStored(const AValue: Boolean);
2591
if FInternallyStored <> AValue then
2593
FInternallyStored := AValue;
2595
FUseStreaming := AValue
2602
procedure TGLTextureImageEx.SetMipGenMode(const AValue: TMipmapGenerationMode);
2604
if FMipGenMode <> AValue then
2606
FMipGenMode := AValue;
2612
procedure TGLTextureImageEx.SetNormalMapScale(const AValue: Single);
2614
if AValue <> FHeightToNormalScale then
2616
FHeightToNormalScale := AValue;
2621
procedure TGLTextureImageEx.SetSourceFile(AValue: string);
2623
FixPathDelimiter(AValue);
2624
if FSourceFile <> AValue then
2626
FSourceFile := AValue;
2627
FUseStreaming := False;
2633
procedure TGLTextureImageEx.SetUseStreaming(const AValue: Boolean);
2635
if AValue <> FUseStreaming then
2639
if not Assigned(FImage) then
2641
if FImage.LevelCount = 1 then
2643
if IsDesignTime then
2644
InformationDlg('Image must be more than one level');2647
FInternallyStored := True;
2649
FUseStreaming := AValue;
2654
function TGLTextureImageEx.StoreBrightness: Boolean;
2656
Result := (FImageBrightness <> 1.0);
2659
function TGLTextureImageEx.StoreGamma: Boolean;
2661
Result := (FImageGamma <> 1.0);
2664
function TGLTextureImageEx.StoreNormalMapScale: Boolean;
2666
Result := (FHeightToNormalScale <> cDefaultNormalMapScale);
2669
procedure TGLTextureImageEx.UnApply(var ARci: TGLRenderContextInfo);
2671
ARci.GLStates.ActiveTextureEnabled[FHandle.Target] := False;
2674
procedure TGLTextureImageEx.WriteToFiler(AWriter: TWriter);
2678
WriteInteger(0); // archive version
2680
WriteBoolean(FDefferedInit);
2681
WriteInteger(Integer(FInternalFormat));
2682
WriteInteger(Integer(FCompression));
2683
WriteInteger(Integer(FImageAlpha));
2684
WriteFloat(FImageBrightness);
2685
WriteFloat(FImageBrightness);
2686
WriteFloat(FImageGamma);
2687
WriteFloat(FHeightToNormalScale);
2688
WriteString(FSourceFile);
2689
WriteBoolean(FInternallyStored);
2690
WriteInteger(Integer(FMipGenMode));
2691
WriteBoolean(FUseStreaming);
2695
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}2697
{$IFDEF GLS_REGION}{$REGION 'TGLTextureSampler'}{$ENDIF}2699
procedure TGLTextureSampler.Apply(var ARci: TGLRenderContextInfo);
2702
ARci.GLStates.SamplerBinding[ARci.GLStates.ActiveTexture] := FHandle.Handle;
2705
procedure TGLTextureSampler.Assign(Source: TPersistent);
2707
LSampler: TGLTextureSampler;
2709
if Source is TGLTextureSampler then
2711
LSampler := TGLTextureSampler(Source);
2712
FMinFilter := LSampler.FMinFilter;
2713
FMagFilter := LSampler.FMagFilter;
2714
FFilteringQuality := LSampler.FFilteringQuality;
2715
FLODBias := LSampler.FLODBias;
2717
FBorderColor.Assign(LSampler.FBorderColor);
2718
FWrap := LSampler.FWrap;
2719
FCompareMode := LSampler.FCompareMode;
2720
FCompareFunc := LSampler.FCompareFunc;
2721
FDecodeSRGB := LSampler.FDecodeSRGB;
2727
constructor TGLTextureSampler.Create(AOwner: TGLXCollection);
2730
FDefferedInit := False;
2731
FHandle := TGLSamplerHandle.Create;
2732
FHandle.OnPrapare := DoOnPrepare;
2733
FMagFilter := maLinear;
2734
FMinFilter := miLinearMipMapLinear;
2735
FFilteringQuality := tfAnisotropic;
2738
FWrap[0] := twRepeat;
2739
FWrap[1] := twRepeat;
2740
FWrap[2] := twRepeat;
2741
FBorderColor := TGLColor.CreateInitialized(Self, clrTransparent);
2742
FCompareMode := tcmNone;
2743
FCompareFunc := cfLequal;
2744
FDecodeSRGB := True;
2745
Name := TGLMatLibComponents(AOwner).MakeUniqueName('Sampler');2748
destructor TGLTextureSampler.Destroy;
2751
FBorderColor.Destroy;
2755
function TGLTextureSampler.GetWrap(Index: Integer): TGLSeparateTextureWrap;
2757
Result := FWrap[Index];
2760
procedure TGLTextureSampler.NotifyChange(Sender: TObject);
2762
FHandle.NotifyChangesOfData;
2766
procedure TGLTextureSampler.DoOnPrepare(Sender: TGLContext);
2770
if IsDesignTime and FDefferedInit then
2773
if FHandle.IsSupported then
2775
FHandle.AllocateHandle;
2776
ID := FHandle.Handle;
2777
if FHandle.IsDataNeedUpdate then
2780
SamplerParameterfv(ID, GL_TEXTURE_BORDER_COLOR,
2781
FBorderColor.AsAddress);
2782
SamplerParameteri(ID, GL_TEXTURE_WRAP_S, cTextureWrapMode[FWrap[0]]);
2783
SamplerParameteri(ID, GL_TEXTURE_WRAP_T, cTextureWrapMode[FWrap[1]]);
2784
SamplerParameteri(ID, GL_TEXTURE_WRAP_R, cTextureWrapMode[FWrap[2]]);
2785
SamplerParameterf(ID, GL_TEXTURE_LOD_BIAS, FLODBias + FLODBiasFract);
2786
SamplerParameteri(ID, GL_TEXTURE_MIN_FILTER,
2787
cTextureMinFilter[FMinFilter]);
2788
SamplerParameteri(ID, GL_TEXTURE_MAG_FILTER,
2789
cTextureMagFilter[FMagFilter]);
2791
if EXT_texture_filter_anisotropic then
2793
if FFilteringQuality = tfAnisotropic then
2794
SamplerParameteri(ID, GL_TEXTURE_MAX_ANISOTROPY_EXT,
2795
CurrentGLContext.GLStates.MaxTextureAnisotropy)
2797
SamplerParameteri(ID, GL_TEXTURE_MAX_ANISOTROPY_EXT, 1);
2800
SamplerParameteri(ID, GL_TEXTURE_COMPARE_MODE,
2801
cTextureCompareMode[FCompareMode]);
2802
SamplerParameteri(ID, GL_TEXTURE_COMPARE_FUNC,
2803
cGLComparisonFunctionToGLEnum[FCompareFunc]);
2805
if EXT_texture_sRGB_decode then
2808
SamplerParameteri(ID, GL_TEXTURE_SRGB_DECODE_EXT, GL_DECODE_EXT)
2810
SamplerParameteri(ID, GL_TEXTURE_SRGB_DECODE_EXT,
2811
GL_SKIP_DECODE_EXT);
2813
{$IFDEF GLS_OPENGL_DEBUG}2817
FHandle.NotifyDataUpdated;
2829
class function TGLTextureSampler.FriendlyName: string;
2831
Result := 'Texture Sampler';
2834
procedure TGLTextureSampler.ReadFromFiler(AReader: TReader);
2836
archiveVersion: Integer;
2840
archiveVersion := ReadInteger;
2841
if archiveVersion = 0 then
2843
Name := ReadWideString;
2844
FDefferedInit := ReadBoolean;
2845
FMinFilter := TGLMinFilter(ReadInteger);
2846
FMagFilter := TGLMagFilter(ReadInteger);
2847
FFilteringQuality := TGLTextureFilteringQuality(ReadInteger);
2848
FLODBias := ReadInteger;
2849
FWrap[0] := TGLSeparateTextureWrap(ReadInteger);
2850
FWrap[1] := TGLSeparateTextureWrap(ReadInteger);
2851
FWrap[2] := TGLSeparateTextureWrap(ReadInteger);
2852
Read(FBorderColor.AsAddress^, SizeOf(TColorVector));
2853
FCompareMode := TGLTextureCompareMode(ReadInteger);
2854
FCompareFunc := TDepthFunction(ReadInteger);
2855
FDecodeSRGB := ReadBoolean;
2858
RaiseFilerException(archiveVersion);
2862
procedure TGLTextureSampler.SetBorderColor(const AValue: TGLColor);
2864
FBorderColor.Assign(AValue);
2868
procedure TGLTextureSampler.SetCompareFunc(AValue: TDepthFunction);
2870
if FCompareFunc <> AValue then
2872
FCompareFunc := AValue;
2877
procedure TGLTextureSampler.SetCompareMode(AValue: TGLTextureCompareMode);
2879
if FCompareMode <> AValue then
2881
FCompareMode := AValue;
2886
procedure TGLTextureSampler.SetDecodeSRGB(AValue: Boolean);
2888
if FDecodeSRGB <> AValue then
2890
FDecodeSRGB := AValue;
2895
procedure TGLTextureSampler.SetFilteringQuality(
2896
AValue: TGLTextureFilteringQuality);
2898
if FFilteringQuality <> AValue then
2900
FFilteringQuality := AValue;
2905
procedure TGLTextureSampler.SetLODBias(AValue: Integer);
2907
if FLODBias <> AValue then
2914
procedure TGLTextureSampler.SetMagFilter(AValue: TGLMagFilter);
2916
if FMagFilter <> AValue then
2918
FMagFilter := AValue;
2923
procedure TGLTextureSampler.SetMinFilter(AValue: TGLMinFilter);
2925
if FMinFilter <> AValue then
2927
FMinFilter := AValue;
2932
procedure TGLTextureSampler.SetWrap(Index: Integer;
2933
AValue: TGLSeparateTextureWrap);
2935
if FWrap[Index] <> AValue then
2937
FWrap[Index] := AValue;
2942
procedure TGLTextureSampler.UnApply(var ARci: TGLRenderContextInfo);
2944
if FHandle.IsSupported then
2945
with ARci.GLStates do
2946
SamplerBinding[ActiveTexture] := 0;
2949
procedure TGLTextureSampler.WriteToFiler(AWriter: TWriter);
2953
WriteInteger(0); // archive version
2954
WriteWideString(Name);
2955
WriteBoolean(FDefferedInit);
2956
WriteInteger(Integer(FMinFilter));
2957
WriteInteger(Integer(FMagFilter));
2958
WriteInteger(Integer(FFilteringQuality));
2959
WriteInteger(FLODBias);
2960
WriteInteger(Integer(FWrap[0]));
2961
WriteInteger(Integer(FWrap[1]));
2962
WriteInteger(Integer(FWrap[2]));
2963
Write(FBorderColor.AsAddress^, SizeOf(TColorVector));
2964
WriteInteger(Integer(FCompareMode));
2965
WriteInteger(Integer(FCompareFunc));
2966
WriteBoolean(FDecodeSRGB);
2970
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}2972
{$IFDEF GLS_REGION}{$REGION 'TGLTextureCombiner'}{$ENDIF}2974
procedure TGLTextureCombiner.Assign(Source: TPersistent);
2976
LCombiner: TGLTextureCombiner;
2978
if Source is TGLTextureCombiner then
2980
LCombiner := TGLTextureCombiner(Source);
2981
FScript.Assign(LCombiner.FScript);
2986
constructor TGLTextureCombiner.Create(AOwner: TGLXCollection);
2989
FDefferedInit := False;
2990
FHandle := TGLVirtualHandle.Create;
2991
FHandle.OnAllocate := DoAllocate;
2992
FHandle.OnDestroy := DoDeallocate;
2993
FHandle.OnPrapare := DoOnPrepare;
2994
FScript := TStringList.Create;
2995
FScript.OnChange := NotifyChange;
2997
Name := TGLMatLibComponents(AOwner).MakeUniqueName('Combiner');3000
destructor TGLTextureCombiner.Destroy;
3007
procedure TGLTextureCombiner.NotifyChange(Sender: TObject);
3009
FHandle.NotifyChangesOfData;
3013
procedure TGLTextureCombiner.DoAllocate(Sender: TGLVirtualHandle;
3014
var handle: TGLUint);
3019
procedure TGLTextureCombiner.DoDeallocate(Sender: TGLVirtualHandle;
3020
var handle: TGLUint);
3025
procedure TGLTextureCombiner.DoOnPrepare(Sender: TGLContext);
3027
if IsDesignTime and FDefferedInit then
3029
if Sender.GL.ARB_multitexture then
3031
FHandle.AllocateHandle;
3032
if FHandle.IsDataNeedUpdate then
3035
FCommandCache := GetTextureCombiners(FScript);
3041
if IsDesignTime then
3042
InformationDlg(E.ClassName + ': ' + E.Message)
3044
GLSLogger.LogError(E.ClassName + ': ' + E.Message);
3047
FHandle.NotifyDataUpdated;
3054
class function TGLTextureCombiner.FriendlyName: string;
3056
Result := 'Texture Combiner';
3059
procedure TGLTextureCombiner.ReadFromFiler(AReader: TReader);
3061
archiveVersion: Integer;
3065
archiveVersion := ReadInteger;
3066
if archiveVersion = 0 then
3068
Name := ReadWideString;
3069
FDefferedInit := ReadBoolean;
3070
FScript.Text := ReadWideString;
3073
RaiseFilerException(archiveVersion);
3077
procedure TGLTextureCombiner.SetScript(AValue: TStringList);
3079
FScript.Assign(AValue);
3083
procedure TGLTextureCombiner.WriteToFiler(AWriter: TWriter);
3087
WriteInteger(0); // archive version
3088
WriteWideString(Name);
3089
WriteBoolean(FDefferedInit);
3090
WriteWideString(FScript.Text);
3094
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}3096
{$IFDEF GLS_REGION}{$REGION 'TGLLibMaterialEx'}{$ENDIF}3098
procedure TGLLibMaterialEx.Apply(var ARci: TGLRenderContextInfo);
3100
LevelReady: array[TGLMaterialLevel] of Boolean;
3101
L, MaxLevel: TGLMaterialLevel;
3103
if Assigned(FNextPass) then
3109
FHandle.AllocateHandle;
3110
if FHandle.IsDataNeedUpdate then
3112
// Other value than mlAuto indicates a level failure
3113
// Need remove deffered initialization and reinitialize used resources
3114
if not IsDesignTime and (FSelectedLevel <> mlAuto) then
3117
LevelReady[mlFixedFunction] := FFixedFunc.Enabled;
3118
LevelReady[mlMultitexturing] := FMultitexturing.Enabled and
3119
FMultitexturing.IsValid;
3120
LevelReady[mlSM3] := FSM3.Enabled and FSM3.IsValid;
3121
LevelReady[mlSM4] := FSM4.Enabled and FSM4.IsValid;
3122
LevelReady[mlSM5] := FSM5.Enabled and FSM5.IsValid;
3124
if FApplicableLevel = mlAuto then
3127
MaxLevel := FApplicableLevel;
3129
FSelectedLevel := mlAuto;
3130
for L := MaxLevel downto mlFixedFunction do
3131
if LevelReady[L] then
3133
FSelectedLevel := L;
3137
FStoreAmalgamating := ARci.amalgamating;
3138
ARci.amalgamating := True;
3139
FHandle.NotifyDataUpdated;
3142
ARci.currentMaterialLevel := FSelectedLevel;
3144
case FSelectedLevel of
3145
mlAuto: ; // No one level can be used. Worst case.
3149
FFixedFunc.Apply(ARci);
3154
if LevelReady[mlFixedFunction] then
3155
FFixedFunc.Apply(ARci);
3156
FMultitexturing.Apply(ARci);
3161
if LevelReady[mlFixedFunction] then
3162
FFixedFunc.Apply(ARci);
3168
if LevelReady[mlFixedFunction] then
3169
FFixedFunc.Apply(ARci);
3175
if LevelReady[mlFixedFunction] then
3176
FFixedFunc.Apply(ARci);
3182
procedure TGLLibMaterialEx.Assign(Source: TPersistent);
3184
LMaterial: TGLLibMaterialEx;
3186
if Source is TGLLibMaterialEx then
3188
LMaterial := TGLLibMaterialEx(Source);
3189
FFixedFunc.Assign(LMaterial.FFixedFunc);
3190
FMultitexturing.Assign(LMaterial.FMultitexturing);
3191
FSM3.Assign(LMaterial.FSM3);
3192
FSM4.Assign(LMaterial.FSM4);
3193
FSM5.Assign(LMaterial.FSM5);
3194
FApplicableLevel := LMaterial.FApplicableLevel;
3200
function TGLLibMaterialEx.Blended: Boolean;
3202
Result := FFixedFunc.Blended;
3205
constructor TGLLibMaterialEx.Create(ACollection: TCollection);
3208
FHandle := TGLVirtualHandle.Create;
3209
FHandle.OnAllocate := DoAllocate;
3210
FHandle.OnDestroy := DoDeallocate;
3211
FHandle.OnPrapare := DoOnPrepare;
3212
FApplicableLevel := mlAuto;
3213
FSelectedLevel := mlAuto;
3214
FFixedFunc := TGLFixedFunctionProperties.Create(Self);
3215
FMultitexturing := TGLMultitexturingProperties.Create(Self);
3216
FSM3 := TGLShaderModel3.Create(Self);
3217
FSM4 := TGLShaderModel4.Create(Self);
3218
FSM5 := TGLShaderModel5.Create(Self);
3222
TGLFreindlyMaterial = class(TGLMaterial);
3224
destructor TGLLibMaterialEx.Destroy;
3231
FMultitexturing.Destroy;
3235
for I := 0 to FUserList.Count - 1 do
3237
LUser := TObject(FUserList[i]);
3238
if LUser is TGLMaterial then
3239
TGLFreindlyMaterial(LUser).NotifyLibMaterialDestruction;
3244
procedure TGLLibMaterialEx.DoAllocate(Sender: TGLVirtualHandle;
3245
var handle: TGLUint);
3250
procedure TGLLibMaterialEx.DoDeallocate(Sender: TGLVirtualHandle;
3251
var handle: TGLUint);
3256
procedure TGLLibMaterialEx.DoOnPrepare(Sender: TGLContext);
3260
procedure TGLLibMaterialEx.Loaded;
3262
FFixedFunc.FTexProp.Loaded;
3263
FMultitexturing.Loaded;
3269
procedure TGLLibMaterialEx.NotifyChange(Sender: TObject);
3272
FHandle.NotifyChangesOfData;
3275
procedure TGLLibMaterialEx.RemoveDefferedInit;
3280
if FFixedFunc.FTexProp.Enabled then
3282
if Assigned(FFixedFunc.FTexProp.FLibTexture) then
3283
FFixedFunc.FTexProp.FLibTexture.FDefferedInit := False;
3284
if Assigned(FFixedFunc.FTexProp.FLibSampler) then
3285
FFixedFunc.FTexProp.FLibSampler.FDefferedInit := False;
3288
if FMultitexturing.Enabled then
3290
if Assigned(FMultitexturing.FLibCombiner) then
3292
FMultitexturing.FLibCombiner.FDefferedInit := False;
3294
if Assigned(FMultitexturing.FTexProps[I]) then
3295
with FMultitexturing.FTexProps[I] do
3297
if Assigned(FLibTexture) then
3298
FLibTexture.FDefferedInit := False;
3299
if Assigned(FLibSampler) then
3300
FLibSampler.FDefferedInit := False;
3305
if FSM3.Enabled then
3307
for ST := Low(TGLShaderType) to High(TGLShaderType) do
3308
if Assigned(FSM3.FShaders[ST]) then
3309
FSM3.FShaders[ST].FDefferedInit := False;
3312
if FSM4.Enabled then
3314
for ST := Low(TGLShaderType) to High(TGLShaderType) do
3315
if Assigned(FSM4.FShaders[ST]) then
3316
FSM4.FShaders[ST].FDefferedInit := False;
3319
if FSM5.Enabled then
3321
for ST := Low(TGLShaderType) to High(TGLShaderType) do
3322
if Assigned(FSM5.FShaders[ST]) then
3323
FSM5.FShaders[ST].FDefferedInit := False;
3326
CurrentGLContext.PrepareHandlesData;
3329
procedure TGLLibMaterialEx.SetMultitexturing(AValue:
3330
TGLMultitexturingProperties);
3332
FMultitexturing.Assign(AValue);
3335
procedure TGLLibMaterialEx.SetFixedFunc(AValue: TGLFixedFunctionProperties);
3337
FFixedFunc.Assign(AValue);
3340
procedure TGLLibMaterialEx.SetLevel(AValue: TGLMaterialLevel);
3342
if FApplicableLevel <> AValue then
3344
FApplicableLevel := AValue;
3349
procedure TGLLibMaterialEx.SetSM3(AValue: TGLShaderModel3);
3351
FSM3.Assign(AValue);
3354
procedure TGLLibMaterialEx.SetSM4(AValue: TGLShaderModel4);
3356
FSM4.Assign(AValue);
3359
procedure TGLLibMaterialEx.SetSM5(AValue: TGLShaderModel5);
3361
FSM5.Assign(AValue);
3364
function TGLLibMaterialEx.UnApply(var ARci: TGLRenderContextInfo): Boolean;
3366
procedure GetNextPass(AProp: TGLLibMaterialProperty);
3368
if Length(AProp.NextPass) > 0 then
3370
TGLMaterialLibraryEx(GetMaterialLibrary).Materials.GetLibMaterialByName(AProp.NextPass)
3374
if FNextPass = Self then
3376
AProp.NextPass := '';
3382
if FStoreAmalgamating <> ARci.amalgamating then
3383
ARci.amalgamating := FStoreAmalgamating;
3385
if Assigned(FNextPass) then
3387
Result := FNextPass.UnApply(ARci);
3389
FNextPass.Apply(ARci)
3395
case FSelectedLevel of
3398
FFixedFunc.UnApply(ARci);
3399
GetNextPass(FFixedFunc);
3404
if FFixedFunc.Enabled then
3405
FFixedFunc.UnApply(ARci);
3406
FMultitexturing.UnApply(ARci);
3407
GetNextPass(FMultitexturing);
3412
if FFixedFunc.Enabled then
3413
FFixedFunc.UnApply(ARci);
3420
if FFixedFunc.Enabled then
3421
FFixedFunc.UnApply(ARci);
3428
if FFixedFunc.Enabled then
3429
FFixedFunc.UnApply(ARci);
3436
ARci.GLStates.ActiveTexture := 0;
3438
Result := Assigned(FNextPass);
3440
FNextPass.Apply(ARCi);
3443
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}3445
{$IFDEF GLS_REGION}{$REGION 'TGLMultitexturingProperties'}{$ENDIF}3447
procedure TGLMultitexturingProperties.Apply(var ARci: TGLRenderContextInfo);
3454
if Assigned(FLibCombiner) and not FLibCombiner.FIsValid then
3456
if Assigned(FLibAsmProg) and not FLibAsmProg.FIsValid then
3460
for N := 0 to High(FTexProps) do
3462
if Assigned(FTexProps[N]) and FTexProps[N].Enabled then
3464
ARci.GLStates.ActiveTexture := N;
3465
FTexProps[N].Apply(ARci);
3466
if Ord(FLightDir) = N+1 then
3468
LDir := ARci.GLStates.LightPosition[FLightSourceIndex];
3469
LDir := VectorTransform(LDir, ARci.PipelineTransformation.InvModelMatrix);
3470
NormalizeVector(LDir);
3471
GL.TexEnvfv(GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, @LDir);
3473
U := U or (1 shl N);
3477
if Assigned(FLibAsmProg) then
3479
FLibAsmProg.Handle.Bind;
3480
GL.Enable(GL_VERTEX_PROGRAM_ARB);
3481
if Assigned(GetMaterial.FOnAsmProgSetting) then
3482
GetMaterial.FOnAsmProgSetting(Self.FLibAsmProg, ARci);
3485
with GL, ARci.GLStates do
3487
if Assigned(FLibCombiner) and (Length(FLibCombiner.FCommandCache) > 0)
3490
for N := 0 to High(FLibCombiner.FCommandCache) do
3492
ActiveTexture := FLibCombiner.FCommandCache[N].ActiveUnit;
3493
TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE);
3494
TexEnvi(GL_TEXTURE_ENV,
3495
FLibCombiner.FCommandCache[N].Arg1,
3496
FLibCombiner.FCommandCache[N].Arg2);
3499
TexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, cTextureMode[FTextureMode]);
3506
XGL.MapTexCoordToArbitrary(U)
3507
else if (FTexProps[0].Enabled)
3508
and (FTexProps[0].MappingMode = tmmUser) then
3509
if FTexProps[1].MappingMode = tmmUser then
3510
XGL.MapTexCoordToDual
3512
XGL.MapTexCoordToMain
3513
else if FTexProps[1].MappingMode = tmmUser then
3514
XGL.MapTexCoordToSecond
3516
XGL.MapTexCoordToMain;
3522
constructor TGLMultitexturingProperties.Create(AOwner: TPersistent);
3526
FTextureMode := tmDecal;
3527
FLightDir := l2eNone;
3528
FLightSourceIndex := 0;
3531
destructor TGLMultitexturingProperties.Destroy;
3533
if Assigned(FLibCombiner) then
3534
FLibCombiner.UnregisterUser(Self);
3535
if Assigned(FLibAsmProg) then
3536
FLibAsmProg.UnregisterUser(Self);
3544
function TGLMultitexturingProperties.GetLibCombinerName: string;
3546
if Assigned(FLibCombiner) then
3547
Result := FLibCombiner.Name
3552
function TGLMultitexturingProperties.GetLibAsmProgName: string;
3554
if Assigned(FLibAsmProg) then
3555
Result := FLibAsmProg.Name
3560
function TGLMultitexturingProperties.IsValid: Boolean;
3565
if Assigned(FLibCombiner) then
3566
Result := Result and FLibCombiner.IsValid;
3567
if Assigned(FLibAsmProg) then
3568
Result := Result and FLibAsmProg.IsValid;
3569
for I := 0 to High(FTexProps) do
3570
if Assigned(FTexProps[I]) and FTexProps[I].FEnabled then
3571
Result := Result and FTexProps[I].IsValid;
3574
procedure TGLMultitexturingProperties.Loaded;
3578
SetLibCombinerName(FLibCombinerName);
3579
SetLibAsmProgName(FLibAsmProgName);
3580
for I := 0 to High(FTexProps) do
3581
if Assigned(FTexProps[I]) then
3582
FTexProps[I].Loaded;
3585
procedure TGLMultitexturingProperties.Notification(Sender: TObject; Operation:
3588
if Operation = opRemove then
3590
if Sender = FLibCombiner then
3591
FLibCombiner := nil;
3592
if Sender = FLibAsmProg then
3598
procedure TGLMultitexturingProperties.SetLibCombinerName(const AValue: string);
3600
LCombiner: TGLTextureCombiner;
3602
if csLoading in GetMaterialLibraryEx.ComponentState then
3604
FLibCombinerName := AValue;
3608
if Assigned(FLibCombiner) then
3610
if FLibCombiner.Name = AValue then
3612
FLibCombiner.UnregisterUser(Self);
3613
FLibCombiner := nil;
3615
LCombiner := GetMaterialLibraryEx.Components.GetCombinerByName(AValue);
3616
if Assigned(LCombiner) then
3618
LCombiner.RegisterUser(Self);
3619
FLibCombiner := LCombiner;
3624
procedure TGLMultitexturingProperties.SetLightSourceIndex(AValue: Integer);
3628
else if AValue > 7 then
3630
FLightSourceIndex := AValue;
3633
procedure TGLMultitexturingProperties.SetLibAsmProgName(const AValue: string);
3635
LProg: TGLASMVertexProgram;
3637
if csLoading in GetMaterialLibraryEx.ComponentState then
3639
FLibAsmProgName := AValue;
3643
if Assigned(FLibAsmProg) then
3645
if FLibAsmProg.Name = AValue then
3647
FLibAsmProg.UnregisterUser(Self);
3650
LProg := GetMaterialLibraryEx.Components.GetAsmProgByName(AValue);
3651
if Assigned(LProg) then
3653
LProg.RegisterUser(Self);
3654
FLibAsmProg := LProg;
3659
function TGLMultitexturingProperties.GetTexProps(AIndex: Integer):
3660
TGLTextureProperties;
3662
if not Assigned(FTexProps[AIndex]) then
3663
FTexProps[AIndex] := TGLTextureProperties.Create(Self);
3664
Result := FTexProps[AIndex];
3667
procedure TGLMultitexturingProperties.SetTexProps(AIndex: Integer;
3668
AValue: TGLTextureProperties);
3670
FTexProps[AIndex].Assign(AValue);
3673
procedure TGLMultitexturingProperties.SetTextureMode(AValue: TGLTextureMode);
3675
if AValue <> FTextureMode then
3677
FTextureMode := AValue;
3682
procedure TGLMultitexturingProperties.UnApply(var ARci: TGLRenderContextInfo);
3686
for N := 0 to High(FTexProps) do
3688
if FTexProps[N].Enabled then
3690
ARci.GLStates.ActiveTexture := N;
3691
FTexProps[N].UnApply(ARci);
3694
ARci.GLStates.ActiveTexture := 0;
3696
if Assigned(FLibAsmProg) then
3697
GL.Disable(GL_VERTEX_PROGRAM_ARB);
3700
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}3702
{$IFDEF GLS_REGION}{$REGION 'TGLTextureProperties'}{$ENDIF}3704
procedure TGLTextureProperties.Apply(var ARci: TGLRenderContextInfo);
3708
if Assigned(FLibTexture) then
3711
FLibTexture.FApplicableSampler := FLibSampler;
3712
FLibTexture.Apply(ARci);
3714
// Apply swizzling if possible
3715
glTarget := DecodeGLTextureTarget(FLibTexture.Shape);
3716
if ARB_texture_swizzle or EXT_texture_swizzle then
3718
if FSwizzling.FSwizzles[0] <> FLibTexture.FSwizzles[0] then
3720
FLibTexture.FSwizzles[0] := FSwizzling.FSwizzles[0];
3721
TexParameteri(glTarget, GL_TEXTURE_SWIZZLE_R,
3722
cTextureSwizzle[FSwizzling.FSwizzles[0]]);
3724
if FSwizzling.FSwizzles[1] <> FLibTexture.FSwizzles[1] then
3726
FLibTexture.FSwizzles[1] := FSwizzling.FSwizzles[1];
3727
TexParameteri(glTarget, GL_TEXTURE_SWIZZLE_G,
3728
cTextureSwizzle[FSwizzling.FSwizzles[1]]);
3730
if FSwizzling.FSwizzles[2] <> FLibTexture.FSwizzles[2] then
3732
FLibTexture.FSwizzles[2] := FSwizzling.FSwizzles[2];
3733
TexParameteri(glTarget, GL_TEXTURE_SWIZZLE_B,
3734
cTextureSwizzle[FSwizzling.FSwizzles[2]]);
3736
if FSwizzling.FSwizzles[3] <> FLibTexture.FSwizzles[3] then
3738
FLibTexture.FSwizzles[3] := FSwizzling.FSwizzles[3];
3739
TexParameteri(glTarget, GL_TEXTURE_SWIZZLE_A,
3740
cTextureSwizzle[FSwizzling.FSwizzles[3]]);
3744
if Assigned(FLibSampler) then
3746
if FLibSampler.IsValid then
3747
FLibSampler.Apply(ARci)
3748
else if FLibTexture.FLastSampler <> FLibSampler then
3750
// Sampler object not supported, lets use texture states
3751
TexParameterfv(glTarget, GL_TEXTURE_BORDER_COLOR,
3752
FLibSampler.BorderColor.AsAddress);
3753
TexParameteri(glTarget, GL_TEXTURE_WRAP_S,
3754
cTextureWrapMode[FLibSampler.WrapX]);
3755
TexParameteri(glTarget, GL_TEXTURE_WRAP_T,
3756
cTextureWrapMode[FLibSampler.WrapY]);
3757
TexParameteri(glTarget, GL_TEXTURE_WRAP_R,
3758
cTextureWrapMode[FLibSampler.WrapZ]);
3759
TexParameterf(glTarget, GL_TEXTURE_LOD_BIAS, FLibSampler.LODBias +
3760
FLibSampler.FLODBiasFract);
3761
TexParameteri(glTarget, GL_TEXTURE_MIN_FILTER,
3762
cTextureMinFilter[FLibSampler.MinFilter]);
3763
TexParameteri(glTarget, GL_TEXTURE_MAG_FILTER,
3764
cTextureMagFilter[FLibSampler.MagFilter]);
3766
if EXT_texture_filter_anisotropic then
3768
if FLibSampler.FilteringQuality = tfAnisotropic then
3769
TexParameteri(glTarget, GL_TEXTURE_MAX_ANISOTROPY_EXT,
3770
CurrentGLContext.GLStates.MaxTextureAnisotropy)
3772
TexParameteri(glTarget, GL_TEXTURE_MAX_ANISOTROPY_EXT, 1);
3775
TexParameteri(glTarget, GL_TEXTURE_COMPARE_MODE,
3776
cTextureCompareMode[FLibSampler.CompareMode]);
3777
TexParameteri(glTarget, GL_TEXTURE_COMPARE_FUNC,
3778
cGLComparisonFunctionToGLEnum[FLibSampler.CompareFunc]);
3780
if EXT_texture_sRGB_decode then
3782
if FLibSampler.sRGB_Encode then
3783
TexParameteri(glTarget, GL_TEXTURE_SRGB_DECODE_EXT, GL_DECODE_EXT)
3785
TexParameteri(glTarget, GL_TEXTURE_SRGB_DECODE_EXT,
3786
GL_SKIP_DECODE_EXT);
3789
FLibTexture.FLastSampler := FLibSampler;
3793
if not FTextureMatrixIsIdentity and (MappingMode = tmmUser) then
3794
ARci.GLStates.SetGLTextureMatrix(FTextureMatrix);
3796
if ARci.currentMaterialLevel < mlSM3 then
3798
GL.TexEnvfv(GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, FEnvColor.AsAddress);
3800
if ARci.currentMaterialLevel = mlFixedFunction then
3801
XGL.MapTexCoordToMain;
3806
procedure TGLTextureProperties.ApplyMappingMode;
3812
R_Dim := ARB_texture_cube_map or EXT_texture3D;
3816
tmmUser: ; // nothing to do, but checked first (common case)
3820
TexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
3821
TexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
3822
TexGenfv(GL_S, GL_OBJECT_PLANE, @MappingSCoordinates.DirectVector);
3823
TexGenfv(GL_T, GL_OBJECT_PLANE, @MappingTCoordinates.DirectVector);
3824
Enable(GL_TEXTURE_GEN_S);
3825
Enable(GL_TEXTURE_GEN_T);
3829
TexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
3830
TexGeni(GL_Q, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);
3831
TexGenfv(GL_R, GL_OBJECT_PLANE, @MappingRCoordinates.DirectVector);
3832
TexGenfv(GL_Q, GL_OBJECT_PLANE, @MappingQCoordinates.DirectVector);
3833
Enable(GL_TEXTURE_GEN_R);
3834
Enable(GL_TEXTURE_GEN_Q);
3840
TexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
3841
TexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
3842
// specify planes in eye space, not world space
3843
MatrixMode(GL_MODELVIEW);
3846
TexGenfv(GL_S, GL_EYE_PLANE, @MappingSCoordinates.DirectVector);
3847
TexGenfv(GL_T, GL_EYE_PLANE, @MappingTCoordinates.DirectVector);
3848
Enable(GL_TEXTURE_GEN_S);
3849
Enable(GL_TEXTURE_GEN_T);
3852
TexGenfv(GL_R, GL_EYE_PLANE, @MappingRCoordinates.DirectVector);
3853
TexGenfv(GL_Q, GL_EYE_PLANE, @MappingQCoordinates.DirectVector);
3854
Enable(GL_TEXTURE_GEN_R);
3855
Enable(GL_TEXTURE_GEN_Q);
3862
TexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
3863
TexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
3864
Enable(GL_TEXTURE_GEN_S);
3865
Enable(GL_TEXTURE_GEN_T);
3868
tmmCubeMapReflection, tmmCubeMapCamera:
3871
TexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP);
3872
TexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP);
3873
TexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP);
3874
Enable(GL_TEXTURE_GEN_S);
3875
Enable(GL_TEXTURE_GEN_T);
3876
Enable(GL_TEXTURE_GEN_R);
3879
tmmCubeMapNormal, tmmCubeMapLight0:
3882
TexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP);
3883
TexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP);
3884
TexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP);
3885
Enable(GL_TEXTURE_GEN_S);
3886
Enable(GL_TEXTURE_GEN_T);
3887
Enable(GL_TEXTURE_GEN_R);
3893
procedure TGLTextureProperties.Assign(Source: TPersistent);
3895
LTexProp: TGLTextureProperties;
3897
if Source is TGLTextureProperties then
3899
LTexProp := TGLTextureProperties(Source);
3900
LibTextureName := LTexProp.LibTextureName;
3901
LibSamplerName := LTexProp.LibSamplerName;
3902
TextureOffset.Assign(LTexProp.TextureOffset);
3903
TextureScale.Assign(LTexProp.TextureScale);
3904
FTextureRotate := LTexProp.TextureRotate;
3905
FEnvColor.Assign(LTexProp.EnvColor);
3906
FMappingMode := LTexProp.MappingMode;
3907
MappingSCoordinates.Assign(LTexProp.MappingSCoordinates);
3908
MappingTCoordinates.Assign(LTexProp.MappingTCoordinates);
3909
MappingRCoordinates.Assign(LTexProp.MappingRCoordinates);
3910
MappingQCoordinates.Assign(LTexProp.MappingQCoordinates);
3915
procedure TGLTextureProperties.CalculateTextureMatrix;
3917
if not (Assigned(FTextureOffset) or Assigned(FTextureScale)
3918
or StoreTextureRotate) then
3920
FTextureMatrixIsIdentity := True;
3924
if TextureOffset.Equals(NullHmgVector)
3925
and TextureScale.Equals(XYZHmgVector)
3926
and not StoreTextureRotate then
3927
FTextureMatrixIsIdentity := True
3930
FTextureMatrixIsIdentity := False;
3931
FTextureMatrix := CreateScaleAndTranslationMatrix(
3932
TextureScale.AsVector,
3933
TextureOffset.AsVector);
3934
if StoreTextureRotate then
3935
FTextureMatrix := MatrixMultiply(FTextureMatrix,
3936
CreateRotationMatrixZ(DegToRad(FTextureRotate)));
3938
FTextureOverride := False;
3942
constructor TGLTextureProperties.Create(AOwner: TPersistent);
3945
FTextureRotate := 0;
3946
FMappingMode := tmmUser;
3947
FTextureMatrix := IdentityHmgMatrix;
3949
FSwizzling := TGLTextureSwizzling.Create(Self);
3950
FEnvColor := TGLColor.CreateInitialized(Self, clrTransparent);
3953
destructor TGLTextureProperties.Destroy;
3955
if Assigned(FLibSampler) then
3956
FLibSampler.UnregisterUser(Self);
3957
if Assigned(FLibTexture) then
3958
FLibTexture.UnregisterUser(Self);
3959
FTextureOffset.Free;
3961
FMapSCoordinates.Free;
3962
FMapTCoordinates.Free;
3963
FMapRCoordinates.Free;
3964
FMapQCoordinates.Free;
3970
function TGLTextureProperties.GetLibSamplerName: TGLMaterialComponentName;
3972
if Assigned(FLibSampler) then
3973
Result := FLibSampler.Name
3978
function TGLTextureProperties.GetLibTextureName: TGLMaterialComponentName;
3980
if Assigned(FLibTexture) then
3981
Result := FLibTexture.Name
3986
function TGLTextureProperties.GetMappingQCoordinates: TGLCoordinates4;
3988
if not Assigned(FMapQCoordinates) then
3989
FMapQCoordinates := TGLCoordinates4.CreateInitialized(Self, WHmgVector,
3991
Result := FMapQCoordinates;
3994
function TGLTextureProperties.GetMappingRCoordinates: TGLCoordinates4;
3996
if not Assigned(FMapRCoordinates) then
3997
FMapRCoordinates := TGLCoordinates4.CreateInitialized(Self, ZHmgVector,
3999
Result := FMapRCoordinates;
4002
function TGLTextureProperties.GetMappingSCoordinates: TGLCoordinates4;
4004
if not Assigned(FMapSCoordinates) then
4005
FMapSCoordinates := TGLCoordinates4.CreateInitialized(Self, XHmgVector,
4007
Result := FMapSCoordinates;
4010
function TGLTextureProperties.GetMappingTCoordinates: TGLCoordinates4;
4012
if not Assigned(FMapTCoordinates) then
4013
FMapTCoordinates := TGLCoordinates4.CreateInitialized(Self, YHmgVector,
4015
Result := FMapTCoordinates;
4018
function TGLTextureProperties.GetTextureOffset: TGLCoordinates;
4020
if not Assigned(FTextureOffset) then
4022
TGLCoordinates3.CreateInitialized(Self, NullHmgVector, csPoint);
4023
Result := FTextureOffset;
4026
function TGLTextureProperties.GetTextureScale: TGLCoordinates;
4028
if not Assigned(FTextureScale) then
4030
TGLCoordinates3.CreateInitialized(Self, VectorMake(1, 1, 1, 1), csVector);
4031
Result := FTextureScale;
4034
function TGLTextureProperties.IsValid: Boolean;
4036
if Assigned(FLibTexture) then
4037
Result := FLibTexture.IsValid
4042
procedure TGLTextureProperties.Loaded;
4044
SetLibTextureName(FLibTextureName);
4045
SetLibSamplerName(FLibSamplerName);
4046
CalculateTextureMatrix;
4049
procedure TGLTextureProperties.Notification(Sender: TObject;
4050
Operation: TOperation);
4052
if Operation = opRemove then
4054
if Sender = FLibTexture then
4056
else if Sender = FLibSampler then
4061
procedure TGLTextureProperties.NotifyChange(Sender: TObject);
4064
if (Sender = FTextureOffset) or (Sender = FTextureScale) then
4065
CalculateTextureMatrix;
4066
if (Sender = FLibSampler) and Assigned(FLibTexture) then
4067
FLibTexture.FLastSampler := nil;
4070
procedure TGLTextureProperties.SetLibSamplerName(const AValue:
4071
TGLMaterialComponentName);
4073
LSampler: TGLTextureSampler;
4075
if csLoading in GetMaterialLibraryEx.ComponentState then
4077
FLibSamplerName := AValue;
4081
if Assigned(FLibSampler) then
4083
if FLibSampler.Name = AValue then
4085
FLibSampler.UnregisterUser(Self);
4088
LSampler := GetMaterialLibraryEx.Components.GetSamplerByName(AValue);
4089
if Assigned(LSampler) then
4091
LSampler.RegisterUser(Self);
4092
FLibSampler := LSampler;
4097
procedure TGLTextureProperties.SetLibTextureName(const AValue:
4098
TGLMaterialComponentName);
4100
LTexture: TGLAbstractTexture;
4102
if csLoading in GetMaterialLibraryEx.ComponentState then
4104
FLibTextureName := AValue;
4108
if Assigned(FLibTexture) then
4110
if FLibTexture.Name = AValue then
4112
FLibTexture.UnregisterUser(Self);
4116
LTexture := GetMaterialLibraryEx.Components.GetTextureByName(AValue);
4118
if Assigned(LTexture) then
4120
if LTexture is TGLFrameBufferAttachment then
4122
if TGLFrameBufferAttachment(LTexture).OnlyWrite then
4124
if IsDesignTime then
4125
InformationDlg('Can not use write only attachment as texture')4127
GLSLogger.LogErrorFmt('Attempt to use write only attachment "%s" as texture',4133
LTexture.RegisterUser(Self);
4134
FLibTexture := LTexture;
4139
procedure TGLTextureProperties.SetMappingMode(
4140
const AValue: TGLTextureMappingMode);
4142
if AValue <> FMappingMode then
4144
FMappingMode := AValue;
4149
procedure TGLTextureProperties.SetMappingQCoordinates(
4150
const AValue: TGLCoordinates4);
4152
MappingQCoordinates.Assign(AValue);
4155
procedure TGLTextureProperties.SetMappingRCoordinates(
4156
const AValue: TGLCoordinates4);
4158
MappingRCoordinates.Assign(AValue);
4161
procedure TGLTextureProperties.SetMappingSCoordinates(
4162
const AValue: TGLCoordinates4);
4164
MappingSCoordinates.Assign(AValue);
4167
procedure TGLTextureProperties.SetMappingTCoordinates(
4168
const AValue: TGLCoordinates4);
4170
MappingTCoordinates.Assign(AValue);
4173
procedure TGLTextureProperties.SetSwizzling(const AValue: TGLTextureSwizzling);
4175
FSwizzling.Assign(AValue);
4178
procedure TGLTextureProperties.SetTextureMatrix(const AValue: TMatrix);
4180
FTextureMatrixIsIdentity := CompareMem(@AValue.V[0], @IdentityHmgMatrix.V[0],
4182
FTextureMatrix := AValue;
4183
FTextureOverride := True;
4187
procedure TGLTextureProperties.SetTextureOffset(const AValue: TGLCoordinates);
4189
TextureOffset.Assign(AValue);
4190
CalculateTextureMatrix;
4193
procedure TGLTextureProperties.SetTextureRotate(AValue: Single);
4195
if AValue <> FTextureRotate then
4197
FTextureRotate := AValue;
4198
CalculateTextureMatrix;
4203
procedure TGLTextureProperties.SetTextureScale(const AValue: TGLCoordinates);
4205
TextureScale.Assign(AValue);
4206
CalculateTextureMatrix;
4209
function TGLTextureProperties.StoreMappingQCoordinates: Boolean;
4211
if Assigned(FMapQCoordinates) then
4212
Result := not VectorEquals(FMapQCoordinates.AsVector, WHmgVector)
4217
function TGLTextureProperties.StoreMappingRCoordinates: Boolean;
4219
if Assigned(FMapRCoordinates) then
4220
Result := not VectorEquals(FMapRCoordinates.AsVector, ZHmgVector)
4225
function TGLTextureProperties.StoreMappingSCoordinates: Boolean;
4227
if Assigned(FMapSCoordinates) then
4228
Result := not VectorEquals(FMapSCoordinates.AsVector, XHmgVector)
4233
function TGLTextureProperties.StoreMappingTCoordinates: Boolean;
4235
if Assigned(FMapTCoordinates) then
4236
Result := not VectorEquals(FMapTCoordinates.AsVector, YHmgVector)
4241
function TGLTextureProperties.StoreSwizzling: Boolean;
4243
Result := FSwizzling.StoreSwizzle(0);
4246
function TGLTextureProperties.StoreTextureOffset: Boolean;
4248
Result := Assigned(FTextureOffset);
4251
function TGLTextureProperties.StoreTextureRotate: Boolean;
4253
Result := Abs(FTextureRotate) > EPSILON;
4256
function TGLTextureProperties.StoreTextureScale: Boolean;
4258
Result := Assigned(FTextureScale);
4261
procedure TGLTextureProperties.SetEnvColor(const AValue:
4264
FEnvColor.Assign(AValue);
4268
procedure TGLTextureProperties.UnApply(var ARci: TGLRenderContextInfo);
4270
if Assigned(FLibTexture) then
4272
FLibTexture.UnApply(ARci);
4273
if Assigned(FLibSampler) then
4274
FLibSampler.UnApply(ARci);
4276
if ARci.currentMaterialLevel < mlSM3 then
4278
if not FTextureMatrixIsIdentity and (MappingMode = tmmUser) then
4279
ARci.GLStates.SetGLTextureMatrix(IdentityHmgMatrix);
4285
procedure TGLTextureProperties.UnApplyMappingMode;
4287
if MappingMode <> tmmUser then
4290
Disable(GL_TEXTURE_GEN_S);
4291
Disable(GL_TEXTURE_GEN_T);
4292
if EXT_texture3D or ARB_texture_cube_map then
4294
Disable(GL_TEXTURE_GEN_R);
4295
Disable(GL_TEXTURE_GEN_Q);
4300
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}4302
{$IFDEF GLS_REGION}{$REGION 'TGLShaderEx'}{$ENDIF}4304
procedure TGLShaderEx.Assign(Source: TPersistent);
4306
LShader: TGLShaderEx;
4308
if Source is TGLShaderEx then
4310
LShader := TGLShaderEx(Source);
4311
FSource.Assign(LShader.Source);
4312
FShaderType := LShader.FShaderType;
4318
constructor TGLShaderEx.Create(AOwner: TGLXCollection);
4320
cShaderClasses: array[TGLShaderType] of TGLShaderHandleClass =
4322
TGLVertexShaderHandle,
4323
TGLTessControlShaderHandle,
4324
TGLTessEvaluationShaderHandle,
4325
TGLGeometryShaderHandle,
4326
TGLFragmentShaderHandle
4332
FDefferedInit := False;
4333
for S := Low(TGLShaderType) to High(TGLShaderType) do
4335
FHandle[S] := cShaderClasses[S].Create;
4336
FHandle[S].OnPrapare := DoOnPrepare;
4338
FSource := TStringList.Create;
4339
FSource.OnChange := NotifyChange;
4340
FShaderType := shtVertex;
4341
FGeometryInput := gsInPoints;
4342
FGeometryOutput := gsOutPoints;
4343
FGeometryVerticesOut := 1;
4344
Name := TGLMatLibComponents(AOwner).MakeUniqueName('Shader');4347
destructor TGLShaderEx.Destroy;
4351
for S := Low(TGLShaderType) to High(TGLShaderType) do
4357
procedure TGLShaderEx.NotifyChange(Sender: TObject);
4361
for S := Low(TGLShaderType) to High(TGLShaderType) do
4362
FHandle[S].NotifyChangesOfData;
4364
if (Sender = FSource) and IsDesignTime and (Length(FSourceFile) > 0) then
4365
FSource.SaveToFile(FSourceFile);
4370
procedure TGLShaderEx.DoOnPrepare(Sender: TGLContext);
4372
if not IsDesignTime and FDefferedInit then
4375
if FHandle[FShaderType].IsSupported then
4377
FHandle[FShaderType].AllocateHandle;
4378
if FHandle[FShaderType].IsDataNeedUpdate then
4381
if (Length(FSourceFile) > 0) and FileStreamExists(FSourceFile) then
4382
FSource.LoadFromFile(FSourceFile);
4383
FHandle[FShaderType].ShaderSource(AnsiString(FSource.Text));
4384
FIsValid := FHandle[FShaderType].CompileShader;
4385
if IsDesignTime then
4387
FInfoLog := FHandle[FShaderType].InfoLog;
4388
if (Length(FInfoLog) = 0) and FIsValid then
4389
FInfoLog := 'Compilation successful';
4391
else if FIsValid then
4392
GLSLogger.LogInfoFmt('Shader "%s" compilation successful - %s',4393
[Name, FHandle[FShaderType].InfoLog])
4395
GLSLogger.LogErrorFmt('Shader "%s" compilation failed - %s',4396
[Name, FHandle[FShaderType].InfoLog]);
4397
FHandle[FShaderType].NotifyDataUpdated;
4403
if IsDesignTime then
4404
FInfoLog := 'Not supported by hardware';
4410
if IsDesignTime then
4411
InformationDlg(E.ClassName + ': ' + E.Message)
4413
GLSLogger.LogError(E.ClassName + ': ' + E.Message);
4418
class function TGLShaderEx.FriendlyName: string;
4420
Result := 'GLSL Shader';
4423
function TGLShaderEx.GetHandle: TGLShaderHandle;
4425
Result := FHandle[FShaderType];
4428
procedure TGLShaderEx.ReadFromFiler(AReader: TReader);
4430
archiveVersion: Integer;
4434
archiveVersion := ReadInteger;
4435
if archiveVersion = 0 then
4437
Name := ReadWideString;
4438
FDefferedInit := ReadBoolean;
4439
FSource.Text := ReadWideString;
4440
FSourceFile := ReadWideString;
4441
FShaderType := TGLShaderType(ReadInteger);
4442
FGeometryInput := TGLgsInTypes(ReadInteger);
4443
FGeometryOutput := TGLgsOutTypes(ReadInteger);
4444
FGeometryVerticesOut := ReadInteger;
4447
RaiseFilerException(archiveVersion);
4451
procedure TGLShaderEx.SetGeometryInput(AValue: TGLgsInTypes);
4453
if AValue <> FGeometryInput then
4455
FGeometryInput := AValue;
4460
procedure TGLShaderEx.SetGeometryOutput(AValue: TGLgsOutTypes);
4462
if AValue <> FGeometryOutput then
4464
FGeometryOutput := AValue;
4469
procedure TGLShaderEx.SetGeometryVerticesOut(AValue: TGLint);
4473
else if AValue > 1024 then
4476
if AValue <> FGeometryVerticesOut then
4478
FGeometryVerticesOut := AValue;
4483
procedure TGLShaderEx.SetShaderType(AValue: TGLShaderType);
4485
if FShaderType <> AValue then
4487
FShaderType := AValue;
4492
procedure TGLShaderEx.SetSource(AValue: TStringList);
4494
FSource.Assign(AValue);
4497
procedure TGLShaderEx.SetSourceFile(AValue: string);
4499
FixPathDelimiter(AValue);
4500
if FSourceFile <> AValue then
4502
FSourceFile := AValue;
4507
procedure TGLShaderEx.WriteToFiler(AWriter: TWriter);
4511
WriteInteger(0); // archive version
4512
WriteWideString(Name);
4513
WriteBoolean(FDefferedInit);
4514
if Length(FSourceFile) = 0 then
4515
WriteWideString(FSource.Text)
4517
WriteWideString('');4518
WriteWideString(FSourceFile);
4519
WriteInteger(Integer(FShaderType));
4520
WriteInteger(Integer(FGeometryInput));
4521
WriteInteger(Integer(FGeometryOutput));
4522
WriteInteger(FGeometryVerticesOut);
4526
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}4528
{$IFDEF GLS_REGION}{$REGION 'TGLLibMaterialProperty'}{$ENDIF}4530
function TGLLibMaterialProperty.GetMaterial: TGLLibMaterialEx;
4532
if Owner is TGLLibMaterialEx then
4533
Result := TGLLibMaterialEx(Owner)
4534
else if Owner is TGLLibMaterialProperty then
4535
Result := TGLLibMaterialProperty(Owner).GetMaterial
4540
function TGLLibMaterialProperty.GetMaterialLibrary: TGLAbstractMaterialLibrary;
4542
if Owner is TGLBaseMaterialCollectionItem then
4543
Result := TGLBaseMaterialCollectionItem(Owner).GetMaterialLibrary
4545
Result := GetMaterial.GetMaterialLibrary;
4548
function TGLLibMaterialProperty.GetMaterialLibraryEx: TGLMaterialLibraryEx;
4550
if Owner is TGLBaseMaterialCollectionItem then
4551
Result := TGLBaseMaterialCollectionItem(Owner).GetMaterialLibraryEx
4553
Result := TGLMaterialLibraryEx(GetMaterial.GetMaterialLibrary);
4556
procedure TGLLibMaterialProperty.SetNextPass(const AValue: TGLLibMaterialName);
4558
if AValue <> FNextPassName then
4560
FNextPassName := AValue;
4565
procedure TGLLibMaterialProperty.Loaded;
4569
procedure TGLLibMaterialProperty.NotifyChange(Sender: TObject);
4573
if Assigned(Owner) then
4575
if Supports(Owner, IGLNotifyAble, NA) then
4576
NA.NotifyChange(Self)
4578
if Assigned(OnNotifyChange) then
4579
OnNotifyChange(Self);
4582
procedure TGLLibMaterialProperty.SetEnabled(AValue: Boolean);
4584
if FEnabled <> AValue then
4587
if Owner is TGLLibMaterialEx then
4588
GetMaterial.NotifyChange(Self);
4592
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}4594
{$IFDEF GLS_REGION}{$REGION 'TGLLibMaterialsEx'}{$ENDIF}4596
function TGLLibMaterialsEx.Add: TGLLibMaterialEx;
4598
Result := (inherited Add) as TGLLibMaterialEx;
4601
constructor TGLLibMaterialsEx.Create(AOwner: TComponent);
4603
inherited Create(AOwner, TGLLibMaterialEx);
4606
function TGLLibMaterialsEx.FindItemID(ID: Integer): TGLLibMaterialEx;
4608
Result := (inherited FindItemID(ID)) as TGLLibMaterialEx;
4611
function TGLLibMaterialsEx.GetItems(AIndex: Integer): TGLLibMaterialEx;
4613
Result := TGLLibMaterialEx(inherited Items[AIndex]);
4616
function TGLLibMaterialsEx.GetLibMaterialByName(
4617
const AName: string): TGLLibMaterialEx;
4619
LMaterial: TGLAbstractLibMaterial;
4621
LMaterial := GetMaterial(AName);
4622
if Assigned(LMaterial) and (LMaterial is TGLLibMaterialEx) then
4623
Result := TGLLibMaterialEx(LMaterial)
4628
function TGLLibMaterialsEx.IndexOf(const Item: TGLLibMaterialEx): Integer;
4634
for I := 0 to Count - 1 do
4635
if GetItems(I) = Item then
4642
function TGLLibMaterialsEx.MaterialLibrary: TGLMaterialLibraryEx;
4644
Result := TGLMaterialLibraryEx(GetOwner);
4647
procedure TGLLibMaterialsEx.SetItems(AIndex: Integer;
4648
const AValue: TGLLibMaterialEx);
4650
inherited Items[AIndex] := AValue;
4653
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}4655
{$IFDEF GLS_REGION}{$REGION 'TGLBaseShaderModel'}{$ENDIF}4657
procedure TGLBaseShaderModel.Apply(var ARci: TGLRenderContextInfo);
4660
LEvent: TOnUniformSetting;
4664
FHandle.UseProgramObject;
4666
for I := FUniforms.Count - 1 downto 0 do
4667
TGLAbstractShaderUniform(FUniforms[I]).Apply(ARci);
4669
if Self is TGLShaderModel3 then
4670
LEvent := GetMaterial.FOnSM3UniformSetting
4671
else if Self is TGLShaderModel4 then
4672
LEvent := GetMaterial.FOnSM4UniformSetting
4673
else if Self is TGLShaderModel5 then
4674
LEvent := GetMaterial.FOnSM5UniformSetting
4678
if Assigned(LEvent) then
4683
procedure TGLBaseShaderModel.Assign(Source: TPersistent);
4685
SM: TGLBaseShaderModel;
4687
if Source is TGLBaseShaderModel then
4689
SM := TGLBaseShaderModel(Source);
4690
LibVertexShaderName := SM.LibVertexShaderName;
4691
LibFragmentShaderName := SM.LibFragmentShaderName;
4692
LibGeometryShaderName := SM.LibGeometryShaderName;
4693
LibTessControlShaderName := SM.LibTessControlShaderName;
4694
LibTessEvalShaderName := SM.LibTessEvalShaderName;
4699
constructor TGLBaseShaderModel.Create(AOwner: TPersistent);
4702
FHandle := TGLProgramHandle.Create;
4703
FHandle.OnPrapare := DoOnPrepare;
4705
FUniforms := TPersistentObjectList.Create;
4709
procedure TGLBaseShaderModel.DefineProperties(Filer: TFiler);
4712
Filer.DefineBinaryProperty(
4716
FUniforms.Count > 0);
4719
destructor TGLBaseShaderModel.Destroy;
4722
LibVertexShaderName := '';
4723
LibFragmentShaderName := '';
4724
LibGeometryShaderName := '';
4725
LibTessControlShaderName := '';
4726
LibTessEvalShaderName := '';
4727
FUniforms.CleanFree;
4731
procedure TGLBaseShaderModel.DoOnPrepare(Sender: TGLContext);
4734
LUniforms: TPersistentObjectList;
4735
LUniform, LUniform2: TGLShaderUniform;
4738
buff: array[0..255] of AnsiChar;
4744
GLSLData: TGLSLDataType;
4745
GLSLSampler: TGLSLSamplerType;
4748
LEvent: TOnUniformInitialize;
4752
if IsSupported and FHandle.IsSupported then
4754
FHandle.AllocateHandle;
4755
if FHandle.IsDataNeedUpdate then
4758
for T := Low(TGLShaderType) to High(TGLShaderType) do
4759
if Assigned(FShaders[T]) then
4761
FShaders[T].DoOnPrepare(Sender);
4762
if not FShaders[T].IsValid then
4764
if IsDesignTime then
4765
FInfoLog := Format('%s shader "%s" is invalid',4766
[cShaderTypeName[FShaders[T].ShaderType],
4773
FHandle.DetachAllObject;
4774
for T := Low(TGLShaderType) to High(TGLShaderType) do
4775
if Assigned(FShaders[T]) then
4776
FHandle.AttachObject(FShaders[T].Handle);
4777
ID := FHandle.Handle;
4781
// Can be override by layouts in shader
4782
if Assigned(FShaders[shtGeometry]) then
4784
ProgramParameteri(ID, GL_GEOMETRY_INPUT_TYPE_EXT,
4785
cGLgsInTypes[FShaders[shtGeometry].GeometryInput]);
4786
ProgramParameteri(ID, GL_GEOMETRY_OUTPUT_TYPE_EXT,
4787
cGLgsOutTypes[FShaders[shtGeometry].GeometryOutput]);
4788
ProgramParameteri(ID, GL_GEOMETRY_VERTICES_OUT_EXT,
4789
FShaders[shtGeometry].GeometryVerticesOut);
4792
if FHandle.LinkProgram then
4796
if Assigned(FShaders[shtGeometry]) then
4798
GetProgramiv(ID, GL_GEOMETRY_INPUT_TYPE_EXT, @AType);
4800
GL_POINTS: FShaders[shtGeometry].FGeometryInput := gsInPoints;
4801
GL_LINES: FShaders[shtGeometry].FGeometryInput := gsInLines;
4802
GL_LINES_ADJACENCY_EXT: FShaders[shtGeometry].FGeometryInput
4804
GL_TRIANGLES: FShaders[shtGeometry].FGeometryInput :=
4806
GL_TRIANGLES_ADJACENCY_EXT:
4807
FShaders[shtGeometry].FGeometryInput := gsInAdjTriangles;
4809
GetProgramiv(ID, GL_GEOMETRY_OUTPUT_TYPE_EXT, @AType);
4811
GL_POINTS: FShaders[shtGeometry].FGeometryOutput :=
4813
GL_LINE_STRIP: FShaders[shtGeometry].FGeometryOutput :=
4815
GL_TRIANGLE_STRIP: FShaders[shtGeometry].FGeometryOutput :=
4818
GetProgramiv(ID, GL_GEOMETRY_VERTICES_OUT_EXT, @I);
4820
FShaders[shtGeometry].FGeometryVerticesOut := I;
4825
LUniforms := TPersistentObjectList.Create;
4827
GL.GetProgramiv(ID, GL_ACTIVE_UNIFORMS, @C);
4828
for I := 0 to C - 1 do
4838
Loc := GetUniformLocation(ID, @buff[0]);
4841
UName := Copy(string(buff), 0, Len);
4842
GLSLData := GLSLTypeUndefined;
4843
GLSLSampler := GLSLSamplerUndefined;
4845
GL_FLOAT: GLSLData := GLSLType1F;
4846
GL_FLOAT_VEC2: GLSLData := GLSLType2F;
4847
GL_FLOAT_VEC3: GLSLData := GLSLType3F;
4848
GL_FLOAT_VEC4: GLSLData := GLSLType4F;
4849
GL_INT: GLSLData := GLSLType1I;
4850
GL_INT_VEC2: GLSLData := GLSLType2I;
4851
GL_INT_VEC3: GLSLData := GLSLType3I;
4852
GL_INT_VEC4: GLSLData := GLSLType4I;
4853
GL_UNSIGNED_INT: GLSLData := GLSLType1UI;
4854
GL_UNSIGNED_INT_VEC2: GLSLData := GLSLType2UI;
4855
GL_UNSIGNED_INT_VEC3: GLSLData := GLSLType3UI;
4856
GL_UNSIGNED_INT_VEC4: GLSLData := GLSLType4UI;
4857
GL_BOOL: GLSLData := GLSLType1I;
4858
GL_BOOL_VEC2: GLSLData := GLSLType2I;
4859
GL_BOOL_VEC3: GLSLData := GLSLType3I;
4860
GL_BOOL_VEC4: GLSLData := GLSLType4I;
4861
GL_FLOAT_MAT2: GLSLData := GLSLTypeMat2F;
4862
GL_FLOAT_MAT3: GLSLData := GLSLTypeMat3F;
4863
GL_FLOAT_MAT4: GLSLData := GLSLTypeMat4F;
4864
//------------------------------------------------------------------------------
4865
GL_SAMPLER_1D: GLSLSampler := GLSLSampler1D;
4866
GL_SAMPLER_2D: GLSLSampler := GLSLSampler2D;
4867
GL_SAMPLER_3D: GLSLSampler := GLSLSampler3D;
4868
GL_SAMPLER_CUBE: GLSLSampler := GLSLSamplerCube;
4869
GL_SAMPLER_1D_SHADOW: GLSLSampler := GLSLSampler1DShadow;
4870
GL_SAMPLER_2D_SHADOW: GLSLSampler := GLSLSampler2DShadow;
4871
GL_SAMPLER_2D_RECT: GLSLSampler := GLSLSamplerRect;
4872
GL_SAMPLER_2D_RECT_SHADOW: GLSLSampler :=
4873
GLSLSamplerRectShadow;
4874
GL_SAMPLER_BUFFER: GLSLSampler := GLSLSamplerBuffer;
4875
GL_INT_SAMPLER_2D_RECT: GLSLSampler :=
4877
GL_INT_SAMPLER_BUFFER: GLSLSampler :=
4878
GLSLIntSamplerBuffer;
4879
GL_UNSIGNED_INT_SAMPLER_1D: GLSLSampler :=
4881
GL_UNSIGNED_INT_SAMPLER_2D: GLSLSampler :=
4883
GL_UNSIGNED_INT_SAMPLER_3D: GLSLSampler :=
4885
GL_UNSIGNED_INT_SAMPLER_CUBE: GLSLSampler :=
4886
GLSLUIntSamplerCube;
4887
GL_UNSIGNED_INT_SAMPLER_1D_ARRAY: GLSLSampler :=
4888
GLSLUIntSampler1DArray;
4889
GL_UNSIGNED_INT_SAMPLER_2D_ARRAY: GLSLSampler :=
4890
GLSLUIntSampler2DArray;
4891
GL_UNSIGNED_INT_SAMPLER_2D_RECT: GLSLSampler :=
4892
GLSLUIntSamplerRect;
4893
GL_UNSIGNED_INT_SAMPLER_BUFFER: GLSLSampler :=
4894
GLSLUIntSamplerBuffer;
4895
GL_SAMPLER_2D_MULTISAMPLE: GLSLSampler :=
4897
GL_INT_SAMPLER_2D_MULTISAMPLE: GLSLSampler :=
4899
GL_UNSIGNED_INT_SAMPLER_2D_MULTISAMPLE: GLSLSampler :=
4901
GL_SAMPLER_2D_MULTISAMPLE_ARRAY: GLSLSampler :=
4903
GL_INT_SAMPLER_2D_MULTISAMPLE_ARRAY: GLSLSampler :=
4904
GLSLIntSamplerMSArray;
4905
GL_UNSIGNED_INT_SAMPLER_2D_MULTISAMPLE_ARRAY: GLSLSampler :=
4906
GLSLUIntSamplerMSArray;
4910
if (GLSLData = GLSLTypeUndefined) and (GLSLSampler =
4911
GLSLSamplerUndefined) then
4913
GLSLogger.LogWarningFmt(
4914
'Detected active uniform "%s" with unknown type', [UName]);
4917
else if GLSLData <> GLSLTypeUndefined then
4919
GLSLogger.LogInfoFmt('Detected active uniform: %s %s',4920
[cGLSLTypeString[GLSLData], UName]);
4925
GLSLogger.LogInfoFmt('Detected active uniform: %s %s',4926
[cGLSLSamplerString[GLSLSampler], UName]);
4929
// Find already existing uniform
4931
for J := 0 to FUniforms.Count - 1 do
4933
if not (FUniforms[J] is TGLShaderUniform) then
4935
LUniform := TGLShaderUniform(FUniforms[J]);
4936
if not Assigned(LUniform) then
4938
if LUniform.Name = UName then
4940
if bSampler and (LUniform is TGLShaderUniformTexture) then
4942
if TGLShaderUniformTexture(LUniform).FSamplerType =
4945
LUniform.FLocation := Loc;
4946
LUniform.FType := GLSLType1I;
4947
TGLShaderUniformTexture(LUniform).FTarget :=
4948
cSamplerToTexture[GLSLSampler];
4949
LUniforms.Add(LUniform);
4950
FUniforms[J] := nil;
4957
if LUniform.FType = GLSLData then
4959
if (LUniform is TGLShaderUniformDSA)
4960
and not EXT_direct_state_access then
4962
LUniform2 := LUniform;
4963
LUniform := TGLShaderUniform.Create(Self);
4965
LUniform.Assign(LUniform2);
4968
LUniform.FLocation := Loc;
4969
LUniforms.Add(LUniform);
4970
FUniforms[J] := nil;
4980
// Create new uniform
4983
LUniform := TGLShaderUniformTexture.Create(Self);
4984
LUniform.FType := GLSLType1I;
4985
TGLShaderUniformTexture(LUniform).FSamplerType :=
4987
TGLShaderUniformTexture(LUniform).FTarget :=
4988
cSamplerToTexture[GLSLSampler];
4992
if EXT_direct_state_access then
4993
LUniform := TGLShaderUniformDSA.Create(Self)
4995
LUniform := TGLShaderUniform.Create(Self);
4996
LUniform.FType := GLSLData;
4999
LUniform.FName := UName;
5000
LUniform.FNameHashCode := ComputeNameHashKey(UName);
5001
LUniform.FLocation := Loc;
5002
LUniforms.Add(LUniform);
5006
// Clean old unused uniforms
5007
ReleaseUniforms(FUniforms);
5009
FUniforms := LUniforms;
5011
FHandle.NotifyDataUpdated;
5014
if Self is TGLShaderModel3 then
5015
LEvent := GetMaterial.FOnSM3UniformInit
5016
else if Self is TGLShaderModel4 then
5017
LEvent := GetMaterial.FOnSM4UniformInit
5018
else if Self is TGLShaderModel5 then
5019
LEvent := GetMaterial.FOnSM5UniformInit
5023
if Assigned(LEvent) then
5026
end // if LinkProgram
5031
if IsDesignTime then
5033
FInfoLog := FHandle.InfoLog;
5034
if (Length(FInfoLog) = 0) and FIsValid then
5035
FInfoLog := 'Link successful';
5037
else if FIsValid then
5038
GLSLogger.LogInfoFmt('Program "%s" link successful - %s',5039
[GetMaterial.Name, FHandle.InfoLog])
5041
GLSLogger.LogErrorFmt('Program "%s" link failed! - %s',5042
[GetMaterial.Name, FHandle.InfoLog]);
5047
if IsDesignTime then
5048
FInfoLog := 'Not supported by hardware';
5056
if IsDesignTime then
5057
InformationDlg(E.ClassName + ': ' + E.Message)
5059
GLSLogger.LogError(E.ClassName + ': ' + E.Message);
5064
procedure TGLBaseShaderModel.Notification(Sender: TObject; Operation:
5069
if Operation = opRemove then
5071
for st := Low(TGLShaderType) to High(TGLShaderType) do
5072
if FShaders[st] = Sender then
5074
FShaders[st] := nil;
5075
FLibShaderName[st] := '';
5082
procedure TGLBaseShaderModel.NotifyChange(Sender: TObject);
5084
FHandle.NotifyChangesOfData;
5088
procedure TGLBaseShaderModel.ReadUniforms(AStream: TStream);
5093
LUniform: TGLAbstractShaderUniform;
5094
LClass: CGLAbstractShaderUniform;
5096
LReader := TReader.Create(AStream, 16384);
5098
N := LReader.ReadInteger;
5099
for I := 0 to N - 1 do
5101
str := LReader.ReadWideString;
5102
LClass := CGLAbstractShaderUniform(FindClass(str));
5103
LUniform := LClass.Create(Self);
5105
LUniform.ReadFromFiler(LReader);
5106
FUniforms.Add(LUniform);
5113
class procedure TGLBaseShaderModel.ReleaseUniforms(
5114
AList: TPersistentObjectList);
5118
for I := 0 to AList.Count - 1 do
5119
if Assigned(AList[I]) then
5120
TGLAbstractShaderUniform(AList[I])._Release;
5124
function TGLBaseShaderModel.GetLibShaderName(AType: TGLShaderType): string;
5126
if Assigned(FShaders[AType]) then
5127
Result := FShaders[AType].Name
5132
function TGLBaseShaderModel.GetUniform(const AName: string): IShaderParameter;
5135
U: TGLAbstractShaderUniform;
5138
H := ComputeNameHashKey(AName);
5139
for I := 0 to FUniforms.Count - 1 do
5141
U := TGLAbstractShaderUniform(FUniforms[I]);
5142
if (U.FNameHashCode = H) and (U.FName = AName) then
5149
if not IsDesignTime then
5151
GLSLogger.LogErrorFmt('Attempt to use unknow uniform "%s" for material "%s"',5152
[AName, GetMaterial.Name]);
5153
U := TGLAbstractShaderUniform.Create(Self);
5156
U.FNameHashCode := H;
5162
procedure TGLBaseShaderModel.Loaded;
5167
for T := Low(TGLShaderType) to High(TGLShaderType) do
5168
SetLibShaderName(T, FLibShaderName[T]);
5169
for I := 0 to FUniforms.Count - 1 do
5170
if FUniforms[I] is TGLShaderUniformTexture then
5171
TGLShaderUniformTexture(FUniforms[I]).Loaded;
5174
procedure TGLBaseShaderModel.GetUniformNames(Proc: TGetStrProc);
5178
for I := 0 to FUniforms.Count - 1 do
5179
Proc(TGLAbstractShaderUniform(FUniforms[I]).FName);
5182
procedure TGLBaseShaderModel.SetLibShaderName(AType: TGLShaderType;
5183
const AValue: string);
5185
LShader: TGLShaderEx;
5187
if csLoading in GetMaterialLibraryEx.ComponentState then
5189
FLibShaderName[AType] := AValue;
5193
if Assigned(FShaders[AType]) then
5195
FShaders[AType].UnregisterUser(Self);
5196
FShaders[AType] := nil;
5197
FLibShaderName[AType] := '';
5200
LShader := GetMaterialLibraryEx.Components.GetShaderByName(AValue);
5201
if Assigned(LShader) then
5203
if LShader.ShaderType <> AType then
5205
if IsDesignTime then
5206
InformationDlg(Format('Incompatible shader type, need %s shader',5207
[cShaderTypeName[AType]]));
5210
LShader.RegisterUser(Self);
5211
FShaders[AType] := LShader;
5212
FLibShaderName[AType] := AValue;
5217
procedure TGLBaseShaderModel.UnApply(var ARci: TGLRenderContextInfo);
5219
if FIsValid and not ARci.GLStates.ForwardContext then
5220
FHandle.EndUseProgramObject;
5223
procedure TGLBaseShaderModel.WriteUniforms(AStream: TStream);
5228
LWriter := TWriter.Create(AStream, 16384);
5230
LWriter.WriteInteger(FUniforms.Count);
5231
for I := 0 to FUniforms.Count - 1 do
5233
LWriter.WriteWideString(FUniforms[I].ClassName);
5234
TGLAbstractShaderUniform(FUniforms[I]).WriteToFiler(LWriter);
5241
class function TGLShaderModel3.IsSupported: Boolean;
5243
Result := GL.ARB_shader_objects;
5246
class function TGLShaderModel4.IsSupported: Boolean;
5248
Result := GL.EXT_gpu_shader4;
5251
class function TGLShaderModel5.IsSupported: Boolean;
5253
Result := GL.ARB_gpu_shader5;
5256
procedure BeginPatch(mode: TGLEnum);
5257
{$IFDEF MSWINDOWS} stdcall;5258
{$ENDIF}{$IFDEF UNIX} cdecl;5261
if mode = GL_PATCHES then
5262
vStoreBegin(GL_PATCHES)
5263
else if (mode = GL_TRIANGLES)
5264
or (mode = GL_TRIANGLE_STRIP)
5265
or (mode = GL_TRIANGLE_FAN)
5266
or (mode = GL_QUADS) then
5268
if mode = GL_QUADS then
5269
GL.PatchParameteri(GL_PATCH_VERTICES, 4)
5271
GL.PatchParameteri(GL_PATCH_VERTICES, 3);
5272
vStoreBegin(GL_PATCHES);
5276
GL.Begin_ := vStoreBegin;
5277
GLSLogger.LogError('glBegin called with unsupported primitive for tessellation');5282
procedure TGLShaderModel5.Apply(var ARci: TGLRenderContextInfo);
5284
if Assigned(FShaders[shtControl]) or Assigned(FShaders[shtEvaluation]) then
5286
vStoreBegin := GL.Begin_;
5287
GL.Begin_ := BeginPatch;
5288
ARci.amalgamating := True;
5293
procedure TGLShaderModel5.UnApply(var ARci: TGLRenderContextInfo);
5296
if Assigned(FShaders[shtControl]) or Assigned(FShaders[shtEvaluation]) then
5297
GL.Begin_ := vStoreBegin;
5298
ARci.amalgamating := False;
5301
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}5303
{$IFDEF GLS_REGION}{$REGION 'TGLMatLibComponents'}{$ENDIF}5305
function TGLMatLibComponents.GetAttachmentByName(
5306
const AName: TGLMaterialComponentName): TGLFrameBufferAttachment;
5310
N := ComputeNameHashKey(AName);
5311
for I := 0 to Count - 1 do
5313
if (Items[I] is TGLFrameBufferAttachment) and (Items[I].FNameHashKey = N)
5316
if Items[I].Name = AName then
5318
Result := TGLFrameBufferAttachment(Items[I]);
5326
function TGLMatLibComponents.GetCombinerByName(
5327
const AName: TGLMaterialComponentName): TGLTextureCombiner;
5331
N := ComputeNameHashKey(AName);
5332
for I := 0 to Count - 1 do
5334
if (Items[I] is TGLTextureCombiner) and (Items[I].FNameHashKey = N) then
5336
if Items[I].Name = AName then
5338
Result := TGLTextureCombiner(Items[I]);
5346
function TGLMatLibComponents.GetItemByName(
5347
const AName: TGLMaterialComponentName): TGLBaseMaterialCollectionItem;
5351
N := ComputeNameHashKey(AName);
5352
for I := 0 to Count - 1 do
5354
if (Items[I].FNameHashKey = N) and (Items[I].Name = AName) then
5363
function TGLMatLibComponents.GetItems(
5364
index: Integer): TGLBaseMaterialCollectionItem;
5366
Result := TGLBaseMaterialCollectionItem(inherited GetItems(index));
5369
function TGLMatLibComponents.GetNamePath: string;
5373
Result := ClassName;
5374
if GetOwner = nil then
5376
s := GetOwner.GetNamePath;
5379
Result := s + '.Components';
5382
function TGLMatLibComponents.GetSamplerByName(
5383
const AName: TGLMaterialComponentName): TGLTextureSampler;
5387
N := ComputeNameHashKey(AName);
5388
for I := 0 to Count - 1 do
5390
if (Items[I] is TGLTextureSampler) and (Items[I].FNameHashKey = N) then
5392
if Items[I].Name = AName then
5394
Result := TGLTextureSampler(Items[I]);
5402
function TGLMatLibComponents.GetShaderByName(
5403
const AName: TGLMaterialComponentName): TGLShaderEx;
5407
N := ComputeNameHashKey(AName);
5408
for I := 0 to Count - 1 do
5410
if (Items[I] is TGLShaderEx) and (Items[I].FNameHashKey = N) then
5412
if Items[I].Name = AName then
5414
Result := TGLShaderEx(Items[I]);
5422
function TGLMatLibComponents.GetAsmProgByName(
5423
const AName: TGLMaterialComponentName): TGLASMVertexProgram;
5427
N := ComputeNameHashKey(AName);
5428
for I := 0 to Count - 1 do
5430
if (Items[I] is TGLASMVertexProgram) and (Items[I].FNameHashKey = N) then
5432
if Items[I].Name = AName then
5434
Result := TGLASMVertexProgram(Items[I]);
5442
function TGLMatLibComponents.GetTextureByName(
5443
const AName: TGLMaterialComponentName): TGLAbstractTexture;
5447
N := ComputeNameHashKey(AName);
5448
for I := 0 to Count - 1 do
5450
if (Items[I] is TGLAbstractTexture) and (Items[I].FNameHashKey = N) then
5452
if Items[I].Name = AName then
5454
Result := TGLTextureImageEx(Items[I]);
5462
class function TGLMatLibComponents.ItemsClass: TGLXCollectionItemClass;
5464
Result := TGLBaseMaterialCollectionItem;
5467
function TGLMatLibComponents.MakeUniqueName(const AName:
5468
TGLMaterialComponentName): TGLMaterialComponentName;
5474
while GetItemByName(Result) <> nil do
5476
Result := AName + IntToStr(i);
5481
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}5483
{$IFDEF GLS_REGION}{$REGION 'TGLMaterialLibraryEx'}{$ENDIF}5485
function TGLMaterialLibraryEx.AddAttachment(
5486
const AName: TGLMaterialComponentName): TGLFrameBufferAttachment;
5488
Result := TGLFrameBufferAttachment.Create(Components);
5489
Result.Name := AName;
5490
Components.Add(Result);
5493
function TGLMaterialLibraryEx.AddCombiner(
5494
const AName: TGLMaterialComponentName): TGLTextureCombiner;
5496
Result := TGLTextureCombiner.Create(Components);
5497
Result.Name := AName;
5498
Components.Add(Result);
5501
function TGLMaterialLibraryEx.AddSampler(
5502
const AName: TGLMaterialComponentName): TGLTextureSampler;
5504
Result := TGLTextureSampler.Create(Components);
5505
Result.Name := AName;
5506
Components.Add(Result);
5509
function TGLMaterialLibraryEx.AddShader(
5510
const AName: TGLMaterialComponentName): TGLShaderEx;
5512
Result := TGLShaderEx.Create(Components);
5513
Result.Name := AName;
5514
Components.Add(Result);
5517
function TGLMaterialLibraryEx.AddAsmProg(
5518
const AName: TGLMaterialComponentName): TGLASMVertexProgram;
5520
Result := TGLASMVertexProgram.Create(Components);
5521
Result.Name := AName;
5522
Components.Add(Result);
5525
function TGLMaterialLibraryEx.AddTexture(
5526
const AName: TGLMaterialComponentName): TGLTextureImageEx;
5528
Result := TGLTextureImageEx.Create(Components);
5529
Result.Name := AName;
5530
Components.Add(Result);
5533
constructor TGLMaterialLibraryEx.Create(AOwner: TComponent);
5536
FMaterials := TGLLibMaterialsEx.Create(Self);
5537
FComponents := TGLMatLibComponents.Create(Self);
5540
procedure TGLMaterialLibraryEx.DefineProperties(Filer: TFiler);
5542
Filer.DefineBinaryProperty(
5546
Components.Count > 0);
5550
destructor TGLMaterialLibraryEx.Destroy;
5553
FComponents.Destroy;
5557
function TGLMaterialLibraryEx.GetMaterials: TGLLibMaterialsEx;
5559
Result := TGLLibMaterialsEx(FMaterials);
5562
procedure TGLMaterialLibraryEx.GetNames(Proc: TGetStrProc;
5563
AClass: CGLBaseMaterialCollectionItem);
5567
for I := 0 to Components.Count - 1 do
5568
if Components[I].ClassType = AClass then
5569
Proc(Components[I].Name)
5572
procedure TGLMaterialLibraryEx.Loaded;
5577
procedure TGLMaterialLibraryEx.ReadComponents(AStream: TStream);
5581
LReader := TReader.Create(AStream, 16384);
5583
Components.ReadFromFiler(LReader);
5589
procedure TGLMaterialLibraryEx.SetComponents(AValue: TGLMatLibComponents);
5591
FComponents.Assign(AValue);
5594
procedure TGLMaterialLibraryEx.SetLevelForAll(const ALevel: TGLMaterialLevel);
5598
for I := Materials.Count - 1 downto 0 do
5599
Materials[I].ApplicableLevel := ALevel;
5602
procedure TGLMaterialLibraryEx.SetMaterials(AValue: TGLLibMaterialsEx);
5604
FMaterials.Assign(AValue);
5607
function TGLMaterialLibraryEx.StoreMaterials: Boolean;
5609
Result := (FMaterials.Count > 0);
5612
procedure TGLMaterialLibraryEx.WriteComponents(AStream: TStream);
5616
LWriter := TWriter.Create(AStream, 16384);
5618
Components.WriteToFiler(LWriter);
5624
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}5626
{$IFDEF GLS_REGION}{$REGION 'TGLShaderUniformTexture'}{$ENDIF}5628
procedure TGLShaderUniformTexture.Apply(var ARci: TGLRenderContextInfo);
5630
function FindHotActiveUnit: Boolean;
5634
bindTime, minTime: Double;
5635
LTex: TGLTextureImageEx;
5637
with ARci.GLStates do
5639
if Assigned(FLibTexture) and FLibTexture.IsValid then
5641
ID := FLibTexture.FHandle.Handle;
5642
// Yar: may be need exract this to new method of TGLTextureImageEx ???
5643
if FLibTexture is TGLTextureImageEx then
5645
LTex := TGLTextureImageEx(FLibTexture);
5646
Inc(LTex.FApplyCounter);
5647
if LTex.FApplyCounter > 16 then
5648
FreeAndNil(LTex.FImage);
5654
// Find alredy binded texture unit
5655
for I := 0 to MaxTextureImageUnits - 1 do
5657
if TextureBinding[I, FTarget] = ID then
5659
GL.Uniform1i(FLocation, I);
5665
// Find unused texture unit
5666
for I := 0 to MaxTextureImageUnits - 1 do
5668
if TextureBinding[I, FTarget] = 0 then
5670
TextureBinding[I, FTarget] := ID;
5671
GL.Uniform1i(FLocation, I);
5677
// Find most useless texture unit
5680
for I := 0 to MaxTextureImageUnits - 1 do
5682
bindTime := TextureBindingTime[I, FTarget];
5683
if bindTime < minTime then
5685
minTime := bindTime;
5690
TextureBinding[J, FTarget] := ID;
5692
GL.Uniform1i(FLocation, J);
5702
if FLocation > -1 then
5704
if FindHotActiveUnit and Assigned(FLibTexture) and Assigned(FLibSampler)
5708
// Apply swizzling if possible
5709
glTarget := DecodeGLTextureTarget(FLibTexture.Shape);
5710
if ARB_texture_swizzle or EXT_texture_swizzle then
5713
if FSwizzling[0] <> FLibTexture.FSwizzles[0] then
5715
FLibTexture.FSwizzles[0] := FSwizzling[0];
5716
TexParameteri(glTarget, GL_TEXTURE_SWIZZLE_R,
5717
cTextureSwizzle[FSwizzling[0]]);
5719
if FSwizzling[1] <> FLibTexture.FSwizzles[1] then
5721
FLibTexture.FSwizzles[1] := FSwizzling[1];
5722
TexParameteri(glTarget, GL_TEXTURE_SWIZZLE_G,
5723
cTextureSwizzle[FSwizzling[1]]);
5725
if FSwizzling[2] <> FLibTexture.FSwizzles[2] then
5727
FLibTexture.FSwizzles[2] := FSwizzling[2];
5728
TexParameteri(glTarget, GL_TEXTURE_SWIZZLE_B,
5729
cTextureSwizzle[FSwizzling[2]]);
5731
if FSwizzling[3] <> FLibTexture.FSwizzles[3] then
5733
FLibTexture.FSwizzles[3] := FSwizzling[3];
5734
TexParameteri(glTarget, GL_TEXTURE_SWIZZLE_A,
5735
cTextureSwizzle[FSwizzling[3]]);
5739
if FLibSampler.IsValid then
5740
FLibSampler.Apply(ARci)
5741
else if FLibTexture.FLastSampler <> FLibSampler then
5743
// Sampler object not supported, lets use texture states
5744
TexParameterfv(glTarget, GL_TEXTURE_BORDER_COLOR,
5745
FLibSampler.BorderColor.AsAddress);
5746
TexParameteri(glTarget, GL_TEXTURE_WRAP_S,
5747
cTextureWrapMode[FLibSampler.WrapX]);
5748
TexParameteri(glTarget, GL_TEXTURE_WRAP_T,
5749
cTextureWrapMode[FLibSampler.WrapY]);
5750
TexParameteri(glTarget, GL_TEXTURE_WRAP_R,
5751
cTextureWrapMode[FLibSampler.WrapZ]);
5752
TexParameterf(glTarget, GL_TEXTURE_LOD_BIAS, FLibSampler.LODBias +
5753
FLibSampler.FLODBiasFract);
5754
TexParameteri(glTarget, GL_TEXTURE_MIN_FILTER,
5755
cTextureMinFilter[FLibSampler.MinFilter]);
5756
TexParameteri(glTarget, GL_TEXTURE_MAG_FILTER,
5757
cTextureMagFilter[FLibSampler.MagFilter]);
5759
if EXT_texture_filter_anisotropic then
5761
if FLibSampler.FilteringQuality = tfAnisotropic then
5762
TexParameteri(glTarget, GL_TEXTURE_MAX_ANISOTROPY_EXT,
5763
CurrentGLContext.GLStates.MaxTextureAnisotropy)
5765
TexParameteri(glTarget, GL_TEXTURE_MAX_ANISOTROPY_EXT, 1);
5768
TexParameteri(glTarget, GL_TEXTURE_COMPARE_MODE,
5769
cTextureCompareMode[FLibSampler.CompareMode]);
5770
TexParameteri(glTarget, GL_TEXTURE_COMPARE_FUNC,
5771
cGLComparisonFunctionToGLEnum[FLibSampler.CompareFunc]);
5773
if EXT_texture_sRGB_decode then
5775
if FLibSampler.sRGB_Encode then
5776
TexParameteri(glTarget, GL_TEXTURE_SRGB_DECODE_EXT, GL_DECODE_EXT)
5778
TexParameteri(glTarget, GL_TEXTURE_SRGB_DECODE_EXT,
5779
GL_SKIP_DECODE_EXT);
5782
FLibTexture.FLastSampler := FLibSampler;
5789
procedure TGLShaderUniformTexture.Assign(Source: TPersistent);
5791
LUniform: TGLShaderUniformTexture;
5793
if Source is TGLShaderUniformTexture then
5795
LUniform := TGLShaderUniformTexture(Source);
5796
LibTextureName := LUniform.LibTextureName;
5797
LibSamplerName := LUniform.LibSamplerName;
5802
constructor TGLShaderUniformTexture.Create(AOwner: TPersistent);
5805
FSwizzling := cDefaultSwizzleVector;
5808
destructor TGLShaderUniformTexture.Destroy;
5810
LibTextureName := '';
5811
LibSamplerName := '';
5815
function TGLShaderUniformTexture.GetSamplerName: string;
5817
if Assigned(FLibSampler) then
5818
Result := FLibSampler.Name
5820
Result := rstrNothing;
5823
function TGLShaderUniformTexture.GetTextureName: string;
5825
if Assigned(FLibTexture) then
5826
Result := FLibTexture.Name
5828
Result := rstrNothing;
5831
function TGLShaderUniformTexture.GetTextureSwizzle: TSwizzleVector;
5833
Result := FSwizzling;
5836
procedure TGLShaderUniformTexture.Loaded;
5838
SetTextureName(FLibTexureName);
5839
SetSamplerName(FLibSamplerName);
5842
procedure TGLShaderUniformTexture.Notification(Sender: TObject;
5843
Operation: TOperation);
5845
if Operation = opRemove then
5847
if Sender = FLibTexture then
5849
else if Sender = FLibSampler then
5854
procedure TGLShaderUniformTexture.ReadFromFiler(AReader: TReader);
5859
LibTextureName := ReadWideString;
5860
LibSamplerName := ReadWideString;
5861
FSwizzling[0] := TGLTextureSwizzle(ReadInteger);
5862
FSwizzling[1] := TGLTextureSwizzle(ReadInteger);
5863
FSwizzling[2] := TGLTextureSwizzle(ReadInteger);
5864
FSwizzling[3] := TGLTextureSwizzle(ReadInteger);
5868
procedure TGLShaderUniformTexture.SetTextureName(
5869
const AValue: string);
5871
LTexture: TGLAbstractTexture;
5873
if csLoading in TGLBaseShaderModel(Owner).GetMaterialLibraryEx.ComponentState
5876
FLibTexureName := AValue;
5880
if Assigned(FLibTexture) then
5882
if FLibTexture.Name = AValue then
5884
FLibTexture.UnregisterUser(Self);
5889
TGLBaseShaderModel(Owner).GetMaterialLibraryEx.Components.GetTextureByName(AValue);
5891
if Assigned(LTexture) then
5893
if LTexture is TGLFrameBufferAttachment then
5895
if TGLFrameBufferAttachment(LTexture).OnlyWrite then
5897
if IsDesignTime then
5898
InformationDlg('Can not use write only attachment as texture')5900
GLSLogger.LogErrorFmt('Attempt to write only attachment "%s" for uniform "%s"',5901
[LTexture.Name, Name]);
5906
LTexture.RegisterUser(Self);
5907
FLibTexture := LTexture;
5912
procedure TGLShaderUniformTexture.SetSamplerName(const AValue: string);
5914
LSampler: TGLTextureSampler;
5916
if csLoading in TGLBaseShaderModel(Owner).GetMaterialLibraryEx.ComponentState
5919
FLibSamplerName := AValue;
5923
if Assigned(FLibSampler) then
5925
if FLibSampler.Name = AValue then
5927
FLibSampler.UnregisterUser(Self);
5932
TGLBaseShaderModel(Owner).GetMaterialLibraryEx.Components.GetSamplerByName(AValue);
5934
if Assigned(LSampler) then
5936
LSampler.RegisterUser(Self);
5937
FLibSampler := LSampler;
5943
procedure TGLShaderUniformTexture.SetTextureSwizzle(const AValue:
5946
FSwizzling := AValue;
5949
procedure TGLShaderUniformTexture.WriteToFiler(AWriter: TWriter);
5954
WriteWideString(LibTextureName);
5955
WriteWideString(LibSamplerName);
5956
WriteInteger(Integer(FSwizzling[0]));
5957
WriteInteger(Integer(FSwizzling[1]));
5958
WriteInteger(Integer(FSwizzling[2]));
5959
WriteInteger(Integer(FSwizzling[3]));
5963
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}5965
{$IFDEF GLS_REGION}{$REGION 'TGLAbstractShaderUniform'}{$ENDIF}5967
function TGLAbstractShaderUniform.GetFloat: Single;
5969
FillChar(Result, SizeOf(Result), $00);
5972
function TGLAbstractShaderUniform.GetGLSLSamplerType: TGLSLSamplerType;
5974
Result := FSamplerType;
5977
function TGLAbstractShaderUniform.GetGLSLType: TGLSLDataType;
5982
function TGLAbstractShaderUniform.GetInt: TGLint;
5984
FillChar(Result, SizeOf(Result), $00);
5987
function TGLAbstractShaderUniform.GetIVec2: TVector2i;
5989
FillChar(Result, SizeOf(Result), $00);
5992
function TGLAbstractShaderUniform.GetIVec3: TVector3i;
5994
FillChar(Result, SizeOf(Result), $00);
5997
function TGLAbstractShaderUniform.GetIVec4: TVector4i;
5999
FillChar(Result, SizeOf(Result), $00);
6002
function TGLAbstractShaderUniform.GetMat2: TMatrix2f;
6004
FillChar(Result, SizeOf(Result), $00);
6007
function TGLAbstractShaderUniform.GetMat3: TMatrix3f;
6009
FillChar(Result, SizeOf(Result), $00);
6012
function TGLAbstractShaderUniform.GetMat4: TMatrix4f;
6014
FillChar(Result, SizeOf(Result), $00);
6017
function TGLAbstractShaderUniform.GetName: string;
6022
function TGLAbstractShaderUniform.GetSamplerName: string;
6024
Result := rstrNothing;
6027
procedure TGLAbstractShaderUniform.Apply(var ARci: TGLRenderContextInfo);
6031
function TGLAbstractShaderUniform.GetAutoSetMethod: string;
6033
Result := rstrNothing;
6036
function TGLAbstractShaderUniform.GetTextureName: string;
6038
Result := rstrNothing;
6041
function TGLAbstractShaderUniform.GetTextureSwizzle: TSwizzleVector;
6043
Result := cDefaultSwizzleVector;
6046
function TGLAbstractShaderUniform.GetUInt: TGLuint;
6048
FillChar(Result, SizeOf(Result), $00);
6051
function TGLAbstractShaderUniform.GetUVec2: TVector2ui;
6053
FillChar(Result, SizeOf(Result), $00);
6056
function TGLAbstractShaderUniform.GetUVec3: TVector3ui;
6058
FillChar(Result, SizeOf(Result), $00);
6061
function TGLAbstractShaderUniform.GetUVec4: TVector4ui;
6063
FillChar(Result, SizeOf(Result), $00);
6066
function TGLAbstractShaderUniform.GetVec2: TVector2f;
6068
FillChar(Result, SizeOf(Result), $00);
6071
function TGLAbstractShaderUniform.GetVec3: TVector3f;
6073
FillChar(Result, SizeOf(Result), $00);
6076
function TGLAbstractShaderUniform.GetVec4: TVector;
6078
FillChar(Result, SizeOf(Result), $00);
6081
procedure TGLAbstractShaderUniform.ReadFromFiler(AReader: TReader);
6085
procedure TGLAbstractShaderUniform.SetFloat(const Value: TGLFloat);
6089
procedure TGLAbstractShaderUniform.SetFloatArray(const Values: PGLFloat;
6094
procedure TGLAbstractShaderUniform.SetInt(const Value: Integer);
6098
procedure TGLAbstractShaderUniform.SetIntArray(const Values: PGLInt;
6103
procedure TGLAbstractShaderUniform.SetIVec2(const Value: TVector2i);
6107
procedure TGLAbstractShaderUniform.SetIVec3(const Value: TVector3i);
6111
procedure TGLAbstractShaderUniform.SetIVec4(const Value: TVector4i);
6115
procedure TGLAbstractShaderUniform.SetMat2(const Value: TMatrix2f);
6119
procedure TGLAbstractShaderUniform.SetMat3(const Value: TMatrix3f);
6123
procedure TGLAbstractShaderUniform.SetMat4(const Value: TMatrix4f);
6127
procedure TGLAbstractShaderUniform.SetSamplerName(const AValue: string);
6131
procedure TGLAbstractShaderUniform.SetAutoSetMethod(const AValue: string);
6135
procedure TGLAbstractShaderUniform.SetTextureName(const AValue: string);
6139
procedure TGLAbstractShaderUniform.SetTextureSwizzle(const AValue:
6144
procedure TGLAbstractShaderUniform.SetUInt(const Value: GLuint);
6148
procedure TGLAbstractShaderUniform.SetUIntArray(const Values: PGLUInt;
6153
procedure TGLAbstractShaderUniform.SetUVec2(const Value: TVector2ui);
6157
procedure TGLAbstractShaderUniform.SetUVec3(const Value: TVector3ui);
6161
procedure TGLAbstractShaderUniform.SetUVec4(const Value: TVector4ui);
6165
procedure TGLAbstractShaderUniform.SetVec2(const Value: TVector2f);
6169
procedure TGLAbstractShaderUniform.SetVec3(const Value: TVector3f);
6173
procedure TGLAbstractShaderUniform.SetVec4(const Value: TVector4f);
6177
procedure TGLAbstractShaderUniform.WriteToFiler(AWriter: TWriter);
6181
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}6183
{$IFDEF GLS_REGION}{$REGION 'TGLShaderUniform'}{$ENDIF}6185
function TGLShaderUniform.GetFloat: Single;
6187
// TODO: Type checking
6188
GL.GetUniformfv(GetProgram, FLocation, @Result);
6191
function TGLShaderUniform.GetInt: TGLint;
6193
GL.GetUniformiv(GetProgram, FLocation, @Result);
6196
function TGLShaderUniform.GetIVec2: TVector2i;
6198
GL.GetUniformiv(GetProgram, FLocation, @Result);
6201
function TGLShaderUniform.GetIVec3: TVector3i;
6203
GL.GetUniformiv(GetProgram, FLocation, @Result);
6206
function TGLShaderUniform.GetIVec4: TVector4i;
6208
GL.GetUniformiv(GetProgram, FLocation, @Result);
6211
function TGLShaderUniform.GetMat2: TMatrix2f;
6213
GL.GetUniformfv(GetProgram, FLocation, @Result);
6216
function TGLShaderUniform.GetMat3: TMatrix3f;
6218
GL.GetUniformfv(GetProgram, FLocation, @Result);
6221
function TGLShaderUniform.GetMat4: TMatrix4f;
6223
GL.GetUniformfv(GetProgram, FLocation, @Result);
6226
function TGLShaderUniform.GetProgram: TGLuint;
6228
Result := TGLBaseShaderModel(Owner).FHandle.Handle;
6231
procedure TGLShaderUniform.Apply(var ARci: TGLRenderContextInfo);
6233
if Assigned(FAutoSet) then
6234
FAutoSet(Self, ARci);
6237
procedure TGLShaderUniform.Assign(Source: TPersistent);
6239
LUniform: TGLShaderUniform;
6241
if Source is TGLShaderUniform then
6243
LUniform := TGLShaderUniform(Source);
6244
FName := LUniform.Name;
6245
FNameHashCode := LUniform.FNameHashCode;
6246
FType := LUniform.FType;
6247
FSamplerType := LUniform.FSamplerType;
6248
FAutoSet := LUniform.FAutoSet;
6253
function TGLShaderUniform.GetAutoSetMethod: string;
6255
Result := GetUniformAutoSetMethodName(FAutoSet);
6258
function TGLShaderUniform.GetUInt: TGLuint;
6260
GL.GetUniformuiv(GetProgram, FLocation, @Result);
6263
function TGLShaderUniform.GetUVec2: TVector2ui;
6265
GL.GetUniformuiv(GetProgram, FLocation, @Result);
6268
function TGLShaderUniform.GetUVec3: TVector3ui;
6270
GL.GetUniformuiv(GetProgram, FLocation, @Result);
6273
function TGLShaderUniform.GetUVec4: TVector4ui;
6275
GL.GetUniformuiv(GetProgram, FLocation, @Result);
6278
function TGLShaderUniform.GetVec2: TVector2f;
6280
GL.GetUniformfv(GetProgram, FLocation, @Result);
6283
function TGLShaderUniform.GetVec3: TVector3f;
6285
GL.GetUniformfv(GetProgram, FLocation, @Result);
6288
function TGLShaderUniform.GetVec4: TVector;
6290
GL.GetUniformfv(GetProgram, FLocation, @Result);
6293
procedure TGLShaderUniform.PopProgram;
6295
CurrentGLContext.GLStates.CurrentProgram := FStoreProgram;
6298
procedure TGLShaderUniform.PushProgram;
6300
with CurrentGLContext.GLStates do
6302
FStoreProgram := CurrentProgram;
6303
CurrentProgram := GetProgram;
6307
procedure TGLShaderUniform.ReadFromFiler(AReader: TReader);
6311
FName := ReadWideString;
6312
FNameHashCode := ComputeNameHashKey(FName);
6313
FType := TGLSLDataType(ReadInteger);
6314
FSamplerType := TGLSLSamplerType(ReadInteger);
6315
SetAutoSetMethod(ReadWideString);
6319
procedure TGLShaderUniform.SetFloat(const Value: TGLFloat);
6322
GL.Uniform1f(FLocation, Value);
6326
procedure TGLShaderUniform.SetFloatArray(const Values: PGLFloat;
6330
GL.Uniform1fv(FLocation, Count, Values);
6334
procedure TGLShaderUniform.SetInt(const Value: Integer);
6337
GL.Uniform1i(FLocation, Value);
6341
procedure TGLShaderUniform.SetIntArray(const Values: PGLInt; Count: Integer);
6344
GL.Uniform1iv(FLocation, Count, Values);
6348
procedure TGLShaderUniform.SetIVec2(const Value: TVector2i);
6351
GL.Uniform2i(FLocation, Value.V[0], Value.V[1]);
6355
procedure TGLShaderUniform.SetIVec3(const Value: TVector3i);
6358
GL.Uniform3i(FLocation, Value.V[0], Value.V[1], Value.V[2]);
6362
procedure TGLShaderUniform.SetIVec4(const Value: TVector4i);
6365
GL.Uniform4i(FLocation, Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
6369
procedure TGLShaderUniform.SetMat2(const Value: TMatrix2f);
6372
GL.UniformMatrix2fv(FLocation, 1, False, @Value);
6376
procedure TGLShaderUniform.SetMat3(const Value: TMatrix3f);
6379
GL.UniformMatrix2fv(FLocation, 1, False, @Value);
6383
procedure TGLShaderUniform.SetMat4(const Value: TMatrix4f);
6386
GL.UniformMatrix4fv(FLocation, 1, False, @Value);
6390
procedure TGLShaderUniform.SetAutoSetMethod(const AValue: string);
6392
FAutoSet := GetUniformAutoSetMethod(AValue);
6395
procedure TGLShaderUniform.SetUInt(const Value: GLuint);
6398
GL.Uniform1ui(FLocation, Value);
6402
procedure TGLShaderUniform.SetUIntArray(const Values: PGLUInt; Count: Integer);
6405
GL.Uniform1uiv(FLocation, Count, Values);
6409
procedure TGLShaderUniform.SetUVec2(const Value: TVector2ui);
6412
GL.Uniform2ui(FLocation, Value.V[0], Value.V[1]);
6416
procedure TGLShaderUniform.SetUVec3(const Value: TVector3ui);
6419
GL.Uniform3ui(FLocation, Value.V[0], Value.V[1], Value.V[2]);
6423
procedure TGLShaderUniform.SetUVec4(const Value: TVector4ui);
6426
GL.Uniform4ui(FLocation, Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
6430
procedure TGLShaderUniform.SetVec2(const Value: TVector2f);
6433
GL.Uniform2f(FLocation, Value.V[0], Value.V[1]);
6437
procedure TGLShaderUniform.SetVec3(const Value: TVector3f);
6440
GL.Uniform3f(FLocation, Value.V[0], Value.V[1], Value.V[2]);
6444
procedure TGLShaderUniform.SetVec4(const Value: TVector4f);
6447
GL.Uniform4f(FLocation, Value.V[0], Value.V[1], Value.V[2], Value.V[3]);
6451
procedure TGLShaderUniform.WriteToFiler(AWriter: TWriter);
6455
WriteWideString(FName);
6456
WriteInteger(Integer(FType));
6457
WriteInteger(Integer(FSamplerType));
6458
WriteWideString(GetAutoSetMethod);
6462
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}6464
{$IFDEF GLS_REGION}{$REGION 'TGLShaderUniformDSA'}{$ENDIF}6466
procedure TGLShaderUniformDSA.SetFloat(const Value: TGLFloat);
6468
GL.ProgramUniform1f(GetProgram, FLocation, Value);
6471
procedure TGLShaderUniformDSA.SetFloatArray(const Values: PGLFloat;
6474
GL.ProgramUniform1fv(GetProgram, FLocation, Count, Values);
6477
procedure TGLShaderUniformDSA.SetInt(const Value: Integer);
6479
GL.ProgramUniform1i(GetProgram, FLocation, Value);
6482
procedure TGLShaderUniformDSA.SetIntArray(const Values: PGLInt; Count: Integer);
6484
GL.ProgramUniform1iv(GetProgram, FLocation, Count, Values);
6487
procedure TGLShaderUniformDSA.SetIVec2(const Value: TVector2i);
6489
GL.ProgramUniform2i(GetProgram, FLocation, Value.V[0], Value.V[1]);
6492
procedure TGLShaderUniformDSA.SetIVec3(const Value: TVector3i);
6494
GL.ProgramUniform3i(GetProgram, FLocation, Value.V[0], Value.V[1], Value.V[2]);
6497
procedure TGLShaderUniformDSA.SetIVec4(const Value: TVector4i);
6499
GL.ProgramUniform4i(GetProgram, FLocation, Value.V[0], Value.V[1], Value.V[2],
6503
procedure TGLShaderUniformDSA.SetMat2(const Value: TMatrix2f);
6505
GL.ProgramUniformMatrix2fv(GetProgram, FLocation, 1, False, @Value);
6508
procedure TGLShaderUniformDSA.SetMat3(const Value: TMatrix3f);
6510
GL.ProgramUniformMatrix3fv(GetProgram, FLocation, 1, False, @Value);
6513
procedure TGLShaderUniformDSA.SetMat4(const Value: TMatrix4f);
6515
GL.ProgramUniformMatrix4fv(GetProgram, FLocation, 1, False, @Value);
6518
procedure TGLShaderUniformDSA.SetUInt(const Value: GLuint);
6520
GL.ProgramUniform1ui(GetProgram, FLocation, Value);
6523
procedure TGLShaderUniformDSA.SetUIntArray(const Values: PGLUInt;
6526
GL.ProgramUniform1uiv(GetProgram, FLocation, Count, Values);
6529
procedure TGLShaderUniformDSA.SetUVec2(const Value: TVector2ui);
6531
GL.ProgramUniform2ui(GetProgram, FLocation, Value.V[0], Value.V[1]);
6534
procedure TGLShaderUniformDSA.SetUVec3(const Value: TVector3ui);
6536
GL.ProgramUniform3ui(GetProgram, FLocation, Value.V[0], Value.V[1], Value.V[2]);
6539
procedure TGLShaderUniformDSA.SetUVec4(const Value: TVector4ui);
6541
GL.ProgramUniform4ui(GetProgram, FLocation, Value.V[0], Value.V[1], Value.V[2],
6545
procedure TGLShaderUniformDSA.SetVec2(const Value: TVector2f);
6547
GL.ProgramUniform2f(GetProgram, FLocation, Value.V[0], Value.V[1]);
6550
procedure TGLShaderUniformDSA.SetVec3(const Value: TVector3f);
6552
GL.ProgramUniform3f(GetProgram, FLocation, Value.V[0], Value.V[1], Value.V[2]);
6555
procedure TGLShaderUniformDSA.SetVec4(const Value: TVector4f);
6557
GL.ProgramUniform4f(GetProgram, FLocation, Value.V[0], Value.V[1], Value.V[2],
6561
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}6563
{$IFDEF GLS_REGION}{$REGION 'TGLTextureSwizzling'}{$ENDIF}6565
procedure TGLTextureSwizzling.Assign(Source: TPersistent);
6567
LSwizzling: TGLTextureSwizzling;
6569
if Source is TGLTextureSwizzling then
6571
LSwizzling := TGLTextureSwizzling(Source);
6572
FSwizzles[0] := LSwizzling.FSwizzles[0];
6573
FSwizzles[1] := LSwizzling.FSwizzles[1];
6574
FSwizzles[2] := LSwizzling.FSwizzles[2];
6575
FSwizzles[3] := LSwizzling.FSwizzles[3];
6580
constructor TGLTextureSwizzling.Create(AOwner: TPersistent);
6583
FSwizzles := cDefaultSwizzleVector;
6586
function TGLTextureSwizzling.GetSwizzle(AIndex: Integer): TGLTextureSwizzle;
6588
Result := FSwizzles[AIndex];
6591
procedure TGLTextureSwizzling.ReadFromFiler(AReader: TReader);
6596
FSwizzles[0] := TGLTextureSwizzle(ReadInteger);
6597
FSwizzles[1] := TGLTextureSwizzle(ReadInteger);
6598
FSwizzles[2] := TGLTextureSwizzle(ReadInteger);
6599
FSwizzles[3] := TGLTextureSwizzle(ReadInteger);
6603
procedure TGLTextureSwizzling.SetSwizzle(AIndex: Integer;
6604
AValue: TGLTextureSwizzle);
6606
if AValue <> FSwizzles[AIndex] then
6608
FSwizzles[AIndex] := AValue;
6613
function TGLTextureSwizzling.StoreSwizzle(AIndex: Integer): Boolean;
6615
Result := (FSwizzles[AIndex] <> cDefaultSwizzleVector[AIndex]);
6618
procedure TGLTextureSwizzling.WriteToFiler(AWriter: TWriter);
6623
WriteInteger(Integer(FSwizzles[0]));
6624
WriteInteger(Integer(FSwizzles[1]));
6625
WriteInteger(Integer(FSwizzles[2]));
6626
WriteInteger(Integer(FSwizzles[3]));
6630
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}6632
{$IFDEF GLS_REGION}{$REGION 'TGLFrameBufferAttachment'}{$ENDIF}6634
procedure TGLFrameBufferAttachment.Apply(var ARci: TGLRenderContextInfo);
6636
if FIsValid and not FOnlyWrite then
6639
with ARci.GLStates do
6641
ActiveTextureEnabled[FHandle.Target] := True;
6642
TextureBinding[ActiveTexture, FHandle.Target] := FHandle.Handle;
6646
ARci.GLStates.TextureBinding[ARci.GLStates.ActiveTexture, FHandle.Target] :=
6650
procedure TGLFrameBufferAttachment.Assign(Source: TPersistent);
6652
LAttachment: TGLFrameBufferAttachment;
6654
if Source is TGLFrameBufferAttachment then
6656
LAttachment := TGLFrameBufferAttachment(Source);
6657
FLayered := LAttachment.Layered;
6658
FCubeMap := LAttachment.CubeMap;
6659
FSamples := LAttachment.Samples;
6660
FOnlyWrite := LAttachment.OnlyWrite;
6661
FFixedSamplesLocation := LAttachment.FixedSamplesLocation;
6662
FWidth := LAttachment.InternalWidth;
6663
FHeight := LAttachment.InternalHeight;
6664
FDepth := LAttachment.InternalDepth;
6665
FInternalFormat := LAttachment.InternalFormat;
6671
constructor TGLFrameBufferAttachment.Create(AOwner: TGLXCollection);
6674
FDefferedInit := False;
6675
FHandle := TGLTextureHandle.Create;
6676
FHandle.OnPrapare := DoOnPrepare;
6677
FRenderBufferHandle := TGLRenderbufferHandle.Create;
6678
FRenderBufferHandle.OnPrapare := DoOnPrepare;
6679
FInternalFormat := tfRGBA8;
6686
FOnlyWrite := False;
6687
FFixedSamplesLocation := False;
6688
Name := TGLMatLibComponents(AOwner).MakeUniqueName('Attachment');6691
destructor TGLFrameBufferAttachment.Destroy;
6694
FRenderBufferHandle.Destroy;
6698
procedure TGLFrameBufferAttachment.DoOnPrepare(Sender: TGLContext);
6700
LTarget: TGLTextureTarget;
6701
w, h, d, s, Level, MaxLevel: Integer;
6702
glTarget, glFormat, glFace: TGLEnum;
6704
if IsDesignTime and FDefferedInit then
6707
FHandle.AllocateHandle;
6708
FRenderBufferHandle.AllocateHandle;
6709
if not (FHandle.IsDataNeedUpdate or FRenderBufferHandle.IsDataNeedUpdate) then
6714
if FSamples < 0 then
6716
LTarget := ttTexture2D;
6718
LTarget := ttTexture1D;
6720
LTarget := ttTextureCube;
6722
LTarget := ttTexture3D;
6726
LTarget := ttTexture1DArray
6728
LTarget := ttTexture2DArray;
6730
LTarget := ttTextureCubeArray;
6736
LTarget := ttTexture2DMultisampleArray
6738
LTarget := ttTexture2DMultisample;
6741
// Check target support
6742
if FOnlyWrite and (LTarget = ttTexture2DMultisample)
6743
and not Sender.GL.EXT_framebuffer_multisample then
6748
if not IsTargetSupported(LTarget) then
6761
if w > Integer(Sender.GLStates.MaxCubeTextureSize) then
6762
w := Sender.GLStates.MaxCubeTextureSize;
6768
else if (d mod 6) > 0 then
6769
d := 6 * (d div 6 + 1);
6772
else if w > Integer(Sender.GLStates.MaxTextureSize) then
6773
w := Sender.GLStates.MaxTextureSize;
6774
if h > Integer(Sender.GLStates.MaxTextureSize) then
6775
h := Sender.GLStates.MaxTextureSize;
6778
if d > Integer(Sender.GLStates.MaxArrayTextureSize) then
6779
d := Sender.GLStates.MaxArrayTextureSize;
6781
else if d > Integer(Sender.GLStates.Max3DTextureSize) then
6782
d := Sender.GLStates.Max3DTextureSize;
6783
if (s > -1) and (s > Integer(Sender.GLStates.MaxSamples)) then
6784
s := Sender.GLStates.MaxSamples;
6786
glTarget := DecodeGLTextureTarget(LTarget);
6788
if (FHandle.Target <> LTarget)
6789
and (FHandle.Target <> ttNoShape) then
6791
FHandle.DestroyHandle;
6792
FHandle.AllocateHandle;
6794
FHandle.Target := LTarget;
6796
glFormat := InternalFormatToOpenGLFormat(FInternalFormat);
6798
if FOnlyWrite and ((LTarget = ttTexture2D) or (LTarget =
6799
ttTexture2DMultisample))
6800
and FRenderBufferHandle.IsSupported then
6802
if LTarget = ttTexture2D then
6803
FRenderBufferHandle.SetStorage(glFormat, w, h)
6805
FRenderBufferHandle.SetStorageMultisample(glFormat, s, w, h);
6810
GLStates.ActiveTextureEnabled[FHandle.Target] := True;
6811
GLStates.TextureBinding[GLStates.ActiveTexture, FHandle.Target] :=
6813
MaxLevel := CalcTextureLevelNumber(LTarget, w, h, d);
6818
for Level := 0 to MaxLevel - 1 do
6820
GL.TexImage1D(glTarget, Level, glFormat, w, 0, GL_RGBA,
6821
GL_UNSIGNED_BYTE, nil);
6826
for Level := 0 to MaxLevel - 1 do
6828
GL.TexImage2D(glTarget, Level, glFormat, w, h, 0, GL_RGBA,
6829
GL_UNSIGNED_BYTE, nil);
6834
GL_TEXTURE_RECTANGLE:
6836
GL.TexImage2D(glTarget, 0, glFormat, w, h, 0, GL_RGBA,
6837
GL_UNSIGNED_BYTE, nil);
6841
for Level := 0 to MaxLevel - 1 do
6843
GL.TexImage3D(glTarget, Level, glFormat, w, h, d, 0, GL_RGBA,
6844
GL_UNSIGNED_BYTE, nil);
6850
GL_TEXTURE_CUBE_MAP:
6851
for Level := 0 to MaxLevel - 1 do
6853
for glFace := GL_TEXTURE_CUBE_MAP_POSITIVE_X to
6854
GL_TEXTURE_CUBE_MAP_NEGATIVE_Z do
6855
GL.TexImage2D(glFace, Level, glFormat, w, w, 0, GL_RGBA,
6856
GL_UNSIGNED_BYTE, nil);
6860
GL_TEXTURE_1D_ARRAY:
6861
for Level := 0 to MaxLevel - 1 do
6863
GL.TexImage2D(glTarget, Level, glFormat, w, h, 0, GL_RGBA,
6864
GL_UNSIGNED_BYTE, nil);
6868
GL_TEXTURE_2D_ARRAY:
6869
for Level := 0 to MaxLevel - 1 do
6871
GL.TexImage3D(glTarget, Level, glFormat, w, h, d, 0, GL_RGBA,
6872
GL_UNSIGNED_BYTE, nil);
6877
GL_TEXTURE_CUBE_MAP_ARRAY:
6878
for Level := 0 to MaxLevel - 1 do
6880
GL.TexImage3D(glTarget, Level, glFormat, w, w, d, 0, GL_RGBA,
6881
GL_UNSIGNED_BYTE, nil);
6886
GLStates.ActiveTextureEnabled[FHandle.Target] := False;
6887
FOnlyWrite := False;
6890
if GL.GetError <> GL_NO_ERROR then
6893
GLSLogger.LogErrorFmt('Unable to create attachment "%s"', [Self.Name]);6899
FHandle.NotifyDataUpdated;
6900
FRenderBufferHandle.NotifyDataUpdated;
6903
class function TGLFrameBufferAttachment.FriendlyName: string;
6905
Result := 'Framebuffer Attachment';
6908
procedure TGLFrameBufferAttachment.NotifyChange(Sender: TObject);
6910
FHandle.NotifyChangesOfData;
6911
FRenderBufferHandle.NotifyChangesOfData;
6915
procedure TGLFrameBufferAttachment.ReadFromFiler(AReader: TReader);
6917
archiveVersion: Integer;
6921
archiveVersion := ReadInteger;
6922
if archiveVersion = 0 then
6924
Name := ReadWideString;
6925
FDefferedInit := ReadBoolean;
6926
FLayered := ReadBoolean;
6927
FCubeMap := ReadBoolean;
6928
FSamples := ReadInteger;
6929
FOnlyWrite := ReadBoolean;
6930
FFixedSamplesLocation := ReadBoolean;
6931
FWidth := ReadInteger;
6932
FHeight := ReadInteger;
6933
FDepth := ReadInteger;
6934
FInternalFormat := TGLInternalFormat(ReadInteger);
6937
RaiseFilerException(archiveVersion);
6941
procedure TGLFrameBufferAttachment.SetCubeMap(AValue: Boolean);
6943
if FCubeMap <> AValue then
6950
procedure TGLFrameBufferAttachment.SetDepth(AValue: Integer);
6954
else if FDepth > 256 then
6956
if FDepth <> AValue then
6963
procedure TGLFrameBufferAttachment.SetFixedSamplesLocation(AValue: Boolean);
6965
if FFixedSamplesLocation <> AValue then
6967
FFixedSamplesLocation := AValue;
6972
procedure TGLFrameBufferAttachment.SetHeight(AValue: Integer);
6976
else if FHeight > 8192 then
6978
if FHeight <> AValue then
6985
procedure TGLFrameBufferAttachment.SetInternalFormat(
6986
const AValue: TGLInternalFormat);
6988
if FInternalFormat <> AValue then
6990
FInternalFormat := AValue;
6995
procedure TGLFrameBufferAttachment.SetLayered(AValue: Boolean);
6997
if FLayered <> AValue then
7004
procedure TGLFrameBufferAttachment.SetOnlyWrite(AValue: Boolean);
7006
if FOnlyWrite <> AValue then
7009
and ((FDepth > 0) or FLayered or FFixedSamplesLocation or FCubeMap) then
7011
FOnlyWrite := AValue;
7016
procedure TGLFrameBufferAttachment.SetSamples(AValue: Integer);
7020
if FSamples <> AValue then
7027
procedure TGLFrameBufferAttachment.SetWidth(AValue: Integer);
7031
else if FWidth > 8192 then
7033
if FWidth <> AValue then
7040
procedure TGLFrameBufferAttachment.UnApply(var ARci: TGLRenderContextInfo);
7042
ARci.GLStates.ActiveTextureEnabled[FHandle.Target] := False;
7045
procedure TGLFrameBufferAttachment.WriteToFiler(AWriter: TWriter);
7049
WriteInteger(0); // archive version
7050
WriteWideString(Name);
7051
WriteBoolean(FDefferedInit);
7052
WriteBoolean(FLayered);
7053
WriteBoolean(FCubeMap);
7054
WriteInteger(FSamples);
7055
WriteBoolean(FOnlyWrite);
7056
WriteBoolean(FFixedSamplesLocation);
7057
WriteInteger(FWidth);
7058
WriteInteger(FHeight);
7059
WriteInteger(FDepth);
7060
WriteInteger(Integer(FInternalFormat));
7064
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}7066
{$IFDEF GLS_REGION}{$REGION 'TStandartUniformAutoSetExecutor'}{$ENDIF}7068
constructor TStandartUniformAutoSetExecutor.Create;
7070
RegisterUniformAutoSetMethod('Camera world position', GLSLType4F,7072
RegisterUniformAutoSetMethod('LightSource[0] world position', GLSLType4F,7073
SetLightSource0Position);
7074
RegisterUniformAutoSetMethod('World (model) matrix', GLSLTypeMat4F,7076
RegisterUniformAutoSetMethod('WorldView matrix', GLSLTypeMat4F,7077
SetModelViewMatrix);
7078
RegisterUniformAutoSetMethod('WorldNormal matrix', GLSLTypeMat3F,7079
SetNormalModelMatrix);
7080
RegisterUniformAutoSetMethod('Inverse World matrix', GLSLTypeMat4F,7082
RegisterUniformAutoSetMethod('View matrix', GLSLTypeMat4F, SetViewMatrix);7083
RegisterUniformAutoSetMethod('Inverse WorldView matrix', GLSLTypeMat4F,7084
SetInvModelViewMatrix);
7085
RegisterUniformAutoSetMethod('Projection matrix', GLSLTypeMat4F,7086
SetProjectionMatrix);
7087
RegisterUniformAutoSetMethod('ViewProjection matrix', GLSLTypeMat4F,7088
SetViewProjectionMatrix);
7089
RegisterUniformAutoSetMethod('WorldViewProjection matrix', GLSLTypeMat4F,7090
SetWorldViewProjectionMatrix);
7091
RegisterUniformAutoSetMethod('Material front face emission', GLSLType4F,7092
SetMaterialFrontEmission);
7093
RegisterUniformAutoSetMethod('Material front face ambient', GLSLType4F,7094
SetMaterialFrontAmbient);
7095
RegisterUniformAutoSetMethod('Material front face diffuse', GLSLType4F,7096
SetMaterialFrontDiffuse);
7097
RegisterUniformAutoSetMethod('Material front face specular', GLSLType4F,7098
SetMaterialFrontSpecular);
7099
RegisterUniformAutoSetMethod('Material front face shininess', GLSLType1F,7100
SetMaterialFrontShininess);
7101
RegisterUniformAutoSetMethod('Material back face emission', GLSLType4F,7102
SetMaterialBackEmission);
7103
RegisterUniformAutoSetMethod('Material back face ambient', GLSLType4F,7104
SetMaterialBackAmbient);
7105
RegisterUniformAutoSetMethod('Material back face diffuse', GLSLType4F,7106
SetMaterialBackDiffuse);
7107
RegisterUniformAutoSetMethod('Material back face specular', GLSLType4F,7108
SetMaterialBackSpecular);
7109
RegisterUniformAutoSetMethod('Material back face shininess', GLSLType1F,7110
SetMaterialBackShininess)
7113
procedure TStandartUniformAutoSetExecutor.SetCameraPosition(Sender:
7114
IShaderParameter; var ARci: TGLRenderContextInfo);
7116
Sender.vec4 := ARci.cameraPosition;
7119
procedure TStandartUniformAutoSetExecutor.SetInvModelMatrix(Sender:
7120
IShaderParameter; var ARci: TGLRenderContextInfo);
7122
Sender.mat4 := ARci.PipelineTransformation.InvModelMatrix;
7125
procedure TStandartUniformAutoSetExecutor.SetInvModelViewMatrix(Sender:
7126
IShaderParameter; var ARci: TGLRenderContextInfo);
7128
Sender.mat4 := ARci.PipelineTransformation.InvModelViewMatrix;
7131
procedure TStandartUniformAutoSetExecutor.SetLightSource0Position(Sender:
7132
IShaderParameter; var ARci: TGLRenderContextInfo);
7134
Sender.vec4 := ARci.GLStates.LightPosition[0];
7137
procedure TStandartUniformAutoSetExecutor.SetMaterialBackAmbient(Sender:
7138
IShaderParameter; var ARci: TGLRenderContextInfo);
7140
Sender.vec4 := ARci.GLStates.MaterialAmbient[cmBack];
7143
procedure TStandartUniformAutoSetExecutor.SetMaterialBackDiffuse(Sender:
7144
IShaderParameter; var ARci: TGLRenderContextInfo);
7146
Sender.vec4 := ARci.GLStates.MaterialDiffuse[cmBack];
7149
procedure TStandartUniformAutoSetExecutor.SetMaterialBackEmission(Sender:
7150
IShaderParameter; var ARci: TGLRenderContextInfo);
7152
Sender.vec4 := ARci.GLStates.MaterialEmission[cmBack];
7155
procedure TStandartUniformAutoSetExecutor.SetMaterialBackShininess(Sender:
7156
IShaderParameter; var ARci: TGLRenderContextInfo);
7158
Sender.float := ARci.GLStates.MaterialShininess[cmBack];
7161
procedure TStandartUniformAutoSetExecutor.SetMaterialBackSpecular(Sender:
7162
IShaderParameter; var ARci: TGLRenderContextInfo);
7164
Sender.vec4 := ARci.GLStates.MaterialSpecular[cmBack];
7167
procedure TStandartUniformAutoSetExecutor.SetMaterialFrontAmbient(Sender:
7168
IShaderParameter; var ARci: TGLRenderContextInfo);
7170
Sender.vec4 := ARci.GLStates.MaterialAmbient[cmFront];
7173
procedure TStandartUniformAutoSetExecutor.SetMaterialFrontDiffuse(Sender:
7174
IShaderParameter; var ARci: TGLRenderContextInfo);
7176
Sender.vec4 := ARci.GLStates.MaterialDiffuse[cmFront];
7179
procedure TStandartUniformAutoSetExecutor.SetMaterialFrontEmission(Sender:
7180
IShaderParameter; var ARci: TGLRenderContextInfo);
7182
Sender.vec4 := ARci.GLStates.MaterialEmission[cmFront];
7185
procedure TStandartUniformAutoSetExecutor.SetMaterialFrontShininess(Sender:
7186
IShaderParameter; var ARci: TGLRenderContextInfo);
7188
Sender.float := ARci.GLStates.MaterialShininess[cmFront];
7191
procedure TStandartUniformAutoSetExecutor.SetMaterialFrontSpecular(Sender:
7192
IShaderParameter; var ARci: TGLRenderContextInfo);
7194
Sender.vec4 := ARci.GLStates.MaterialSpecular[cmFront];
7197
procedure TStandartUniformAutoSetExecutor.SetModelMatrix(Sender:
7198
IShaderParameter; var ARci: TGLRenderContextInfo);
7200
Sender.mat4 := ARci.PipelineTransformation.ModelMatrix;
7203
procedure TStandartUniformAutoSetExecutor.SetModelViewMatrix(Sender:
7204
IShaderParameter; var ARci: TGLRenderContextInfo);
7206
Sender.mat4 := ARci.PipelineTransformation.ModelViewMatrix;
7209
procedure TStandartUniformAutoSetExecutor.SetNormalModelMatrix(Sender:
7210
IShaderParameter; var ARci: TGLRenderContextInfo);
7212
Sender.mat3 := ARci.PipelineTransformation.NormalModelMatrix;
7215
procedure TStandartUniformAutoSetExecutor.SetProjectionMatrix(Sender:
7216
IShaderParameter; var ARci: TGLRenderContextInfo);
7218
Sender.mat4 := ARci.PipelineTransformation.ProjectionMatrix;
7221
procedure TStandartUniformAutoSetExecutor.SetViewMatrix(Sender:
7222
IShaderParameter; var ARci: TGLRenderContextInfo);
7224
Sender.mat4 := ARci.PipelineTransformation.ViewMatrix;
7227
procedure TStandartUniformAutoSetExecutor.SetViewProjectionMatrix(Sender:
7228
IShaderParameter; var ARci: TGLRenderContextInfo);
7230
Sender.mat4 := ARci.PipelineTransformation.ViewProjectionMatrix;
7233
procedure TStandartUniformAutoSetExecutor.SetWorldViewProjectionMatrix(Sender:
7234
IShaderParameter; var ARci: TGLRenderContextInfo);
7236
Sender.mat4 := MatrixMultiply(
7237
ARci.PipelineTransformation.ModelViewMatrix,
7238
ARci.PipelineTransformation.ProjectionMatrix);
7241
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}7243
{$IFDEF GLS_REGION}{$REGION 'TGLASMVertexProgram'}{$ENDIF}7245
procedure TGLASMVertexProgram.Assign(Source: TPersistent);
7247
LProg: TGLASMVertexProgram;
7249
if Source is TGLASMVertexProgram then
7251
LProg := TGLASMVertexProgram(Source);
7252
FSource.Assign(LProg.FSource);
7257
constructor TGLASMVertexProgram.Create(AOwner: TGLXCollection);
7260
FHandle := TGLARBVertexProgramHandle.Create;
7261
FHandle.OnPrapare := DoOnPrepare;
7262
FSource := TStringList.Create;
7263
FSource.OnChange := NotifyChange;
7264
Name := TGLMatLibComponents(AOwner).MakeUniqueName('VertexProg');7267
destructor TGLASMVertexProgram.Destroy;
7274
procedure TGLASMVertexProgram.DoOnPrepare(Sender: TGLContext);
7276
if FDefferedInit and not IsDesignTime then
7279
if FHandle.IsSupported then
7281
FHandle.AllocateHandle;
7282
if FHandle.IsDataNeedUpdate then
7285
if (Length(FSourceFile) > 0) and FileStreamExists(FSourceFile) then
7286
FSource.LoadFromFile(FSourceFile);
7287
if FSource.Count > 0 then
7289
FHandle.LoadARBProgram(FSource.Text);
7290
FIsValid := FHandle.Ready;
7291
if IsDesignTime then
7293
FInfoLog := FHandle.InfoLog;
7294
if (Length(FInfoLog) = 0) and FIsValid then
7295
FInfoLog := 'Compilation successful';
7297
else if FIsValid then
7298
GLSLogger.LogInfoFmt('Program "%s" compilation successful - %s',7299
[Name, FHandle.InfoLog])
7301
GLSLogger.LogErrorFmt('Program "%s" compilation failed - %s',7302
[Name, FHandle.InfoLog]);
7303
FHandle.NotifyDataUpdated;
7307
if IsDesignTime then
7308
FInfoLog := 'No source'
7310
GLSLogger.LogInfoFmt('Program "%s" has no source code', [Name]);7318
if IsDesignTime then
7319
FInfoLog := 'Not supported by hardware';
7325
if IsDesignTime then
7326
InformationDlg(E.ClassName + ': ' + E.Message)
7328
GLSLogger.LogError(E.ClassName + ': ' + E.Message);
7333
class function TGLASMVertexProgram.FriendlyName: string;
7335
Result := 'ASM Vertex Program';
7338
function TGLASMVertexProgram.GetHandle: TGLARBVertexProgramHandle;
7343
procedure TGLASMVertexProgram.NotifyChange(Sender: TObject);
7345
FHandle.NotifyChangesOfData;
7349
procedure TGLASMVertexProgram.ReadFromFiler(AReader: TReader);
7351
archiveVersion: Integer;
7355
archiveVersion := ReadInteger;
7356
if archiveVersion = 0 then
7358
Name := ReadWideString;
7359
FDefferedInit := ReadBoolean;
7360
FSource.Text := ReadWideString;
7361
FSourceFile := ReadWideString;
7364
RaiseFilerException(archiveVersion);
7368
procedure TGLASMVertexProgram.SetSource(AValue: TStringList);
7370
FSource.Assign(AValue);
7373
procedure TGLASMVertexProgram.SetSourceFile(AValue: string);
7375
FixPathDelimiter(AValue);
7376
if FSourceFile <> AValue then
7378
FSourceFile := AValue;
7383
procedure TGLASMVertexProgram.WriteToFiler(AWriter: TWriter);
7387
WriteInteger(0); // archive version
7388
WriteWideString(Name);
7389
WriteBoolean(FDefferedInit);
7390
if Length(FSourceFile) = 0 then
7391
WriteWideString(FSource.Text)
7393
WriteWideString('');7394
WriteWideString(FSourceFile);
7398
{$IFDEF GLS_REGION}{$ENDREGION}{$ENDIF}7405
TGLFrameBufferAttachment,
7409
TGLASMVertexProgram,
7410
TGLMaterialLibraryEx,
7412
TGLShaderUniformDSA,
7413
TGLShaderUniformTexture
7416
RegisterXCollectionItemClass(TGLTextureImageEx);
7417
RegisterXCollectionItemClass(TGLTextureSampler);
7418
RegisterXCollectionItemClass(TGLFrameBufferAttachment);
7419
RegisterXCollectionItemClass(TGLTextureCombiner);
7420
RegisterXCollectionItemClass(TGLShaderEx);
7421
RegisterXCollectionItemClass(TGLASMVertexProgram);
7423
vStandartUniformAutoSetExecutor := TStandartUniformAutoSetExecutor.Create;
7427
vStandartUniformAutoSetExecutor.Destroy;