LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  Class for managing a ROAM (square) patch.
6

7
   History :  
8
   29/12/14 - PW - Fixed SafeTesselation function that caused gaps between tiles
9
   22/08/10 - DaStr - Fixed compiler warning
10
   27/07/10 - YP - Safe tesselation operation to avoid AV after a memory shift
11
   26/07/10 - YP - Invalid range test when splitting, we need to check space for n and n+1
12
   20/05/10 - Yar - Fixes for Linux x64
13
   16/10/08 - UweR - Compatibility fix for Delphi 2009
14
   30/03/07 - DaStr - Added $I GLScene.inc
15
   19/10/06 - LC - Added code to gracefully handle the case when MaxCLODTriangles is reached.
16
  It will now increase the buffer instead of not splitting. Bugtracker ID=1574111
17
   09/10/06 - Lin - Added OnMaxCLODTrianglesReached event.
18
   09/06/06 - Lin - Bugfix: Stop splitting Triangles when MaxCLODTriangles is reached (prevents Access Violations)
19
   10/06/05 - Mathx - Protection against cards that have GL_EXT_compiled_vertex_array
20
  but not GL_EXT_draw_range_elements
21
   25/04/04 - EG - Occlusion testing support
22
   06/02/03 - EG - Adaptative variance computation
23
   03/12/02 - EG - Minor ROAM tessel/render optimizations
24
   15/06/02 - EG - Fixed patch rendering bug "introduced" by TBaseList fix
25
   24/02/02 - EG - Hybrid ROAM-stripifier engine
26
   10/09/01 - EG - Creation
27
   
28
}
29
unit GLROAMPatch;
30

31
interface
32

33
{$I GLScene.inc}
34

35
uses
36
  SysUtils,
37
  GLVectorGeometry, GLHeightData, GLVectorLists, GLCrossPlatform, GLContext,
38
  OpenGLTokens, XOpenGL;
39

40
type
41

42
  // Exception use by Split for SafeTesselate
43
  EGLROAMException = class(Exception);
44

45
  // TROAMTriangleNode
46
  //
47
  PROAMTriangleNode = ^TROAMTriangleNode;
48

49
  TROAMTriangleNode = packed record
50
    base, left, right: PROAMTriangleNode;
51
    leftChild, rightChild: PROAMTriangleNode;
52
  end;
53

54
  // TROAMRenderPoint
55
  //
56
  TROAMRenderPoint = packed record
57
    X, Y: Integer;
58
    idx: Integer;
59
  end;
60

61
  // TGLROAMPatch
62
  //
63
  TGLROAMPatch = class(TObject)
64
  private
65
     
66
    FID: Integer;
67
    FHeightData: TGLHeightData; // Referred, not owned
68
    FHeightRaster: PSmallIntRaster;
69
    FTLNode, FBRNode: Integer;
70
    FTLVariance, FBRVariance: array of cardinal;
71
    FPatchSize, FTriangleCount: Integer;
72
    FListHandle: TGLListHandle;
73
    FTag: Integer;
74
    FObserverPosition: TAffineVector;
75
    FNorth, FSouth, FWest, FEast: TGLROAMPatch; // neighbours
76
    FHighRes: Boolean;
77
    FMaxDepth: Integer;
78
    FVertexScale, FVertexOffset: TAffineVector;
79
    FTextureScale, FTextureOffset: TAffineVector;
80
    FMaxTLVarianceDepth, FMaxBRVarianceDepth: Integer;
81

82
    FOcclusionQuery: TGLOcclusionQueryHandle;
83
    FOcclusionSkip, FOcclusionCounter: Integer;
84
    FLastOcclusionTestPassed: Boolean;
85

86
  protected
87
     
88
    procedure SeTGLHeightData(val: TGLHeightData);
89
    procedure SetOcclusionSkip(val: Integer);
90

91
    procedure RenderROAM(vertices: TAffineVectorList;
92
      vertexIndices: TIntegerList; texCoords: TTexPointList);
93
    procedure RenderAsStrips(vertices: TAffineVectorList;
94
      vertexIndices: TIntegerList; texCoords: TTexPointList);
95

96
    function Tesselate: boolean;
97
    // Returns false if MaxCLODTriangles limit is reached(Lin)
98
  public
99
     
100
    constructor Create;
101
    destructor Destroy; override;
102

103
    procedure ComputeVariance(variance: Integer);
104

105
    procedure ResetTessellation;
106
    procedure ConnectToTheWest(westPatch: TGLROAMPatch);
107
    procedure ConnectToTheNorth(northPatch: TGLROAMPatch);
108

109
    { : AV free version of Tesselate.
110
      When IncreaseTrianglesCapacity is called, all PROAMTriangleNode
111
      values in higher function became invalid due to the memory shifting.
112
      Recursivity is the main problem, that's why SafeTesselate is calling
113
      Tesselate in a try..except . }
114
    function SafeTesselate: boolean;
