LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   A scene object encapsulating the OpenGL feedback buffer.
6

7
   This object, when Active, will render it's children using
8
   the GL_FEEDBACK render mode. This will render the children
9
   into the feedback Buffer rather than into the frame buffer.
10

11
   Mesh data can be extracted from the buffer using the
12
   BuildMeshFromBuffer procedure. For custom parsing of the
13
   buffer use the Buffer SingleList. The Buffered property
14
   will indicate if there is valid data in the buffer.
15

16
    History :  
17
       10/11/12 - PW - Added CPP compatibility: changed vector arrays to records
18
       01/03/11 - Yar - Added Colors list to BuildMeshFromBuffer
19
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
20
       15/06/10 - Yar - Bugfixed face culling on in feedback mode drawing (thanks Radli)
21
       22/04/10 - Yar - Fixes after GLState revision
22
       05/03/10 - DanB - More state added to TGLStateCache
23
       30/03/07 - DaStr - Added $I GLScene.inc
24
       28/03/07 - DaStr - Renamed parameters in some methods
25
                            (thanks Burkhard Carstens) (Bugtracker ID = 1678658)
26
       23/07/04 - SG - Creation.
27
    
28

29
}
30
unit GLFeedback;
31

32
interface
33

34
{$I GLScene.inc}
35

36
uses
37
  Classes, SysUtils,
38
   
39
  GLVectorGeometry, GLVectorLists, GLScene, GLVectorFileObjects,
40
  GLTexture, GLRenderContextInfo, GLContext, GLState, OpenGLTokens,
41
  GLMeshUtils
42
  , GLVectorTypes;
43

44
type
45
  TFeedbackMode = (fm2D, fm3D, fm3DColor, fm3DColorTexture, fm4DColorTexture);
46

47
  // TGLFeedback
48
  { An object encapsulating the OpenGL feedback rendering mode. }
49
  TGLFeedback = class(TGLBaseSceneObject)
50
  private
51
     
52
    FActive: Boolean;
53
    FBuffer: TSingleList;
54
    FMaxBufferSize: Cardinal;
55
    FBuffered: Boolean;
56
    FCorrectionScaling: Single;
57
    FMode: TFeedbackMode;
58

59
  protected
60
     
61
    procedure SetMaxBufferSize(const Value: Cardinal);
62
    procedure SetMode(const Value: TFeedbackMode);
63

64
  public
65
     
66
    constructor Create(AOwner: TComponent); override;
67
    destructor Destroy; override;
68

69
    procedure DoRender(var ARci: TGLRenderContextInfo;
70
      ARenderSelf, ARenderChildren: Boolean); override;
71

72
    { Parse the the feedback buffer for polygon data and build
73
       a mesh into the assigned lists. }
74
    procedure BuildMeshFromBuffer(
75
      Vertices: TAffineVectorList = nil;
76
      Normals: TAffineVectorList = nil;
77
      Colors: TVectorList = nil;
78
      TexCoords: TAffineVectorList = nil;
79
      VertexIndices: TIntegerList = nil);
80

81
    // True when there is data in the buffer ready for parsing
82
    property Buffered: Boolean read FBuffered;
83

84
    // The feedback buffer
85
    property Buffer: TSingleList read FBuffer;
86

87
    { Vertex positions in the buffer needs to be scaled by
88
       CorrectionScaling to get correct coordinates. }
89
    property CorrectionScaling: Single read FCorrectionScaling;
90

91
  published
92
     
93

94
    // Maximum size allocated for the feedback buffer
95
    property MaxBufferSize: Cardinal read FMaxBufferSize write SetMaxBufferSize;
96
    // Toggles the feedback rendering
97
    property Active: Boolean read FActive write FActive;
98
    // The type of data that is collected in the feedback buffer
99
    property Mode: TFeedbackMode read FMode write SetMode;
100

101
    property Visible;
102
  end;
103

104
  // ----------------------------------------------------------------------
105
  // ----------------------------------------------------------------------
106
  // ----------------------------------------------------------------------
107
implementation
108
// ----------------------------------------------------------------------
109
// ----------------------------------------------------------------------
110
// ----------------------------------------------------------------------
111

112
// ----------
113
// ---------- TGLFeedback ----------
114
// ----------
115

116
// Create
117
//
118

119
constructor TGLFeedback.Create(AOwner: TComponent);
120
begin
121
  inherited;
122

123
  FMaxBufferSize := $100000;
124
  FBuffer := TSingleList.Create;
125
  FBuffer.Capacity := FMaxBufferSize div SizeOf(Single);
