LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
    This unit provides support for two new types of "multisample
6
    textures" - two-dimensional and two-dimensional array - as well as
7
    mechanisms to fetch a specific sample from such a texture in a shader,
8
    and to attach such textures to FBOs for rendering.
9

10
    History :  
11
       04/11/10- DaStr - Added $I GLScene.inc   
12
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
13
       16/05/10 - Yar - Creation (thanks to C4)
14
    
15
}
16
unit GLMultisampleImage;
17

18
interface
19

20
{$I GLScene.inc}
21

22
uses
23
  Classes,
24
  OpenGLTokens,
25
  GLContext,
26
  GLTexture,
27
  GLGraphics,
28
  GLTextureFormat;
29

30
type
31

32
  // TGLMultisampleImage
33
  //
34
  TGLMultisampleImage = class(TGLTextureImage)
35
  private
36
     
37
    FBitmap: TGLBitmap32;
38
    FSamplesCount: Integer;
39
    FWidth, FHeight, FDepth: Integer;
40
    FFixedSamplesLocation: Boolean;
41
    procedure SetWidth(val: Integer);
42
    procedure SetHeight(val: Integer);
43
    procedure SetDepth(val: Integer);
44
    procedure SetSamplesCount(val: Integer);
45
    procedure SetFixedSamplesLocation(val: Boolean);
46
  protected
47
     
48
    function GetWidth: Integer; override;
49
    function GetHeight: Integer; override;
50
    function GetDepth: Integer; override;
51
    function GetTextureTarget: TGLTextureTarget; override;
52
  public
53
     
54
    constructor Create(AOwner: TPersistent); override;
55
    destructor Destroy; override;
56

57
    procedure Assign(Source: TPersistent); override;
58

59
    class function IsSelfLoading: Boolean; override;
60
    procedure LoadTexture(AInternalFormat: TGLInternalFormat); override;
61
    function GetBitmap32: TGLBitmap32; override;
62
    procedure ReleaseBitmap32; override;
63

64
    procedure SaveToFile(const fileName: string); override;
65
    procedure LoadFromFile(const fileName: string); override;
66
    class function FriendlyName: string; override;
67
    class function FriendlyDescription: string; override;
68

69
    property NativeTextureTarget;
70

71
  published
72
     
73
    { Width of the blank image (for memory allocation). }
74
    property Width: Integer read GetWidth write SetWidth default 256;
75
    { Width of the blank image (for memory allocation). }
76
    property Height: Integer read GetHeight write SetHeight default 256;
77
    property Depth: Integer read GetDepth write SetDepth default 0;
78
    property SamplesCount: Integer read FSamplesCount write SetSamplesCount
79
      default 0;
80
    property FixedSamplesLocation: Boolean read FFixedSamplesLocation write
81
      SetFixedSamplesLocation;
82
  end;
83

84
implementation
85

86
// ------------------
87
// ------------------ TGLMultisampleImage ------------------
88
// ------------------
89

90
{$IFDEF GLS_REGIONS}{$REGION 'TGLMultisampleImage'}{$ENDIF}
91

92
// Create
93
//
94

95
constructor TGLMultisampleImage.Create(AOwner: TPersistent);
96
begin
97
  inherited;
98
  FWidth := 256;
99
  FHeight := 256;
100
  FDepth := 0;
101
  FSamplesCount := 0;
102
end;
103

104
// Destroy
105
//
106

107
destructor TGLMultisampleImage.Destroy;
108
begin
109
  ReleaseBitmap32;
110
  inherited Destroy;
111
end;
112

113
 
114
//
115

116
procedure TGLMultisampleImage.Assign(Source: TPersistent);
117
begin
118
  if Assigned(Source) then
119
  begin
120
    if (Source is TGLMultisampleImage) then
121
    begin
122
      FWidth := TGLMultisampleImage(Source).FWidth;
123
      FHeight := TGLMultisampleImage(Source).FHeight;
124
      FDepth := TGLMultisampleImage(Source).FDepth;
125
      FSamplesCount := TGLMultisampleImage(Source).FSamplesCount;
126
      Invalidate;
127
    end
128
    else
129
      inherited;
130
  end
131
  else
132
    inherited;
133
end;
134

135
// SetWidth
136
//
137

138
procedure TGLMultisampleImage.SetWidth(val: Integer);
139
begin
140
  if val <> FWidth then
141
  begin
142
    FWidth := val;
143
    if FWidth < 1 then
144
      FWidth := 1;
145
    Invalidate;
146
  end;
147
end;
148

149
// GetWidth
150
//
151

152
function TGLMultisampleImage.GetWidth: Integer;
153
begin
154
  Result := FWidth;
155
end;
156

157
// SetHeight
158
//
159

160
procedure TGLMultisampleImage.SetHeight(val: Integer);
161
begin
162
  if val <> FHeight then
163
  begin
164
    FHeight := val;
165
    if FHeight < 1 then
166
      FHeight := 1;
167
    Invalidate;
168
  end;
169
end;
170

171
// GetHeight
172
//
173

174
function TGLMultisampleImage.GetHeight: Integer;
175
begin
176
  Result := FHeight;