115

116
    { : Render the patch in high-resolution.
117
      The lists are assumed to have enough capacity to allow AddNC calls
118
      (additions without capacity check). High-resolution renders use
119
      display lists, and are assumed to be made together. }
120
    procedure RenderHighRes(vertices: TAffineVectorList;
121
      vertexIndices: TIntegerList; texCoords: TTexPointList;
122
      forceROAM: Boolean);
123
    { : Render the patch by accumulating triangles.
124
      The lists are assumed to have enough capacity to allow AddNC calls
125
      (additions without capacity check). 
126
      Once at least autoFlushVertexCount vertices have been accumulated,
127
      perform a FlushAccum }
128
    procedure RenderAccum(vertices: TAffineVectorList;
129
      vertexIndices: TIntegerList; texCoords: TTexPointList;
130
      autoFlushVertexCount: Integer);
131
    { : Render all vertices accumulated in the arrays and set their count
132
      back to zero. }
133
    class procedure FlushAccum(vertices: TAffineVectorList;
134
      vertexIndices: TIntegerList; texCoords: TTexPointList);
135

136
    property HeightData: TGLHeightData read FHeightData write SeTGLHeightData;
137
    property VertexScale: TAffineVector read FVertexScale write FVertexScale;
138
    property VertexOffset: TAffineVector read FVertexOffset write FVertexOffset;
139

140
    property ObserverPosition: TAffineVector read FObserverPosition
141
      write FObserverPosition;
142

143
    property TextureScale: TAffineVector read FTextureScale write FTextureScale;
144
    property TextureOffset: TAffineVector read FTextureOffset
145
      write FTextureOffset;
146

147
    property HighRes: Boolean read FHighRes write FHighRes;
148

149
    { : Number of frames to skip after an occlusion test returned zero pixels. }
150
    property OcclusionSkip: Integer read FOcclusionSkip write SetOcclusionSkip;
151
    { : Number of frames remaining to next occlusion test. }
152
    property OcclusionCounter: Integer read FOcclusionCounter
153
      write FOcclusionCounter;
154
    { : Result for the last occlusion test.
155
      Note that this value is updated upon rendering the tile in
156
      non-high-res mode only. }
157
    property LastOcclusionTestPassed: Boolean read FLastOcclusionTestPassed;
158

159
    property ID: Integer read FID;
160
    property TriangleCount: Integer read FTriangleCount;
161
    property Tag: Integer read FTag write FTag;
162
  end;
163

164
  { : Specifies the maximum number of ROAM triangles that may be allocated. }
165
procedure SetROAMTrianglesCapacity(nb: Integer);
166
function GetROAMTrianglesCapacity: Integer;
167

168
// ------------------------------------------------------------------
169
// ------------------------------------------------------------------
170
// ------------------------------------------------------------------
171
implementation
172

173
// ------------------------------------------------------------------
174
// ------------------------------------------------------------------
175
// ------------------------------------------------------------------
176

177
var
178
  FVBOVertHandle, FVBOTexHandle: TGLVBOArrayBufferHandle;
179
  FVBOIndicesHandle: TGLVBOElementArrayHandle;
180

181
type
182

183
  // TROAMVariancePoint
184
  //
185
  TROAMVariancePoint = packed record
186
    X, Y: Integer;
187
    Z: Integer;
188
  end;
189

190
var
191
  vNextPatchID: Integer;
192
  vNbTris, vTriangleNodesCapacity: Integer;
193
  vTriangleNodes: array of TROAMTriangleNode;
194

195
  // SetROAMTrianglesCapacity
196

197
procedure SetROAMTrianglesCapacity(nb: Integer);
198
begin
199
  vNbTris := 0;
200
  if vTriangleNodesCapacity <> nb then
201
  begin
202
    SetLength(vTriangleNodes, nb);
203
    vTriangleNodesCapacity := nb;
204
  end;
205
end;
206

207
function GetROAMTrianglesCapacity: Integer;
208
begin
209
  Result := vTriangleNodesCapacity;
210
end;
211

212
// The result is the delta between the old address of the array and the new one
213
function IncreaseTrianglesCapacity(NewCapacity: Integer): int64;
214

215
  procedure FixNodePtr(var p: PROAMTriangleNode; const delta: int64);
216
  begin
217
    if p = nil then
218
      exit;
219

220
    Inc(PByte(p), delta);
221
  end;
222

223
var
224
  oldbase, newbase: pointer;
225
  node: PROAMTriangleNode;
226
  i, oldsize: Integer;
227
begin
228
  Result := 0;
229
  if NewCapacity <= vTriangleNodesCapacity then
230
    exit;
231

232
  oldsize := vTriangleNodesCapacity;
233

234
  oldbase := pointer(vTriangleNodes);
235
  SetLength(vTriangleNodes, NewCapacity);
236

237
  vTriangleNodesCapacity := NewCapacity;
238

239
  newbase := pointer(vTriangleNodes);