126
  FBuffered := False;
127
  FActive := False;
128
  FMode := fm3DColorTexture;
129
end;
130

131
// Destroy
132
//
133

134
destructor TGLFeedback.Destroy;
135
begin
136
  FBuffer.Free;
137

138
  inherited;
139
end;
140

141
// DoRender
142
//
143

144
procedure TGLFeedback.DoRender(var ARci: TGLRenderContextInfo;
145
  ARenderSelf, ARenderChildren: Boolean);
146

147
  function RecursChildRadius(obj: TGLBaseSceneObject): Single;
148
  var
149
    i: Integer;
150
    childRadius: Single;
151
  begin
152
    childRadius := 0;
153
    Result := obj.BoundingSphereRadius + VectorLength(obj.AbsolutePosition);
154
    for i := 0 to obj.Count - 1 do
155
      childRadius := RecursChildRadius(obj.Children[i]);
156
    if childRadius > Result then
157
      Result := childRadius;
158
  end;
159

160
var
161
  i: integer;
162
  radius: Single;
163
  atype: cardinal;
164
begin
165
  FBuffer.Count := 0;
166
  try
167
    if (csDesigning in ComponentState) or not Active then
168
      exit;
169
    if not ARenderChildren then
170
      exit;
171

172
    FCorrectionScaling := 1.0;
173
    for i := 0 to Count - 1 do
174
    begin
175
      radius := RecursChildRadius(Children[i]);
176
      if radius > FCorrectionScaling then
177
        FCorrectionScaling := radius + 1e-5;
178
    end;
179

180
    case FMode of
181
      fm2D: aType := GL_2D;
182
      fm3D: aType := GL_3D;
183
      fm3DColor: aType := GL_3D_COLOR;
184
      fm3DColorTexture: aType := GL_3D_COLOR_TEXTURE;
185
      fm4DColorTexture: aType := GL_4D_COLOR_TEXTURE;
186
    else
187
      aType := GL_3D_COLOR_TEXTURE;
188
    end;
189

190
    FBuffer.Count := FMaxBufferSize div SizeOf(Single);
191
    GL.FeedBackBuffer(FMaxBufferSize, atype, @FBuffer.List[0]);
192
    ARci.GLStates.Disable(stCullFace);
193
    ARci.ignoreMaterials := FMode < fm3DColor;
194
    ARci.PipelineTransformation.Push;
195
    ARci.PipelineTransformation.ProjectionMatrix := IdentityHmgMatrix;
196
    ARci.PipelineTransformation.ViewMatrix :=
197
      CreateScaleMatrix(VectorMake(
198
        1.0 / FCorrectionScaling,
199
        1.0 / FCorrectionScaling,
200
        1.0 / FCorrectionScaling));
201
    ARci.GLStates.ViewPort := Vector4iMake(-1, -1, 2, 2);
202
    GL.RenderMode(GL_FEEDBACK);
203

204
    Self.RenderChildren(0, Count - 1, ARci);
205

206
    FBuffer.Count := GL.RenderMode(GL_RENDER);
207
    ARci.PipelineTransformation.Pop;
208

209
  finally
210
    ARci.ignoreMaterials := False;
211
    FBuffered := (FBuffer.Count > 0);
212
    if ARenderChildren then
213
      Self.RenderChildren(0, Count - 1, ARci);
214
  end;
215
  ARci.GLStates.ViewPort :=
216
    Vector4iMake(0, 0, ARci.viewPortSize.cx, ARci.viewPortSize.cy);
217
end;
218

219
// BuildMeshFromBuffer
220
//
221

222
procedure TGLFeedback.BuildMeshFromBuffer(
223
  Vertices: TAffineVectorList = nil;
224
  Normals: TAffineVectorList = nil;
225
  Colors: TVectorList = nil;
226
  TexCoords: TAffineVectorList = nil;
227
  VertexIndices: TIntegerList = nil);
228
var
229
  value: Single;
230
  i, j, LCount, skip: Integer;
231
  vertex, color, texcoord: TVector;
232
  tempVertices, tempNormals, tempTexCoords: TAffineVectorList;
233
  tempColors: TVectorList;
234
  tempIndices: TIntegerList;
235
  ColorBuffered, TexCoordBuffered: Boolean;
236
begin
237
  Assert(FMode <> fm2D, 'Cannot build mesh from fm2D feedback mode.');
238

239
  tempVertices := TAffineVectorList.Create;
240
  tempColors := TVectorList.Create;
241
  tempTexCoords := TAffineVectorList.Create;
242