177
end;
178

179
// GetDepth
180
//
181

182
function TGLMultisampleImage.GetDepth: Integer;
183
begin
184
  Result := FDepth;
185
end;
186

187
// SetHeight
188
//
189

190
procedure TGLMultisampleImage.SetDepth(val: Integer);
191
begin
192
  if val <> FDepth then
193
  begin
194
    FDepth := val;
195
    if FDepth < 0 then
196
      FDepth := 0;
197
    Invalidate;
198
  end;
199
end;
200

201
// SetSamplesCount
202
//
203

204
procedure TGLMultisampleImage.SetSamplesCount(val: Integer);
205
begin
206
  if val < 0 then
207
    val := 0;
208

209
  if val <> FSamplesCount then
210
  begin
211
    FSamplesCount := val;
212
    Invalidate;
213
  end;
214
end;
215

216
// SetFixedSamplesLocation
217
//
218

219
procedure TGLMultisampleImage.SetFixedSamplesLocation(val: Boolean);
220
begin
221
  if val <> FFixedSamplesLocation then
222
  begin
223
    FFixedSamplesLocation := val;
224
    Invalidate;
225
  end;
226
end;
227

228
// GetBitmap32
229
//
230

231
function TGLMultisampleImage.GetBitmap32: TGLBitmap32;
232
begin
233
  if not Assigned(FBitmap) then
234
  begin
235
    FBitmap := TGLBitmap32.Create;
236
    FBitmap.Blank := true;
237
    FBitmap.Width := FWidth;
238
    FBitmap.Height := FHeight;
239
  end;
240
  Result := FBitmap;
241
end;
242

243
// ReleaseBitmap32
244
//
245

246
procedure TGLMultisampleImage.ReleaseBitmap32;
247
begin
248
  FBitmap.Free;
249
  FBitmap := nil;
250
end;
251

252
// SaveToFile
253
//
254

255
procedure TGLMultisampleImage.SaveToFile(const fileName: string);
256
begin
257
end;
258

259
 
260
//
261

262
procedure TGLMultisampleImage.LoadFromFile(const fileName: string);
263
begin
264
end;
265

266
 
267
//
268

269
class function TGLMultisampleImage.FriendlyName: string;
270
begin
271
  Result := 'Multisample Image';
272
end;
273

274
// FriendlyDescription
275
//
276

277
class function TGLMultisampleImage.FriendlyDescription: string;
278
begin
279
  Result := 'Image for rendering to texture with antialiasing';
280
end;
281

282
// GetTextureTarget
283
//
284

285
function TGLMultisampleImage.GetTextureTarget: TGLTextureTarget;
286
begin
287
  if fDepth > 0 then
288
    Result := ttTexture2DMultisampleArray
289
  else
290
    Result := ttTexture2DMultisample;
291
end;
292

293
class function TGLMultisampleImage.IsSelfLoading: Boolean;
294
begin
295
  Result := True;
296
end;
297

298
procedure TGLMultisampleImage.LoadTexture(AInternalFormat: TGLInternalFormat);
299
var
300
  target: TGLTextureTarget;
301
  maxSamples, maxSize: TGLint;
302
begin
303
  // Check smaples count range
304
  GL.GetIntegerv(GL_MAX_SAMPLES, @maxSamples);
305
  if FSamplesCount > maxSamples then
306
    FSamplesCount := maxSamples;
307
  if IsDepthFormat(AInternalFormat) then
308
  begin
309
    GL.GetIntegerv(GL_MAX_DEPTH_TEXTURE_SAMPLES, @maxSamples);
310
    if FSamplesCount > maxSamples then
311
      FSamplesCount := maxSamples;
312
  end
313
  else
314
  begin
315
    GL.GetIntegerv(GL_MAX_COLOR_TEXTURE_SAMPLES, @maxSamples);
316
    if FSamplesCount > maxSamples then
317
      FSamplesCount := maxSamples;
318
  end;
319
  // Check texture size
320
  GL.GetIntegerv(GL_MAX_TEXTURE_SIZE, @maxSize);
321
  if FWidth > maxSize then
322
    FWidth := maxSize;
323
  if FHeight > maxSize then
324
    FHeight := maxSize;
325

326
  target := NativeTextureTarget;
327
  case target of
328

329
    ttTexture2DMultisample:
330
      GL.TexImage2DMultisample(
331
        DecodeGLTextureTarget(target),
332
        SamplesCount,
333
        InternalFormatToOpenGLFormat(AInternalFormat),
334
        Width,
335
        Height,
336
        FFixedSamplesLocation);
337

338
    ttTexture2DMultisampleArray:
339
      GL.TexImage3DMultisample(
340
        DecodeGLTextureTarget(target),
341
        SamplesCount,
342
        InternalFormatToOpenGLFormat(AInternalFormat),
343
        Width,
344
        Height,
345
        Depth,
346
        FFixedSamplesLocation);
347
  end;
348
end;
349

350
{$IFDEF GLS_REGIONS}{$ENDREGION}{$ENDIF}
351

352
initialization
353
  RegisterGLTextureImageClass(TGLMultisampleImage);
354

355
end.