240

241
  // Array has not been relocated, no need to fix
242
  if oldbase = newbase then
243
    exit;
244

245
  // go through all the old nodes and fix the pointers
246
  // YP: Delphi needs int64 dual casting to avoid overflow exception
247
  Result := int64(PtrUInt(newbase)) - int64(PtrUInt(oldbase));
248
  for i := 0 to oldsize - 1 do
249
  begin
250
    node := @vTriangleNodes[i];
251

252
    FixNodePtr(node^.base, Result);
253
    FixNodePtr(node^.left, Result);
254
    FixNodePtr(node^.right, Result);
255
    FixNodePtr(node^.leftChild, Result);
256
    FixNodePtr(node^.rightChild, Result);
257
  end;
258
end;
259

260
// AllocTriangleNode
261
//
262
function AllocTriangleNode: Integer;
263
var
264
  nilNode: PROAMTriangleNode;
265
begin
266
  if vNbTris >= vTriangleNodesCapacity then
267
  begin
268
    // grow by 50%
269
    IncreaseTrianglesCapacity(vTriangleNodesCapacity +
270
      (vTriangleNodesCapacity shr 1));
271
  end;
272
  Result := vNbTris;
273
  with vTriangleNodes[vNbTris] do
274
  begin
275
    nilNode := nil;
276
    left := nilNode;
277
    right := nilNode;
278
    leftChild := nilNode;
279
    rightChild := nilNode;
280
  end;
281
  Inc(vNbTris);
282
end;
283

284
// Split
285
//
286
function Split(tri: PROAMTriangleNode): Boolean;
287
var
288
  n: Integer;
289
  lc, rc: PROAMTriangleNode;
290
  Shift: int64;
291
begin
292
  Result := Assigned(tri.leftChild);
293
  if Result then
294
    exit; // dont split if tri already has a left child
295
  with tri^ do 
296
  begin 
297
    if Assigned(base) and (base.base <> tri) then
298
	  Split(base);
299
   // If this triangle is not in a proper diamond, force split our base neighbor
300
    n := vNbTris;
301
  end;
302

303
  if n >= vTriangleNodesCapacity - 1 then
304
  begin
305
    // grow by 50%
306
    Shift := IncreaseTrianglesCapacity(vTriangleNodesCapacity +
307
      (vTriangleNodesCapacity shr 1));
308
    if Shift <> 0 then
309
    begin
310
      raise EGLROAMException.Create
311
        ('PROAMTriangleNode addresses are invalid now');
312
    end;
313
  end;
314

315
  with tri^ do
316
  begin
317

318
    // Create children and cross-link them
319
    lc := @vTriangleNodes[n]; // left child
320
    rc := @vTriangleNodes[n + 1]; // right child
321

322
    leftChild := lc;
323
    rightChild := rc;
324

325
    rc.base := right; // right child
326
    rc.leftChild := nil;
327
    rc.rightChild := leftChild;
328
    rc.right := leftChild;
329

330
    lc.base := left; // left child
331
    lc.leftChild := nil;
332
    lc.rightChild := leftChild;
333
    lc.left := rightChild;
334

335
    Inc(vNbTris, 2);
336

337
    if Assigned(left) then // Link our Left Neighbour to the new children
338
      if left.base = tri then
339
        left.base := lc
340
      else if left.left = tri then
341
        left.left := lc
342
      else
343
        left.right := lc;
344
    if Assigned(right) then // Link our Right Neighbour to the new children
345
      if right.base = tri then
346
        right.base := rc
347
      else if right.left = tri then
348
        right.left := rc
349
      else
350
        right.right := rc;
351
    // Link our Base Neighbor to the new children
352
    if Assigned(base) then
353
    begin
354
      if Assigned(base.leftChild) then
355
      begin
356
        base.leftChild.right := rightChild;
357
        rightChild.left := base.leftChild;
358
        base.rightChild.left := leftChild;
359
        leftChild.right := base.rightChild;
360
      end
361
      else
362
        Split(base);
363
    end
364
    else
365
    begin // An edge triangle, trivial case.
366
      leftChild.right := nil;
367
      rightChild.left := nil;
368
    end;
369
  end;
370
  Result := True;
371
end;
372

373

374
// ------------------
375
// ------------------ TGLROAMPatch ------------------
376
// ------------------
377

378
// Create
379
//
380
constructor TGLROAMPatch.Create;
381
begin
382
  inherited Create;
383
  FID := vNextPatchID;
384
  Inc(vNextPatchID);
385
  FListHandle := TGLListHandle.Create;
386
  FOcclusionQuery := TGLOcclusionQueryHandle.Create;
387
end;
388

389
// Destroy
390
//
391
destructor TGLROAMPatch.Destroy;
392
begin
393
  FListHandle.Free;
394
  FOcclusionQuery.Free;
395
  inherited Destroy;
396
end;
397