243
  ColorBuffered := (FMode = fm3DColor) or
244
    (FMode = fm3DColorTexture) or
245
    (FMode = fm4DColorTexture);
246
  TexCoordBuffered := (FMode = fm3DColorTexture) or
247
    (FMode = fm4DColorTexture);
248

249
  i := 0;
250

251
  skip := 3;
252
  if FMode = fm4DColorTexture then
253
    Inc(skip, 1);
254
  if ColorBuffered then
255
    Inc(skip, 4);
256
  if TexCoordBuffered then
257
    Inc(skip, 4);
258

259
  while i < FBuffer.Count - 1 do
260
  begin
261
    value := FBuffer[i];
262
    if value = GL_POLYGON_TOKEN then
263
    begin
264
      Inc(i);
265
      value := FBuffer[i];
266
      LCount := Round(value);
267
      Inc(i);
268
      if LCount = 3 then
269
      begin
270
        for j := 0 to 2 do
271
        begin
272
          vertex.V[0] := FBuffer[i];
273
          Inc(i);
274
          vertex.V[1] := FBuffer[i];
275
          Inc(i);
276
          vertex.V[2] := FBuffer[i];
277
          Inc(i);
278
          if FMode = fm4DColorTexture then
279
            Inc(i);
280
          if ColorBuffered then
281
          begin
282
            color.V[0] := FBuffer[i];
283
            Inc(i);
284
            color.V[1] := FBuffer[i];
285
            Inc(i);
286
            color.V[2] := FBuffer[i];
287
            Inc(i);
288
            color.V[3] := FBuffer[i];
289
            Inc(i);
290
          end;
291
          if TexCoordBuffered then
292
          begin
293
            texcoord.V[0] := FBuffer[i];
294
            Inc(i);
295
            texcoord.V[1] := FBuffer[i];
296
            Inc(i);
297
            texcoord.V[2] := FBuffer[i];
298
            Inc(i);
299
            texcoord.V[3] := FBuffer[i];
300
            Inc(i);
301
          end;
302

303
          vertex.V[2] := 2 * vertex.V[2] - 1;
304
          ScaleVector(vertex, FCorrectionScaling);
305

306
          tempVertices.Add(AffineVectorMake(vertex));
307
          tempColors.Add(color);
308
          tempTexCoords.Add(AffineVectorMake(texcoord));
309
        end;
310
      end
311
      else
312
      begin
313
        Inc(i, skip * LCount);
314
      end;
315
    end
316
    else
317
    begin
318
      Inc(i);
319
    end;
320
  end;
321

322
  if Assigned(VertexIndices) then
323
  begin
324
    tempIndices := BuildVectorCountOptimizedIndices(tempVertices, nil, nil);
325
    RemapAndCleanupReferences(tempVertices, tempIndices);
326
    VertexIndices.Assign(tempIndices);
327
  end
328
  else
329
  begin
330
    tempIndices := TIntegerList.Create;
331
    tempIndices.AddSerie(0, 1, tempVertices.Count);
332
  end;
333

334
  tempNormals := BuildNormals(tempVertices, tempIndices);
335

336
  if Assigned(Vertices) then
337
    Vertices.Assign(tempVertices);
338
  if Assigned(Normals) then
339
    Normals.Assign(tempNormals);
340
  if Assigned(Colors) and ColorBuffered then
341
    Colors.Assign(tempColors);
342
  if Assigned(TexCoords) and TexCoordBuffered then
343
    TexCoords.Assign(tempTexCoords);
344

345
  tempVertices.Destroy;
346
  tempNormals.Destroy;
347
  tempColors.Destroy;
348
  tempTexCoords.Destroy;
349
  tempIndices.Destroy;
350
end;
351

352
// SetMaxBufferSize
353
//
354

355
procedure TGLFeedback.SetMaxBufferSize(const Value: Cardinal);
356
begin
357
  if Value <> FMaxBufferSize then
358
  begin
359
    FMaxBufferSize := Value;
360
    FBuffered := False;
361
    FBuffer.Count := 0;
362
    FBuffer.Capacity := FMaxBufferSize div SizeOf(Single);
363
  end;
364
end;
365

366
// SetMode
367
//
368

369
procedure TGLFeedback.SetMode(const Value: TFeedbackMode);
370
begin
371
  if Value <> FMode then
372
  begin
373
    FMode := Value;
374
    FBuffered := False;
375
    FBuffer.Count := 0;
376
  end;
377
end;
378

379
initialization
380

381
  RegisterClasses([TGLFeedback]);
382

383
end.
384

385