398
// SeTGLHeightData
399
//
400
procedure TGLROAMPatch.SeTGLHeightData(val: TGLHeightData);
401
begin
402
  FHeightData := val;
403
  FPatchSize := FHeightData.Size - 1;
404
  FHeightRaster := val.SmallIntRaster;
405
end;
406

407
// SetOcclusionSkip
408
//
409
procedure TGLROAMPatch.SetOcclusionSkip(val: Integer);
410
begin
411
  if val < 0 then
412
    val := 0;
413
  if FOcclusionSkip <> val then
414
  begin
415
    FOcclusionSkip := val;
416
    FOcclusionQuery.DestroyHandle;
417
  end;
418
end;
419

420
// ConnectToTheWest
421
//
422
procedure TGLROAMPatch.ConnectToTheWest(westPatch: TGLROAMPatch);
423
begin
424
  if Assigned(westPatch) then
425
  begin
426
    if not(westPatch.HighRes or HighRes) then
427
    begin
428
      vTriangleNodes[FTLNode].left := @vTriangleNodes[westPatch.FBRNode];
429
      vTriangleNodes[westPatch.FBRNode].left := @vTriangleNodes[FTLNode];
430
    end;
431
    FWest := westPatch;
432
    westPatch.FEast := Self;
433
  end;
434
end;
435

436
// ConnectToTheNorth
437
//
438
procedure TGLROAMPatch.ConnectToTheNorth(northPatch: TGLROAMPatch);
439
begin
440
  if Assigned(northPatch) then
441
  begin
442
    if not(northPatch.HighRes or HighRes) then
443
    begin
444
      vTriangleNodes[FTLNode].right := @vTriangleNodes[northPatch.FBRNode];
445
      vTriangleNodes[northPatch.FBRNode].right := @vTriangleNodes[FTLNode];
446
    end;
447
    FNorth := northPatch;
448
    northPatch.FSouth := Self;
449
  end;
450
end;
451

452
// ComputeVariance
453
//
454
procedure TGLROAMPatch.ComputeVariance(variance: Integer);
455
var
456
  raster: PSmallIntRaster;
457
  currentVariance: PIntegerArray;
458
  maxVarianceDepth: Integer;
459
  maxNonNullIndex: Integer;
460
  invVariance: Single;
461

462
  function ROAMVariancePoint(anX, anY: Integer): TROAMVariancePoint;
463
  begin
464
    Result.X := anX;
465
    Result.Y := anY;
466
    Result.Z := (Integer(FHeightRaster[anY][anX]) shl 8);
467
  end;
468

469
  function RecursComputeVariance(const left, right, apex: TROAMVariancePoint;
470
    node: Integer): Cardinal;
471
  var
472
    half: TROAMVariancePoint;
473
    v: Cardinal;
474
    n2: Integer;
475
  begin
476
    with half do
477
    begin
478
      X := (left.X + right.X) shr 1;
479
      Y := (left.Y + right.Y) shr 1;
480
      Z := Integer(raster[Y][X]) shl 8;
481
      Result := ScaleAndRound(Abs(((left.Z + right.Z) div 2) - Z), invVariance);
482
    end;
483

484
    n2 := node shl 1;
485
    if n2 < maxVarianceDepth then
486
    begin
487
      v := RecursComputeVariance(apex, left, half, n2);
488
      if v > Result then
489
        Result := v;
490
      v := RecursComputeVariance(right, apex, half, 1 + n2);
491
      if v > Result then
492
        Result := v;
493
    end;
494
    currentVariance[node] := Result;
495
  end;
496

497
  procedure ScaleVariance(n, d: Integer);
498
  var
499
    newVal: Integer;
500
  begin
501
    if d >= 0 then
502
      newVal := (currentVariance[n] shl (d shr 1))
503
    else
504
      newVal := (currentVariance[n] shr (-d shr 1));
505
    currentVariance[n] := newVal;
506
    if newVal > 0 then
507
      if n > maxNonNullIndex then
508
        maxNonNullIndex := n;
509
    n := n shl 1;
510
    if n < maxVarianceDepth then
511
    begin
512
      Dec(d);
513
      ScaleVariance(n, d);
514
      ScaleVariance(n + 1, d);
515
    end;
516
  end;
517

518
var
519
  s, p: Integer;
520
begin
521
  invVariance := 1 / variance;
522
  s := Sqr(FPatchSize);
523
  raster := FHeightRaster;
524
  FMaxDepth := 1;
525
  p := -1 - 8;
526
  repeat
527
    FMaxDepth := FMaxDepth shl 2;
528
    Inc(p);
529
  until FMaxDepth >= s;
530
  maxVarianceDepth := FMaxDepth;
531
  SetLength(FTLVariance, maxVarianceDepth);
532
  SetLength(FBRVariance, maxVarianceDepth);
533

534
  s := FPatchSize;
535
  currentVariance := @FTLVariance[0];
536
  maxNonNullIndex := 1;
537
  RecursComputeVariance(ROAMVariancePoint(0, s), ROAMVariancePoint(s, 0),
538
    ROAMVariancePoint(0, 0), 1);
539
  ScaleVariance(1, p);
540
  FMaxTLVarianceDepth := maxNonNullIndex + 1;
541
  SetLength(FTLVariance, FMaxTLVarianceDepth);
542
  currentVariance := @FBRVariance[0];
543
  maxNonNullIndex := 1;
544
  RecursComputeVariance(ROAMVariancePoint(s, 0), ROAMVariancePoint(0, s),
545
    ROAMVariancePoint(s, s), 1);
546
  ScaleVariance(1, p);
547
  FMaxBRVarianceDepth := maxNonNullIndex + 1;
548
  SetLength(FBRVariance, FMaxBRVarianceDepth);
549
end;
550

551
// ResetTessellation
552
//
553
procedure TGLROAMPatch.ResetTessellation;
554
begin
555
  FTLNode := AllocTriangleNode;
556
  FBRNode := AllocTriangleNode;
557
  vTriangleNodes[FTLNode].base := @vTriangleNodes[FBRNode];
558
  vTriangleNodes[FBRNode].base := @vTriangleNodes[FTLNode];
559
  FNorth := nil;
560
  FSouth := nil;
561
  FWest := nil;
562
  FEast := nil;
563
end;
564

565
// Tessellate
566
//
567
var
568
  tessMaxVariance: Cardinal;
569
  tessMaxDepth: Cardinal;
570
  tessCurrentVariance: PIntegerArray;
571
  tessObserverPosX, tessObserverPosY: Integer;
572

573
function RecursTessellate(tri: PROAMTriangleNode; n: cardinal;
574
  const left, right, apex: cardinal): boolean;
575
// returns false if tessellation failed due to MaxCLODTriangles limit
576
var
577
  d: Integer;
578
begin
579
  Result := True;
580
  d := ((left + right) shr 1);
581
  if tessCurrentVariance[n] > d then
582
  begin
583
    Result := False;
584
    if Split(tri) then
585
    begin
586
      n := n shl 1;
587
      if n < tessMaxVariance then
588
      begin
589
        RecursTessellate(tri.leftChild, n, apex, left, d);
590
        Result := RecursTessellate(tri.rightChild, n + 1, right, apex, d);
591
      end;
592
    end;
593
  end;
594
end;
595

596
function TGLROAMPatch.Tesselate: boolean;
597
// Returns false if MaxCLODTriangles limit is reached.
598
var
599
  tessFrameVarianceDelta: Integer;
600

601
  function VertexDist(X, Y: Integer): cardinal;
602
  var
603
    f: Single;
604
  const
605
    c1Div100: Single = 0.01;
606
  begin
607
    if HighRes then
608
      f := 0.2 * Sqr(FPatchSize)
609
    else
610
      f := Sqr(X - tessObserverPosX) + Sqr(Y - tessObserverPosY) +
611
        tessFrameVarianceDelta;
612
    Result := Round(Sqrt(f) + f * c1Div100);
613
  end;
614

615
procedure FullBaseTess(tri: PROAMTriangleNode; n: Cardinal); forward;
616

617
  procedure FullLeftTess(tri: PROAMTriangleNode; n: Cardinal);
618
  begin
619
    if Split(tri) then
620
    begin
621
      n := n shl 1;
622
      if n < tessMaxDepth then
623
        FullBaseTess(tri.leftChild, n);
624
    end;
625
  end;
626

627
  procedure FullRightTess(tri: PROAMTriangleNode; n: Cardinal);
628
  begin
629
    if Split(tri) then
630
    begin
631
      n := n shl 1;
632
      if n < tessMaxDepth then
633
        FullBaseTess(tri.rightChild, n);
634
    end;
635
  end;
636

637
  procedure FullBaseTess(tri: PROAMTriangleNode; n: Cardinal);
638
  begin
639
    if Split(tri) then
640
    begin
641
      n := n shl 1;
642
      if n < tessMaxDepth then
643
      begin
644
        FullRightTess(tri.leftChild, n);
645
        FullLeftTess(tri.rightChild, n);
646
      end;
647
    end;
648
  end;
649

650
var
651
  s: Integer;
652
begin
653
  tessMaxDepth := FMaxDepth;
654
  tessObserverPosX := Round(FObserverPosition.X);
655
  tessObserverPosY := Round(FObserverPosition.Y);
656

657
  if HighRes then
658
  begin
659
    FullRightTess(@vTriangleNodes[FTLNode], 1);
660
    FullRightTess(@vTriangleNodes[FBRNode], 1);
661
    FullLeftTess(@vTriangleNodes[FBRNode], 1);
662
    FullLeftTess(@vTriangleNodes[FTLNode], 1);
663
    tessFrameVarianceDelta := 0;
664
  end
665
  else
666
  begin
667
    if Assigned(FNorth) and FNorth.HighRes then
668
      FullRightTess(@vTriangleNodes[FTLNode], 1);
669
    if Assigned(FSouth) and FSouth.HighRes then
670
      FullRightTess(@vTriangleNodes[FBRNode], 1);
671
    if Assigned(FEast) and FEast.HighRes then
672
      FullLeftTess(@vTriangleNodes[FBRNode], 1);
673
    if Assigned(FWest) and FWest.HighRes then
674
      FullLeftTess(@vTriangleNodes[FTLNode], 1);
675
    if FObserverPosition.v[2] > 0 then
676
      tessFrameVarianceDelta := Round(Sqr(FObserverPosition.Z * (1 / 16)))
677
    else
678
      tessFrameVarianceDelta := 0;
679
  end;
680
  s := FPatchSize;
681
  tessCurrentVariance := @FTLVariance[0];
682
  tessMaxVariance := FMaxTLVarianceDepth;
683
  Result := RecursTessellate(@vTriangleNodes[FTLNode], 1, VertexDist(0, s),
684
    VertexDist(s, 0), VertexDist(0, 0));
685
  tessCurrentVariance := @FBRVariance[0];
686
  tessMaxVariance := FMaxBRVarianceDepth;
687
  if Result then
688
    Result := RecursTessellate(@vTriangleNodes[FBRNode], 1, VertexDist(s, 0),
689
      VertexDist(0, s), VertexDist(s, s));
690
end;
691

692

693
// SafeTesselate
694

695
function TGLROAMPatch.SafeTesselate: boolean;
696
var
697
  Fail: boolean;
698
begin
699
  Result := False;
700
  Fail := True;
701
  repeat
702
    try
703
      //ResetTessellation; <- creates gaps between tiles
704
      Result := Tesselate;
705
      Fail := False;
706
    except
707
      on e: EGLROAMException do
708
      begin
709
        // Nothing to do, just wait the next iteration
710
        Fail := True;
711
      end;
712
    end;
713
  until not Fail;
714
end;
715

716
// RenderHighRes
717
//
718
procedure TGLROAMPatch.RenderHighRes(vertices: TAffineVectorList;
719
  vertexIndices: TIntegerList; texCoords: TTexPointList; forceROAM: Boolean);
720
var
721
  primitive: TGLEnum;
722
begin
723
  // Prepare display list if needed
724
  if FListHandle.Handle = 0 then
725
  begin
726
    // either use brute-force strips or a high-res static tesselation
727
    if forceROAM then
728
    begin
729
      SafeTesselate;
730
      RenderROAM(vertices, vertexIndices, texCoords);
731
      primitive := GL_TRIANGLES;
732
      FTriangleCount := vertexIndices.Count div 3;
733
    end
734
    else
735
    begin
736
      RenderAsStrips(vertices, vertexIndices, texCoords);
737
      primitive := GL_TRIANGLE_STRIP;
738
      FTriangleCount := vertexIndices.Count - 2 * FPatchSize;
739
    end;
740

741
    vertices.Translate(VertexOffset);
742
    texCoords.ScaleAndTranslate(PTexPoint(@TextureScale)^,
743
      PTexPoint(@TextureOffset)^);
744

745
    GL.VertexPointer(3, GL_FLOAT, 0, vertices.List);
746
    xgl.TexCoordPointer(2, GL_FLOAT, 0, texCoords.List);
747

748
    FListHandle.AllocateHandle;
749
    GL.NewList(FListHandle.Handle, GL_COMPILE);
750
    GL.DrawElements(primitive, vertexIndices.Count, GL_UNSIGNED_INT,
751
      vertexIndices.List);
752
    GL.EndList;
753

754
    vertices.Count := 0;
755
    texCoords.Count := 0;
756
    vertexIndices.Count := 0;
757
  end;
758
  // perform the render
759
  GL.CallList(FListHandle.Handle);
760
end;
761

762
// RenderAccum
763
//
764
procedure TGLROAMPatch.RenderAccum(vertices: TAffineVectorList;
765
  vertexIndices: TIntegerList; texCoords: TTexPointList;
766
  autoFlushVertexCount: Integer);
767
var
768
  occlusionPassed: Boolean;
769
  n, nb, nvi: Integer;
770
begin
771
  // CLOD tiles are rendered via ROAM
772
  if (FOcclusionSkip > 0) and FOcclusionQuery.IsSupported then
773
  begin
774
    if FOcclusionQuery.Handle = 0 then
775
    begin
776
      FOcclusionQuery.AllocateHandle;
777
      FOcclusionCounter := -(ID mod (FOcclusionSkip));
778
    end;
779
    occlusionPassed := (FOcclusionCounter <= 0) or
780
      (FOcclusionQuery.PixelCount > 0);
781
    Dec(FOcclusionCounter);
782
    if occlusionPassed then
783
    begin
784
      if FOcclusionCounter <= 0 then
785
        Inc(FOcclusionCounter, FOcclusionSkip);
786
      FOcclusionQuery.BeginQuery;
787
    end;
788
  end
789
  else
790
    occlusionPassed := True;
791
  FLastOcclusionTestPassed := occlusionPassed;
792
  if occlusionPassed then
793
  begin
794
    nvi := vertexIndices.Count;
795
    n := vertices.Count;
796
    RenderROAM(vertices, vertexIndices, texCoords);
797
    nb := vertices.Count - n;
798
    FTriangleCount := (vertexIndices.Count - nvi) div 3;
799

800
    vertices.Translate(VertexOffset, n, nb);
801
    texCoords.ScaleAndTranslate(PTexPoint(@TextureScale)^,
802
      PTexPoint(@TextureOffset)^, n, nb);
803

804
    if FOcclusionQuery.Active then
805
    begin
806
      FlushAccum(vertices, vertexIndices, texCoords);
807
      FOcclusionQuery.EndQuery;
808
    end
809
    else if vertexIndices.Count > autoFlushVertexCount then
810
      FlushAccum(vertices, vertexIndices, texCoords);
811
  end
812
  else
813
    FTriangleCount := 0;
814
end;
815

816
// FlushAccum
817
//
818
class procedure TGLROAMPatch.FlushAccum(vertices: TAffineVectorList;
819
  vertexIndices: TIntegerList; texCoords: TTexPointList);
820
begin
821
  if vertexIndices.Count = 0 then
822
    Exit;
823

824
  if GL.ARB_vertex_buffer_object then
825
  begin
826
    FVBOVertHandle.AllocateHandle;
827
    FVBOVertHandle.BindBufferData(vertices.List, vertices.DataSize,
828
      GL_STREAM_DRAW_ARB);
829
    GL.VertexPointer(3, GL_FLOAT, 0, nil);
830

831
    FVBOTexHandle.AllocateHandle;
832
    FVBOTexHandle.BindBufferData(texCoords.List, texCoords.DataSize,
833
      GL_STREAM_DRAW_ARB);
834
    xgl.TexCoordPointer(2, GL_FLOAT, 0, nil);
835

836
    GL.DrawRangeElements(GL_TRIANGLES, 0, vertices.Count - 1,
837
      vertexIndices.Count, GL_UNSIGNED_INT, vertexIndices.List);
838
    GL.BindBuffer(GL_ARRAY_BUFFER_ARB, 0);
839
    GL.BindBuffer(GL_ELEMENT_ARRAY_BUFFER_ARB, 0);
840
  end
841
  else if GL.EXT_compiled_vertex_array and GL.EXT_draw_range_elements then
842
  begin
843
    GL.LockArrays(0, vertices.Count);
844
    GL.DrawRangeElements(GL_TRIANGLES, 0, vertices.Count - 1,
845
      vertexIndices.Count, GL_UNSIGNED_INT, vertexIndices.List);
846
    GL.UnLockArrays;
847
  end
848
  else
849
  begin
850
    GL.DrawElements(GL_TRIANGLES, vertexIndices.Count, GL_UNSIGNED_INT,
851
      vertexIndices.List);
852
  end;
853
  vertices.Count := 0;
854
  texCoords.Count := 0;
855
  vertexIndices.Count := 0;
856
end;
857

858
// RenderROAM
859
//
860
var
861
  renderRaster: PSmallIntRaster;
862
  renderIndices: PIntegerArray;
863
  renderVertices: TAffineVectorList;
864
  renderTexCoords: TTexPointList;
865

866
procedure RecursRender(const tri: PROAMTriangleNode;
867
  const left, right, apex: TROAMRenderPoint);
868
var
869
  half: TROAMRenderPoint;
870
  localIndices: PIntegerArray;
871
begin
872
  if Assigned(tri.leftChild) then
873
  begin // = if node is split
874
    half.Y := (left.Y + right.Y) shr 1;
875
    half.X := (left.X + right.X) shr 1;
876
    renderTexCoords.AddNC(@half.X);
877
    half.idx := renderVertices.AddNC(@half.X, renderRaster[half.Y][half.X]);
878
    RecursRender(tri.leftChild, apex, left, half);
879
    RecursRender(tri.rightChild, right, apex, half);
880
  end
881
  else
882
  begin
883
    localIndices := renderIndices;
884
    localIndices[0] := left.idx;
885
    localIndices[1] := apex.idx;
886
    localIndices[2] := right.idx;
887
    renderIndices := PIntegerArray(@localIndices[3]);
888
  end;
889
end;
890

891
procedure TGLROAMPatch.RenderROAM(vertices: TAffineVectorList;
892
  vertexIndices: TIntegerList; texCoords: TTexPointList);
893

894
  procedure ROAMRenderPoint(var p: TROAMRenderPoint; anX, anY: Integer);
895
  begin
896
    p.X := anX;
897
    p.Y := anY;
898
    p.idx := vertices.Add(anX, anY, renderRaster[anY][anX]);
899
    texCoords.Add(anX, anY);
900
  end;
901

902
var
903
  rtl, rtr, rbl, rbr: TROAMRenderPoint;
904
begin
905
  renderVertices := vertices;
906
  renderTexCoords := texCoords;
907
  vertexIndices.AdjustCapacityToAtLeast(Sqr(FPatchSize) * 6 + 15000);
908
  // this is required, the actual item count is maintained out of the list scope
909
  vertexIndices.SetCountResetsMemory := False;
910
  renderIndices := @vertexIndices.List[vertexIndices.Count];
911

912
  renderRaster := FHeightData.SmallIntRaster;
913

914
  ROAMRenderPoint(rtl, 0, 0);
915
  ROAMRenderPoint(rtr, FPatchSize, 0);
916
  ROAMRenderPoint(rbl, 0, FPatchSize);
917
  ROAMRenderPoint(rbr, FPatchSize, FPatchSize);
918

919
  RecursRender(@vTriangleNodes[FTLNode], rbl, rtr, rtl);
920
  RecursRender(@vTriangleNodes[FBRNode], rtr, rbl, rbr);
921

922
  vertexIndices.Count := (PtrUInt(renderIndices) - PtrUInt(vertexIndices.List))
923
    div SizeOf(Integer);
924
end;
925

926
// RenderAsStrips
927
//
928
procedure TGLROAMPatch.RenderAsStrips(vertices: TAffineVectorList;
929
  vertexIndices: TIntegerList; texCoords: TTexPointList);
930

931
var
932
  X, Y, baseTop, rowLength: Integer;
933
  p: TAffineVector;
934
  row: PSmallIntArray;
935
  raster: PSmallIntRaster;
936
  tex: TTexPoint;
937
  verticesList: PAffineVector;
938
  texCoordsList: PTexPoint;
939
  indicesList: PInteger;
940
begin
941
  raster := FHeightData.SmallIntRaster;
942
  rowLength := FPatchSize + 1;
943
  // prepare vertex data
944
  vertices.Count := Sqr(rowLength);
945
  verticesList := PAffineVector(vertices.List);
946
  texCoords.Count := Sqr(rowLength);
947
  texCoordsList := PTexPoint(texCoords.List);
948
  for Y := 0 to FPatchSize do
949
  begin
950
    p.Y := Y;
951
    tex.T := p.Y;
952
    row := raster[Y];
953
    for X := 0 to FPatchSize do
954
    begin
955
      p.X := X;
956
      tex.s := p.X;
957
      p.Z := row[X];
958
      verticesList^ := p;
959
      Inc(verticesList);
960
      texCoordsList^ := tex;
961
      Inc(texCoordsList);
962
    end;
963
  end;
964
  // build indices list
965
  baseTop := 0;
966
  vertexIndices.Count := (rowLength * 2 + 2) * FPatchSize - 1;
967
  indicesList := PInteger(vertexIndices.List);
968
  Y := 0;
969
  while Y < FPatchSize do
970
  begin
971
    if Y > 0 then
972
    begin
973
      indicesList^ := baseTop + FPatchSize;
974
      Inc(indicesList);
975
    end;
976
    for X := baseTop + FPatchSize downto baseTop do
977
    begin
978
      indicesList^ := X;
979
      PIntegerArray(indicesList)[1] := rowLength + X;
980
      Inc(indicesList, 2);
981
    end;
982
    indicesList^ := baseTop + rowLength;
983
    Inc(baseTop, rowLength);
984
    PIntegerArray(indicesList)[1] := baseTop + rowLength;
985
    Inc(indicesList, 2);
986
    for X := baseTop to baseTop + FPatchSize do
987
    begin
988
      indicesList^ := rowLength + X;
989
      PIntegerArray(indicesList)[1] := X;
990
      Inc(indicesList, 2);
991
    end;
992
    indicesList^ := baseTop + FPatchSize;
993
    Inc(indicesList);
994
    Inc(baseTop, rowLength);
995
    Inc(Y, 2);
996
  end;
997
  vertexIndices.Count := vertexIndices.Count - 1;
998
end;
999

1000
// ------------------------------------------------------------------
1001
// ------------------------------------------------------------------
1002
// ------------------------------------------------------------------
1003
initialization
1004

1005
// ------------------------------------------------------------------
1006
// ------------------------------------------------------------------
1007
// ------------------------------------------------------------------
1008

1009
FVBOVertHandle := TGLVBOArrayBufferHandle.Create;
1010
FVBOTexHandle := TGLVBOArrayBufferHandle.Create;
1011
FVBOIndicesHandle := TGLVBOElementArrayHandle.Create;
1012

1013
finalization
1014

1015
FVBOVertHandle.Free;
1016
FVBOTexHandle.Free;
1017
FVBOIndicesHandle.Free;
1018

1019
SetROAMTrianglesCapacity(0);
1020

1021
end.
1022