LZScene

Форк
0
/
GLOctree.pas 
1703 строки · 50.1 Кб
1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  Octree management classes and structures.
6

7
  TODO: move the many public vars/fields to private/protected
8

9
   History :  
10
   10/11/14 - PW - Renamed from "Octree.pas" to "GLOctree.pas" and added ListHandle in TOctreeNode
11
   10/11/12 - PW - Added CPP compatibility: changed vector arrays to records
12
   30/03/07 - DaStr - Added $I GLScene.inc
13
   28/03/07 - DaStr - Renamed parameters in some methods
14
                        (thanks Burkhard Carstens) (Bugtracker ID = 1678658)
15
   24/03/07 - DaStr - Added explicit pointer dereferencing
16
                        (thanks Burkhard Carstens) (Bugtracker ID = 1678644)
17
   02/08/04 - LR, YHC - BCB corrections: use record instead array
18
   19/06/04 - LucasG - Moved triangleFiler and WalkSphereToLeaf to public
19
   31/01/04 - Mathx - Bugfix on DisposeTree (thanks dikoe Kanguru)
20
   20/07/03 - DanB - Modified SphereSweepIntersect to deal with embedded spheres better
21
   08/05/03 - DanB - name changes + added ClosestPointOnTriangle + fixes
22
   08/05/03 - DanB - added AABBIntersect (Matheus Degiovani)
23
   22/01/03 - EG - GetTrianglesInCube moved in (Bernd Klaiber)
24
   29/11/02 - EG - Added triangleInfo
25
   14/07/02 - EG - Dropped GLvectorFileObjects dependency
26
   17/03/02 - EG - Added SphereIntersectAABB from Robert Hayes
27
   13/03/02 - EG - Made in a standalone unit, based on Robert Hayes code
28
   
29
}
30
unit GLOctree;
31

32
interface
33

34
{$I GLScene.inc}
35

36
uses
37
  Classes,
38
  GLVectorTypes, GLVectorGeometry, GLVectorLists, GLGeometryBB, GLContext;
39

40
type
41

42
  TProcInt = procedure(I: Integer) of object;
43
  TProcAffineAffineAffine = procedure(V1, V2, V3: TAffineFLTVector) of object;
44

45
  // TOctreeTriangleInfo
46
  //
47
  { : Stores information about an intersected triangle. }
48
  TOctreeTriangleInfo = record
49
    Index: Integer;
50
    Vertex: array [0 .. 2] of TAffineVector;
51
  end;
52

53
  POctreeTriangleInfo = ^TOctreeTriangleInfo;
54

55
  // TOctreeNode
56
  //
57
  POctreeNode = ^TOctreeNode;
58

59
  TOctreeNode = record
60
    MinExtent: TAffineFLTVector;
61
    MaxExtent: TAffineFLTVector;
62
    // TextureHandle:TGLTextureHandle;
63
    ListHandle: TGLListHandle;
64
    WillDraw: Boolean; // temporary change
65

66
    // Duplicates possible?
67
    TriArray: array of Integer; // array of triangle references
68

69
    ChildArray: array [0 .. 7] of POctreeNode; // Octree's 8 children
70
  end;
71

72
  // TOctree
73
  //
74
  { : Manages an Octree containing references to triangles. }
75
  TOctree = class(TObject)
76
  private
77
     
78
{$IFDEF DEBUG}
79
    Intersections: Integer;
80
    // for debugging  - number of triangles intersecting an AABB plane
81
{$ENDIF}
82
  protected
83
     
84
    // Find the exact centre of an AABB
85
    function GetMidPoint(Min, Max: Single): Single;
86
    // Check if a point lies within the AABB specified by min and max entents
87
    function PointInNode(const Min, Max, APoint: TAffineFLTVector): Boolean;
88
    // Check if a triangle (vertices v1, v2, v3) lies within the AABB specified by min and max entents
89
    function TriIntersectNode(const MinExtent, MaxExtent, V1, V2,
90
      V3: TAffineFLTVector): BOOLEAN;
91
    // Check if a sphere (at point C with radius) lies within the AABB specified by min and max entents
92
    function SphereInNode(const MinExtent, MaxExtent: TAffineVector;
93
      const C: TVector; Radius: Single): Boolean;
94

95
    procedure WalkTriToLeafx(Onode: POctreeNode;
96
      const V1, V2, V3: TAffineFLTVector);
97
    procedure WalkPointToLeafx(ONode: POctreeNode; const P: TAffineVector);
98
    procedure WalkSphereToLeafx(Onode: POctreeNode; const P: TVector;
99
      Radius: Single);
100
    procedure WalkRayToLeafx(Onode: POctreeNode; const P, V: TVector);
101

102
    function GetExtent(const Flags: array of Byte; ParentNode: POctreeNode)
103
      : TAffineFLTVector;
104

105
    { : Recursive routine to build nodes from parent to max depth level. }
106
    procedure Refine(ParentNode: POctreeNode; Level: Integer);
107

108
    // Main "walking" routines.  Walks the item through the Octree down to a leaf node.
109
    procedure WalkPointToLeaf(ONode: POctreeNode; const P: TAffineVector);
110
    procedure WalkTriToLeaf(Onode: POctreeNode;
111
      const V1, V2, V3: TAffineVector);
112
    procedure WalkRayToLeaf(Onode: POctreeNode; const P, V: TVector);
113

114
    // : Example of how to process each node in the tree
115
    procedure ConvertR4(ONode: POctreeNode; const Scale: TAffineFLTVector);
116

117
    procedure CreateTree(Depth: Integer);
118
    procedure CutMesh;
119

120
  public
121
     
122
    WorldMinExtent, WorldMaxExtent: TAffineFLTVector;
123
    RootNode: POctreeNode; // always points to root node
124
    MaxOlevel: Integer; // max depth level of TOctreeNode
125
    NodeCount: Integer;
126
    // number of nodes (ex: 8 for level 1, 72 for level 2 etc).
127
    TriCountMesh: Integer; // total number of triangles in the mesh
128
    TriCountOctree: Integer; // total number of triangles cut into the octree
129
    MeshCount: Integer; // number of meshes currently cut into the Octree
130

131
    ResultArray: array of POctreeNode;
132
    // holds the result nodes of various calls
133

134
    { 19/06/2004 - Lucas G. - Needed this change - Used in ECMisc.pas }
135
    TriangleFiler: TAffineVectorList;
136
    procedure WalkSphereToLeaf(Onode: POctreeNode; const P: TVector;
137
      Radius: Single);
138

139
    { : Initializes the tree from the triangle list.
140
      All triangles must be contained in the world extent to be properly
141
      taken into account. }
142
    procedure InitializeTree(const AWorldMinExtent, AWorldMaxExtent
143
      : TAffineVector; const ATriangles: TAffineVectorList;
144
      const ATreeDepth: Integer);
145
    procedure DisposeTree;
146

147
    destructor Destroy; override;
148

149
    function RayCastIntersect(const RayStart, RayVector: TVector;
150
      IntersectPoint: PVector = nil; IntersectNormal: PVector = nil;
151
      TriangleInfo: POctreeTriangleInfo = nil): Boolean;
152
    function SphereSweepIntersect(const RayStart, RayVector: TVector;
153
      const Velocity, Radius: Single; IntersectPoint: PVector = nil;
154
      IntersectNormal: PVector = nil): Boolean;
155

156
    function TriangleIntersect(const V1, V2, V3: TAffineVector): Boolean;
157
    { : Returns all triangles in the AABB. }
158
    function GetTrianglesFromNodesIntersectingAABB(const ObjAABB: TAABB)
159
      : TAffineVectorList;
160
    { : Returns all triangles in an arbitrarily placed cube }
161
    function GetTrianglesFromNodesIntersectingCube(const ObjAABB: TAABB;
162
      const ObjToSelf, SelfToObj: TMatrix): TAffineVectorList;
163
    { : Checks if an AABB intersects a face on the octree }
164
    function AABBIntersect(const AABB: TAABB; M1to2, M2to1: TMatrix;
165
      Triangles: TAffineVectorList = nil): Boolean;
166
    // function SphereIntersect(position:TAffineVector; radius:single);
167
  end;
168

169
  // ------------------------------------------------------------------
170
  // ------------------------------------------------------------------
171
  // ------------------------------------------------------------------
172
implementation
173

174
// ------------------------------------------------------------------
175
// ------------------------------------------------------------------
176
// ------------------------------------------------------------------
177

178
// ----------------------------------------------------------------------
179
// Name  : CheckPointInSphere()
180
// Input : point - point we wish to check for inclusion
181
// sO - Origin of sphere
182
// sR - radius of sphere
183
// Notes :
184
// Return: TRUE if point is in sphere, FALSE if not.
185
// -----------------------------------------------------------------------
186

187
function CheckPointInSphere(const Point, SO: TVector; const SR: Single)
188
  : Boolean;
189
begin
190
  // Allow small margin of error
191
  Result := (VectorDistance2(Point, SO) <= Sqr(SR));
192
end;
193

194
// ----------------------------------------------------------------------
195
// Name  : CheckPointInTriangle()
196
// Input : point - point we wish to check for inclusion
197
// a - first vertex in triangle
198
// b - second vertex in triangle
199
// c - third vertex in triangle
200
// Notes : Triangle should be defined in clockwise order a,b,c
201
// Return: TRUE if point is in triangle, FALSE if not.
202
// -----------------------------------------------------------------------
203

204
function CheckPointInTriangle(Point, A, B, C: TAffineVector): Boolean;
205
var
206
  Total_angles: Single;
207
  V1, V2, V3: TAffineVector;
208
begin
209
  Total_angles := 0;
210

211
  // make the 3 vectors
212
  V1 := VectorSubtract(Point, A);
213
  V2 := VectorSubtract(Point, B);
214
  V3 := VectorSubtract(Point, C);
215

216
  NormalizeVector(V1);
217
  NormalizeVector(V2);
218
  NormalizeVector(V3);
219

220
  Total_angles := Total_angles + Arccos(VectorDotProduct(V1, V2));
221
  Total_angles := Total_angles + Arccos(VectorDotProduct(V2, V3));
222
  Total_angles := Total_angles + Arccos(VectorDotProduct(V3, V1));
223

224
  if (Abs(Total_angles - 2 * PI) <= 0.005) then
225
    Result := TRUE
226
  else
227
    Result := FALSE;
228
end;
229

230
// ----------------------------------------------------------------------
231
// Name  : ClosestPointOnLine()
232
// Input : a - first end of line segment
233
// b - second end of line segment
234
// p - point we wish to find closest point on line from
235
// Notes : Helper function for closestPointOnTriangle()
236
// Return: closest point on line segment
237
// -----------------------------------------------------------------------
238

239
function ClosestPointOnLine(const A, B, P: TAffineVector): TAffineVector;
240
var
241
  D, T: Double;
242
  C, V: TAffineFLTVector;
243
begin
244
  VectorSubtract(P, A, C);
245
  VectorSubtract(B, A, V);
246

247
  D := VectorLength(V);
248
  NormalizeVector(V);
249
  T := VectorDotProduct(V, C);
250

251
  // Check to see if t is beyond the extents of the line segment
252
  if (T < 0.0) then
253
    Result := A
254
  else if (T > D) then
255
    Result := B
256
  else
257
  begin
258
    V.X := V.X * T;
259
    V.Y := V.Y * T;
260
    V.Z := V.Z * T;
261
    Result := VectorAdd(A, V);
262
  end;
263
end;
264

265
// ----------------------------------------------------------------------
266
// Name  : ClosestPointOnTriangle()
267
// Input : a - first vertex in triangle
268
// b - second vertex in triangle
269
// c - third vertex in triangle
270
// p - point we wish to find closest point on triangle from
271
// Notes :
272
// Return: closest point on triangle
273
// -----------------------------------------------------------------------
274
{
275
  function ClosestPointOnTriangle(const a, b, c, n, p: TAffineVector): TAffineVector;
276
  var
277
  dAB, dBC, dCA : Single;
278
  Rab, Rbc, Rca, intPoint : TAffineFLTVector;
279
  hit:boolean;
280
  begin
281
  //this would be faster if RayCastTriangleIntersect detected backwards hits
282
  hit:=RayCastTriangleIntersect(VectorMake(p),VectorMake(n),a,b,c,@intPoint) or
283
  RayCastTriangleIntersect(VectorMake(p),VectorMake(VectorNegate(n)),a,b,c,@intPoint);
284
  if (hit) then
285
  begin
286
  Result:=intPoint;
287
  end
288
  else
289
  begin
290
  Rab:=ClosestPointOnLine(a, b, p);
291
  Rbc:=ClosestPointOnLine(b, c, p);
292
  Rca:=ClosestPointOnLine(c, a, p);
293

294
  dAB:=VectorDistance2(p, Rab);
295
  dBC:=VectorDistance2(p, Rbc);
296
  dCA:=VectorDistance2(p, Rca);
297

298
  if dBC<dAB then
299
  if dCA<dBC then
300
  Result:=Rca
301
  else Result:=Rbc
302
  else if dCA<dAB then
303
  Result:=Rca
304
  else Result:=Rab;
305
  end;
306
  end;
307
}
308

309
// ----------------------------------------------------------------------
310
// Name  : ClosestPointOnTriangleEdge()
311
// Input : a - first vertex in triangle
312
// b - second vertex in triangle
313
// c - third vertex in triangle
314
// p - point we wish to find closest point on triangle from
315
// Notes :
316
// Return: closest point on line triangle edge
317
// -----------------------------------------------------------------------
318

319
function ClosestPointOnTriangleEdge(const A, B, C, P: TAffineVector)
320
  : TAffineVector;
321
var
322
  DAB, DBC, DCA: Single;
323
  Rab, Rbc, Rca: TAffineFLTVector;
324
begin
325
  Rab := ClosestPointOnLine(A, B, P);
326
  Rbc := ClosestPointOnLine(B, C, P);
327
  Rca := ClosestPointOnLine(C, A, P);
328

329
  DAB := VectorDistance2(P, Rab);
330
  DBC := VectorDistance2(P, Rbc);
331
  DCA := VectorDistance2(P, Rca);
332

333
  if DBC < DAB then
334
    if DCA < DBC then
335
      Result := Rca
336
    else
337
      Result := Rbc
338
  else if DCA < DAB then
339
    Result := Rca
340
  else
341
    Result := Rab;
342
end;
343

344
// HitBoundingBox
345
//
346
function HitBoundingBox(const MinB, MaxB: TAffineFLTVector;
347
  const Origin, Dir: TVector; var Coord: TVector): BOOLEAN;
348
const
349
  NUMDIM = 2;
350
  RIGHT = 0;
351
  LEFT = 1;
352
  MIDDLE = 2;
353
var
354
  I, Whichplane: Integer;
355
  Inside: BOOLEAN;
356
  Quadrant: array [0 .. NUMDIM] of Byte;
357
  MaxT: array [0 .. NUMDIM] of Double;
358
  CandidatePlane: array [0 .. NUMDIM] of Double;
359

360
begin
361
  Inside := TRUE;
362

363
  // Find candidate planes; this loop can be avoided if
364
  // rays cast all from the eye(assume perpsective view)
365
  for I := 0 to NUMDIM do
366
  begin
367
    if (Origin.V[I] < MinB.V[I]) then
368
    begin
369
      Quadrant[I] := LEFT;
370
      CandidatePlane[I] := MinB.V[I];
371
      Inside := FALSE;
372
    end
373
    else if (Origin.V[I] > MaxB.V[I]) then
374
    begin
375
      Quadrant[I] := RIGHT;
376
      CandidatePlane[I] := MaxB.V[I];
377
      Inside := FALSE;
378
    end
379
    else
380
      Quadrant[I] := MIDDLE;
381
  end;
382

383
  // * Ray origin inside bounding box */
384
  if Inside then
385
  begin
386
    SetVector(Coord, Origin);
387
    Result := TRUE;
388
    Exit;
389
  end;
390

391
  // * Calculate T distances to candidate planes */
392
  for I := 0 to NUMDIM do
393
  begin
394
    if (Quadrant[I] <> MIDDLE) AND (Dir.V[I] <> 0) then
395
      MaxT[I] := (CandidatePlane[I] - Origin.V[I]) / Dir.V[I]
396
    else
397
      MaxT[I] := -1;
398
  end;
399

400
  // * Get largest of the maxT's for final choice of intersection */
401
  WhichPlane := 0;
402
  for I := 1 to NUMDIM do
403
    if (MaxT[WhichPlane] < MaxT[I]) then
404
      WhichPlane := I;
405

406
  // * Check final candidate actually inside box */
407
  if (MaxT[WhichPlane] < 0) then
408
  begin
409
    Result := FALSE;
410
    Exit;
411
  end;
412

413
  for I := 0 to NUMDIM do
414
  begin
415
    if WhichPlane <> I then
416
    begin
417
      Coord.V[I] := Origin.V[I] + MaxT[WhichPlane] * Dir.V[I];
418
      if (Coord.V[I] < MinB.V[I]) OR (Coord.V[I] > MaxB.V[I])
419
      then
420
      begin
421
        Result := FALSE;
422
        Exit;
423
      end;
424
    end
425
    else
426
      Coord.V[I] := CandidatePlane[I];
427
  end;
428

429
  Result := TRUE; // * ray hits box */
430

431
end;
432

433
const
434
  USE_EPSILON_TEST = TRUE;
435
  EPSILON = 0.000001;
436

437
  // coplanar_tri_tri
438
  //
439
function Coplanar_tri_tri(const N, V0, V1, V2, U0, U1,
440
  U2: TAffineFLTVEctor): Integer;
441
var
442
  A: TAffineFLTVector;
443
  I0, I1: Shortint;
444

445
  function EDGE_AGAINST_TRI_EDGES(const V0, V1, U0, U1,
446
    U2: TAffineFLTVector): Integer;
447
  var
448
    Ax, Ay, Bx, By, Cx, Cy, E, D, F: Single;
449

450
    // * this edge to edge test is based on Franlin Antonio's gem:
451
    // "Faster Line Segment Intersection", in Graphics Gems III,
452
    // pp. 199-202 */
453
    function EDGE_EDGE_TEST(const V0, U0, U1: TAffineFLTVector): Integer;
454
    begin
455
      Result := 0;
456
      Bx := U0.V[I0] - U1.V[I0];
457
      By := U0.V[I1] - U1.V[I1];
458
      Cx := V0.V[I0] - U0.V[I0];
459
      Cy := V0.V[I1] - U0.V[I1];
460
      F := Ay * Bx - Ax * By;
461
      D := By * Cx - Bx * Cy;
462
      if ((F > 0) and (D >= 0) and (D <= F)) or
463
        ((F < 0) and (D <= 0) and (D >= F)) then
464
      begin
465
        E := Ax * Cy - Ay * Cx;
466
        if (F > 0) then
467
        begin
468
          if (E >= 0) and (E <= F) then
469
            Result := 1
470
        end
471
        else if (E <= 0) and (E >= F) then
472
          Result := 1;
473
      end;
474
    end;
475

476
  begin
477
    Ax := V1.V[I0] - V0.V[I0];
478
    Ay := V1.V[I1] - V0.V[I1];
479
    // * test edge U0,U1 against V0,V1 */
480
    Result := EDGE_EDGE_TEST(V0, U0, U1);
481
    if Result = 1 then
482
      Exit;
483
    // * test edge U1,U2 against V0,V1 */
484
    Result := EDGE_EDGE_TEST(V0, U1, U2);
485
    if Result = 1 then
486
      Exit;
487
    // * test edge U2,U1 against V0,V1 */
488
    Result := EDGE_EDGE_TEST(V0, U2, U0);
489
  end;
490

491
  function POINT_IN_TRI(const V0, U0, U1, U2: TAffineFLTVector): Integer;
492
  var
493
    A, B, C, D0, D1, D2: Single;
494
  begin
495
    Result := 0;
496
    // * is T1 completly inside T2? */
497
    // * check if V0 is inside tri(U0,U1,U2) */
498
    A := U1.V[I1] - U0.V[I1];
499
    B := -(U1.V[I0] - U0.V[I0]);
500
    C := -A * U0.V[I0] - B * U0.V[I1];
501
    D0 := A * V0.V[I0] + B * V0.V[I1] + C;
502

503
    A := U2.V[I1] - U1.V[I1];
504
    B := -(U2.V[I0] - U1.V[I0]);
505
    C := -A * U1.V[I0] - B * U1.V[I1];
506
    D1 := A * V0.V[I0] + B * V0.V[I1] + C;
507

508
    A := U0.V[I1] - U2.V[I1];
509
    B := -(U0.V[I0] - U2.V[I0]);
510
    C := -A * U2.V[I0] - B * U2.V[I1];
511
    D2 := A * V0.V[I0] + B * V0.V[I1] + C;
512
    if (D0 * D1 > 0.0) then
513
      if (D0 * D2 > 0.0) then
514
        Result := 1;
515
  end;
516

517
/// Begin Main logic ///////////////////////////////
518
begin
519
  // * first project onto an axis-aligned plane, that maximizes the area */
520
  // * of the triangles, compute indices: i0,i1. */
521
  A.V[0] := Abs(N.V[0]);
522
  A.V[1] := Abs(N.V[1]);
523
  A.V[2] := Abs(N.V[2]);
524
  if (A.V[0] > A.V[1]) then
525
  begin
526
    if (A.V[0] > A.V[2]) then
527
    begin
528
      I0 := 1; // * A[0] is greatest */
529
      I1 := 2;
530
    end
531
    else
532
    begin
533
      I0 := 0; // * A[2] is greatest */
534
      I1 := 1;
535
    end
536
  end
537
  else
538
  begin // * A[0]<=A[1] */
539
    if (A.V[2] > A.V[1]) then
540
    begin
541
      I0 := 0; // * A[2] is greatest */
542
      I1 := 1;
543
    end
544
    else
545
    begin
546
      I0 := 0; // * A[1] is greatest */
547
      I1 := 2;
548
    end
549
  end;
550

551
  // * test all edges of triangle 1 against the edges of triangle 2 */
552
  Result := EDGE_AGAINST_TRI_EDGES(V0, V1, U0, U1, U2);
553
  if Result = 1 then
554
    Exit;
555
  Result := EDGE_AGAINST_TRI_EDGES(V1, V2, U0, U1, U2);
556
  if Result = 1 then
557
    Exit;
558
  Result := EDGE_AGAINST_TRI_EDGES(V2, V0, U0, U1, U2);
559
  if Result = 1 then
560
    Exit;
561

562
  // * finally, test if tri1 is totally contained in tri2 or vice versa */
563
  Result := POINT_IN_TRI(V0, U0, U1, U2);
564
  if Result = 1 then
565
    Exit;
566
  Result := POINT_IN_TRI(U0, V0, V1, V2);
567
end;
568

569
// tri_tri_intersect
570
//
571
function Tri_tri_intersect(const V0, V1, V2, U0, U1,
572
  U2: TAFFineFLTVector): Integer;
573
var
574
  E1, E2: TAffineFLTVector;
575
  N1, N2: TAffineFLTVector;
576
  D1, D2: Single;
577
  Du0, Du1, Du2, Dv0, Dv1, Dv2: Single;
578
  D: TAffineFLTVector;
579
  Isect1: array [0 .. 1] of Single;
580
  Isect2: array [0 .. 1] of Single;
581
  Du0du1, Du0du2, Dv0dv1, Dv0dv2: Single;
582
  Index: Shortint;
583
  Vp0, Vp1, Vp2: Single;
584
  Up0, Up1, Up2: Single;
585
  B, C, Max: Single;
586

587
  procedure ISECT(VV0, VV1, VV2, D0, D1, D2: Single;
588
    var Isect0, Isect1: Single);
589
  begin
590
    Isect0 := VV0 + (VV1 - VV0) * D0 / (D0 - D1);
591
    Isect1 := VV0 + (VV2 - VV0) * D0 / (D0 - D2);
592
  end;
593

594
  function COMPUTE_INTERVALS(VV0, VV1, VV2, D0, D1, D2, D0D1, D0D2: Single;
595
    var Isect0, Isect1: Single): Integer;
596
  begin
597
    Result := 0;
598
    if (D0D1 > 0.0) then
599
      // * here we know that D0D2<=0.0 */
600
      // * that is D0, D1 are on the same side, D2 on the other or on the plane */ \
601
      ISECT(VV2, VV0, VV1, D2, D0, D1, Isect0, Isect1)
602
    else if (D0D2 > 0.0) then
603
      // * here we know that d0d1<=0.0 */
604
      ISECT(VV1, VV0, VV2, D1, D0, D2, Isect0, Isect1)
605
    else if (D1 * D2 > 0.0) or (D0 <> 0.0) then
606
      // * here we know that d0d1<=0.0 or that D0!=0.0 */
607
      ISECT(VV0, VV1, VV2, D0, D1, D2, Isect0, Isect1)
608
    else if (D1 <> 0.0) then
609
      ISECT(VV1, VV0, VV2, D1, D0, D2, Isect0, Isect1)
610
    else if (D2 <> 0.0) then
611
      ISECT(VV2, VV0, VV1, D2, D0, D1, Isect0, Isect1)
612
    else
613
      // * triangles are coplanar */
614
      Result := Coplanar_tri_tri(N1, V0, V1, V2, U0, U1, U2);
615
  end;
616

617
// * sort so that a<=b */
618
  procedure SORT(var A: Single; var B: Single);
619
  var
620
    C: Single;
621
  begin
622
    if (A > B) then
623
    begin
624
      C := A;
625
      A := B;
626
      B := C;
627
    end;
628
  end;
629

630
begin
631
  // * compute plane equation of triangle(V0,V1,V2) */
632
  E1 := VectorSubtract(V1, V0);
633
  E2 := VectorSubtract(V2, V0);
634
  N1 := VectorCrossProduct(E1, E2);
635
  D1 := -VectorDotProduct(N1, V0);
636
  // * plane equation 1: N1.X+d1=0 */
637

638
  // * put U0,U1,U2 into plane equation 1 to compute signed distances to the plane*/
639
  Du0 := VectorDotProduct(N1, U0) + D1;
640
  Du1 := VectorDotProduct(N1, U1) + D1;
641
  Du2 := VectorDotProduct(N1, U2) + D1;
642

643
  // * coplanarity robustness check */
644
  if USE_EPSILON_TEST = TRUE then
645
  begin
646
    if (Abs(Du0) < EPSILON) then
647
      Du0 := 0.0;
648
    if (Abs(Du1) < EPSILON) then
649
      Du1 := 0.0;
650
    if (Abs(Du2) < EPSILON) then
651
      Du2 := 0.0;
652
  end;
653
  Du0du1 := Du0 * Du1;
654
  Du0du2 := Du0 * Du2;
655

656
  if (Du0du1 > 0.0) and (Du0du2 > 0.0) then
657
  begin // * same sign on all of them + not equal 0 ? */
658
    Result := 0; // * no intersection occurs */
659
    Exit;
660
  end;
661

662
  // * compute plane of triangle (U0,U1,U2) */
663
  E1 := VectorSubtract(U1, U0);
664
  E2 := VectorSubtract(U2, U0);
665
  N2 := VectorCrossProduct(E1, E2);
666
  D2 := -VectorDotProduct(N2, U0);
667
  // * plane equation 2: N2.X+d2=0 */
668

669
  // * put V0,V1,V2 into plane equation 2 */
670
  Dv0 := VectorDotProduct(N2, V0) + D2;
671
  Dv1 := VectorDotProduct(N2, V1) + D2;
672
  Dv2 := VectorDotProduct(N2, V2) + D2;
673

674
  if USE_EPSILON_TEST = TRUE then
675
  begin
676
    if (Abs(Dv0) < EPSILON) then
677
      Dv0 := 0.0;
678
    if (Abs(Dv1) < EPSILON) then
679
      Dv1 := 0.0;
680
    if (Abs(Dv2) < EPSILON) then
681
      Dv2 := 0.0;
682
  end;
683

684
  Dv0dv1 := Dv0 * Dv1;
685
  Dv0dv2 := Dv0 * Dv2;
686

687
  if (Dv0dv1 > 0.0) and (Dv0dv2 > 0.0) then
688
  begin // * same sign on all of them + not equal 0 ? */
689
    Result := 0; // * no intersection occurs */
690
    Exit;
691
  end;
692

693
  // * compute direction of intersection line */
694
  D := VectorCrossProduct(N1, N2);
695

696
  // * compute and index to the largest component of D */
697
  Max := Abs(D.V[0]);
698
  index := 0;
699
  B := Abs(D.V[1]);
700
  C := Abs(D.V[2]);
701
  if (B > Max) then
702
  begin
703
    Max := B;
704
    index := 1;
705
  end;
706
  if (C > Max) then
707
  begin
708
    // max:=c;   why?
709
    index := 2;
710
  end;
711
  // * this is the simplified projection onto L*/
712
  Vp0 := V0.V[index];
713
  Vp1 := V1.V[index];
714
  Vp2 := V2.V[index];
715

716
  Up0 := U0.V[index];
717
  Up1 := U1.V[index];
718
  Up2 := U2.V[index];
719

720
  // * compute interval for triangle 1 */
721
  COMPUTE_INTERVALS(Vp0, Vp1, Vp2, Dv0, Dv1, Dv2, Dv0dv1, Dv0dv2, Isect1[0],
722
    Isect1[1]);
723

724
  // * compute interval for triangle 2 */
725
  COMPUTE_INTERVALS(Up0, Up1, Up2, Du0, Du1, Du2, Du0du1, Du0du2, Isect2[0],
726
    Isect2[1]);
727

728
  SORT(Isect1[0], Isect1[1]);
729
  SORT(Isect2[0], Isect2[1]);
730

731
  if (Isect1[1] < Isect2[0]) or (Isect2[1] < Isect1[0]) then
732
    Result := 0
733
  else
734
    Result := 1;
735
end;
736

737
// ------------------
738
// ------------------ TOctree ------------------
739
// ------------------
740

741
const
742
  MIN = 0;
743

744
const
745
  MID = 1;
746

747
const
748
  MAX = 2;
749

750
const
751
  POINT = 0;
752

753
const
754
  TRIANGLE = 1;
755

756
const
757
  TOPFACE = 0;
758

759
const
760
  BOTTOMFACE = 1;
761

762
const
763
  LEFTFACE = 2;
764

765
const
766
  RIGHTFACE = 3;
767

768
const
769
  FRONTFACE = 4;
770

771
const
772
  BACKFACE = 5;
773

774
const
775
  TOPLEFT = 0;
776

777
const
778
  TOPRIGHT = 1;
779

780
const
781
  BOTTOMLEFT = 2;
782

783
const
784
  BOTTOMRIGHT = 3;
785

786
  // Theory on FlagMax and FlagMin:
787
  // When a node is subdivided, each of the 8 children assumes 1/8th ownership of its
788
  // parent's bounding box (defined by parent extents).  Calculating a child's min/max
789
  // extent only requires 3 values: the parent's min extent, the parent's max extent
790
  // and the midpoint of the parent's extents (since the cube is divided in half twice).
791
  // The following arrays assume that the children are numbered from 0 to 7, named Upper
792
  // and Lower (Upper = top 4 cubes on Y axis, Bottom = lower 4 cubes), Left and Right, and
793
  // Fore and Back (Fore facing furthest away from you the viewer).
794
  // Each node can use its corresponding element in the array to flag the operation needed
795
  // to find its new min/max extent.  Note that min, mid and max refer to an array of
796
  // 3 coordinates (x,y,z); each of which are flagged separately. Also note that these
797
  // flags are based on the Y vector being the up vector.
798
const
799
  FlagMax: array [0 .. 7] of array [0 .. 2] of Byte = ((MID, MAX, MAX),
800
    // Upper Fore Left
801
    (MAX, MAX, MAX), // Upper Fore Right
802
    (MID, MAX, MID), // Upper Back Left
803
    (MAX, MAX, MID), // Upper Back Right
804

805
    (MID, MID, MAX), // Lower Fore Left   (similar to above except height/2)
806
    (MAX, MID, MAX), // Lower Fore Right
807
    (MID, MID, MID), // Lower Back Left
808
    (MAX, MID, MID) // Lower Back Right
809
    );
810

811
  FlagMin: array [0 .. 7] of array [0 .. 2] of Byte = ((MIN, MID, MID),
812
    // Upper Fore Left
813
    (MID, MID, MID), // Upper Fore Right
814
    (MIN, MID, MIN), // Upper Back Left
815
    (MID, MID, MIN), // Upper Back Right
816

817
    (MIN, MIN, MID), // Lower Fore Left  (similar to above except height/2)
818
    (MID, MIN, MID), // Lower Fore Right
819
    (MIN, MIN, MIN), // Lower Back Left
820
    (MID, MIN, MIN) // Lower Back Right
821
    );
822

823
  // Design of the AABB faces, using similar method to above.. Note than normals are not
824
  // correct, but not needed for current tri-intersection test.
825
  // Could be removed if the tri-plane collision is replaced with a tri-box routine.
826
  FlagFaces: array [0 .. 23] of array [0 .. 2] of Byte = (
827
    // Top Face
828
    (MIN, MAX, MAX), // Upper left corner
829
    (MAX, MAX, MAX), // Upper right corner
830
    (MAX, MIN, MAX), // Bottom right corner
831
    (MIN, MIN, MAX),
832

833
    // Bottom Face
834
    (MIN, MAX, MIN), // Upper left corner
835
    (MAX, MAX, MIN), // Upper right corner
836
    (MAX, MIN, MIN), // Bottom right corner
837
    (MIN, MIN, MIN),
838

839
    // Back Face
840
    (MIN, MAX, MAX), // Upper left corner
841
    (MAX, MAX, MAX), // Upper right corner
842
    (MAX, MAX, MIN), // Bottom right corner
843
    (MIN, MAX, MIN),
844

845
    // Front Face
846
    (MIN, MIN, MAX), // Upper left corner
847
    (MAX, MIN, MAX), // Upper right corner
848
    (MAX, MIN, MIN), // Bottom right corner
849
    (MIN, MIN, MIN),
850

851
    // Left Face
852
    (MIN, MAX, MAX), // Upper left corner
853
    (MIN, MIN, MAX), // Upper right corner
854
    (MIN, MIN, MIN), // Bottom right corner
855
    (MIN, MAX, MIN),
856

857
    // Right Face
858
    (MAX, MIN, MAX), // Upper left corner
859
    (MAX, MAX, MAX), // Upper right corner
860
    (MAX, MAX, MIN), // Bottom right corner
861
    (MAX, MIN, MIN));
862

863
  // Destroy
864
  //
865
destructor TOctree.Destroy;
866
begin
867
  DisposeTree;
868
  inherited Destroy;
869
end;
870

871
// DisposeTree
872
//
873
procedure TOctree.DisposeTree;
874

875
  procedure WalkDispose(var Node: POctreeNode);
876
  var
877
    I: Integer;
878
  begin
879
    if Assigned(Node) then
880
    begin
881
      for I := 0 to 7 do
882
        WalkDispose(Node^.ChildArray[I]);
883
      Dispose(Node);
884
    end;
885
  end;
886

887
begin
888
  WalkDispose(RootNode);
889
  RootNode := nil;
890
  TriangleFiler.Free;
891
  TriangleFiler := nil;
892
end;
893

894
// CreateTree
895
//
896
procedure TOctree.CreateTree(Depth: Integer);
897
begin
898
  MaxOlevel := Depth; // initialize max depth.
899
  Refine(Rootnode, 0);
900
end;
901

902
// "cuts" all the triangles in the mesh into the octree.
903
procedure TOctree.CutMesh;
904

905
  procedure AddTriangleToNodes(N: Integer);
906
  var
907
    X, K: Integer;
908
    P: POctreeNode;
909
  begin
910
    for X := 0 to High(ResultArray) do
911
    begin
912
      P := Resultarray[X]; // Pointer to a node.
913

914
      K := Length(P^.TriArray);
915
      SetLength(P^.TriArray, K + 1); // Increase array by 1.
916
      P^.TriArray[K] := N; // Store triangle # reference.
917

918
{$IFDEF DEBUG}
919
      Inc(Intersections);
920
{$ENDIF}
921
    end;
922
  end;
923

924
var
925
  N: Integer; // n = triangle # in mesh
926
begin
927
  TriCountMesh := TriangleFiler.Count div 3;
928
  N := 0;
929
  while N < TriangleFiler.Count do
930
  begin
931
    WalkTriToLeaf(RootNode, TriangleFiler.List^[N], TriangleFiler.List^[N + 1],
932
      TriangleFiler.List^[N + 2]);
933
    if ResultArray <> NIL then
934
    begin
935
      AddTriangleToNodes(N);
936
      Inc(TriCountOctree, 1);
937
    end;
938
    Inc(N, 3);
939
  end;
940
end;
941

942
function TOctree.GetMidPoint(Min, Max: Single): Single;
943
begin
944
  Result := Max / 2 + Min / 2;
945
  // This formula is non-quadrant specific; ie: good.
946
end;
947

948
function TOctree.GetExtent(const Flags: array of Byte; ParentNode: POctreeNode)
949
  : TAffineFLTVector;
950
var
951
  Emin, Emax: TAffineFLTVector;
952
  N: Integer;
953
begin
954
  Emin := ParentNode^.MinExtent; // Some easy to work with variables.
955
  Emax := ParentNode^.MaxExtent;
956

957
  for N := 0 to 2 do
958
  begin
959
    case Flags[N] of
960
      MIN:
961
        Result.V[N] := Emin.V[N];
962
      MID:
963
        Result.V[N] := GetMidPoint(Emin.V[N], Emax.V[N]);
964
      MAX:
965
        Result.V[N] := Emax.V[N];
966
    end;
967
  end;
968
end;
969

970
// InitializeTree
971
//
972
procedure TOctree.InitializeTree(const AWorldMinExtent, AWorldMaxExtent
973
  : TAffineVector; const ATriangles: TAffineVectorList;
974
  const ATreeDepth: Integer);
975
var
976
  N: Integer;
977
  Newnode: POctreeNode;
978
begin
979
  Self.WorldMinExtent := AWorldMinExtent;
980
  Self.WorldMaxExtent := AWorldMaxExtent;
981

982
  // set up the filer data for this mesh
983
  if TriangleFiler = nil then
984
    TriangleFiler := TAffineVectorList.Create;
985
  TriangleFiler.Assign(ATriangles);
986

987
  New(Newnode);
988
  Newnode^.MinExtent := AWorldMinExtent;
989
  Newnode^.MaxExtent := AWorldMaxExtent;
990
  Newnode^.TriArray := NIL;
991
  for N := 0 to 7 do
992
    Newnode^.ChildArray[N] := NIL;
993

994
  // Initialize work variables for new tree.
995
  Rootnode := Newnode; // rootnode always points to root.
996
  NodeCount := 0; // initialize node count
997

998
  CreateTree(ATreeDepth);
999
  CutMesh;
1000
end;
1001

1002
// Refine
1003
//
1004
procedure TOctree.Refine(ParentNode: POctreeNode; Level: Integer);
1005
var
1006
  N, X, Z: Integer;
1007
  Pwork: array [0 .. 7] of POctreeNode;
1008
  // Stores addresses of newly created children.
1009
  Newnode: POctreeNode;
1010
begin
1011
  if Level < MaxOlevel then
1012
  begin
1013
    for N := 0 to 7 do
1014
    begin // Create 8 new children under this parent.
1015
      Inc(NodeCount);
1016
      New(Newnode);
1017
      Pwork[N] := Newnode; // Create work pointers for the next for loop.
1018

1019
      // Generate new extents based on parent's extents
1020
      Newnode^.MinExtent := GetExtent(FlagMin[N], ParentNode);
1021
      Newnode^.MaxExtent := GetExtent(FlagMax[N], ParentNode);
1022

1023
      Newnode^.TriArray := nil; // Initialize.
1024

1025
      for Z := 0 to 7 do
1026
        Newnode^.ChildArray[Z] := nil; // initialize all child pointers to NIL
1027

1028
      ParentNode^.ChildArray[N] := Newnode;
1029
      // initialize parent's child pointer to this node
1030
    end;
1031
    for X := 0 to 7 do // Now recursively Refine each child we just made
1032
      Refine(Pwork[X], Level + 1);
1033
  end; // end if
1034
end;
1035

1036
// ConvertR4
1037
//
1038
procedure TOctree.ConvertR4(ONode: POctreeNode; const Scale: TAffineFLTVector);
1039
var
1040
  N: Smallint;
1041
begin
1042
  ScaleVector(Onode^.MinExtent, Scale);
1043
  ScaleVector(Onode^.MaxExtent, Scale);
1044
  if ONode^.ChildArray[0] <> NIL then
1045
  begin // ie: if not a leaf then loop through children.
1046
    for N := 0 to 7 do
1047
    begin
1048
      ConvertR4(Onode^.ChildArray[N], Scale);
1049
    end;
1050
  end
1051
end;
1052

1053
// PointInNode
1054
//
1055
function TOctree.PointInNode(const Min, Max, APoint: TAffineFLTVector): BOOLEAN;
1056
begin
1057
  Result := (APoint.V[0] >= Min.V[0]) and
1058
    (APoint.V[1] >= Min.V[1]) and (APoint.V[2] >= Min.V[2]) and
1059
    (APoint.V[0] <= Max.V[0]) and (APoint.V[1] <= Max.V[1]) and
1060
    (APoint.V[2] <= Max.V[2]);
1061
end;
1062

1063
// WalkPointToLeaf
1064
//
1065
procedure TOctree.WalkPointToLeaf(Onode: POctreeNode; const P: TAffineVector);
1066
begin
1067
  Finalize(Resultarray);
1068
  WalkPointToLeafx(Onode, P);
1069
end;
1070

1071
// WalkPointToLeafx
1072
//
1073
procedure TOctree.WalkPointToLeafx(Onode: POctreeNode; const P: TAffineVector);
1074
var
1075
  N: Integer;
1076
begin
1077
  if PointInNode(Onode^.MinExtent, Onode^.MaxExtent, P) then
1078
  begin
1079
    if Assigned(Onode^.ChildArray[0]) then
1080
      for N := 0 to 7 do
1081
        WalkPointToLeafx(Onode^.ChildArray[N], P)
1082
    else
1083
    begin
1084
      SetLength(Resultarray, Length(Resultarray) + 1);
1085
      Resultarray[High(Resultarray)] := Onode;
1086
    end;
1087
  end;
1088
end;
1089

1090
// SphereInNode
1091
//
1092
function TOctree.SphereInNode(const MinExtent, MaxExtent: TAffineVector;
1093
  const C: TVector; Radius: Single): Boolean;
1094
// Sphere-AABB intersection by Miguel Gomez
1095
var
1096
  S, D: Single;
1097
  I: Integer;
1098
begin
1099
  // find the square of the distance
1100
  // from the sphere to the box
1101
  D := 0;
1102
  for I := 0 to 2 do
1103
  begin
1104
    if (C.V[I] < MinExtent.V[I]) then
1105
    begin
1106
      S := C.V[I] - MinExtent.V[I];
1107
      D := D + S * S;
1108
    end
1109
    else if (C.V[I] > MaxExtent.V[I]) then
1110
    begin
1111
      S := C.V[I] - MaxExtent.V[I];
1112
      D := D + S * S;
1113
    end;
1114
  end; // end for
1115

1116
  if D <= Radius * Radius then
1117
    Result := TRUE
1118
  else
1119
    Result := FALSE;
1120
end;
1121

1122
// WalkSphereToLeaf
1123
//
1124
procedure TOctree.WalkSphereToLeaf(Onode: POctreeNode; const P: TVector;
1125
  Radius: Single);
1126
begin
1127
  Finalize(Resultarray);
1128
  WalkSphereToLeafx(Onode, P, Radius);
1129
end;
1130

1131
// WalkSphereToLeafx
1132
//
1133
procedure TOctree.WalkSphereToLeafx(Onode: POctreeNode; const P: TVector;
1134
  Radius: Single);
1135
var
1136
  N: Integer;
1137
begin
1138
  if SphereInNode(Onode^.MinExtent, Onode^.MaxExtent, P, Radius) then
1139
  begin
1140
    if Assigned(Onode^.ChildArray[0]) then
1141
      for N := 0 to 7 do
1142
        WalkSphereToLeafx(Onode^.ChildArray[N], P, Radius)
1143
    else
1144
    begin
1145
      SetLength(Resultarray, Length(Resultarray) + 1);
1146
      Resultarray[High(Resultarray)] := Onode;
1147
    end;
1148
  end;
1149
end;
1150

1151
// Cast a ray (point p, vector v) into the Octree (ie: ray-box intersect).
1152
procedure TOctree.WalkRayToLeaf(Onode: POctreeNode; const P, V: TVector);
1153
begin
1154
  Finalize(Resultarray);
1155

1156
  WalkRayToLeafx(Onode, P, V);
1157
end;
1158

1159
// WalkRayToLeafx
1160
//
1161
procedure TOctree.WalkRayToLeafx(Onode: POctreeNode; const P, V: TVector);
1162
var
1163
  N: Integer;
1164
  Coord: TVector;
1165
begin
1166
  if HitBoundingBox(Onode^.MinExtent, Onode^.MaxExtent, P, V, Coord) then
1167
  begin
1168
    if Assigned(Onode^.ChildArray[0]) then
1169
      for N := 0 to 7 do
1170
        WalkRayToLeafx(Onode^.ChildArray[N], P, V)
1171
    else
1172
    begin
1173
      SetLength(Resultarray, Length(Resultarray) + 1);
1174
      Resultarray[High(Resultarray)] := Onode;
1175
    end;
1176
  end;
1177
end;
1178

1179
// Check triangle intersect with any of the node's faces.
1180
// Could be replaced with a tri-box check.
1181
function TOctree.TriIntersectNode(const MinExtent, MaxExtent, V1, V2,
1182
  V3: TAffineVector): Boolean;
1183
var
1184
  F0, F1, F2, F3: TAffineFLTVector;
1185
  N, O, P: Integer;
1186
  AFace: array [0 .. 3] of TAffineFLTVector; // A face's 4 corners.
1187
begin
1188
  for N := 0 to 5 do
1189
  begin // Do all 6 faces.
1190
    for O := 0 to 3 do
1191
    begin // Do all 4 vertices for the face.
1192
      for P := 0 to 2 do
1193
      begin // Do x,y,z for each vertex.
1194
        if FlagFaces[O + N * 4, P] = MIN then
1195
          AFace[O].V[P] := MinExtent.V[P]
1196
        else
1197
          AFace[O].V[P] := MaxExtent.V[P];
1198
      end; // end for o
1199
    end; // end for p
1200
    F0 := AFace[0];
1201
    F1 := AFace[1];
1202
    F2 := AFace[2];
1203
    F3 := AFace[3];
1204

1205
    // Now check the two triangles in the face against the mesh triangle.
1206
    if Tri_tri_intersect(V1, V2, V3, F0, F1, F2) = 1 then
1207
      Result := TRUE
1208
    else if Tri_tri_intersect(V1, V2, V3, F2, F3, F0) = 1 then
1209
      Result := TRUE
1210
    else
1211
      Result := FALSE;
1212
    if Result then
1213
      Exit;
1214

1215
  end; // end for n
1216
end;
1217

1218
// WalkTriToLeaf
1219
//
1220
procedure TOctree.WalkTriToLeaf(Onode: POctreeNode;
1221
  const V1, V2, V3: TAffineFLTVector);
1222
begin
1223
  Finalize(Resultarray);
1224
  WalkTriToLeafx(Onode, V1, V2, V3);
1225
end;
1226

1227
// WalkTriToLeafx
1228
//
1229
procedure TOctree.WalkTriToLeafx(Onode: POctreeNode;
1230
  const V1, V2, V3: TAffineFLTVector);
1231
var
1232
  M: Integer;
1233
begin
1234
  if TriIntersectNode(Onode^.MinExtent, Onode^.MaxExtent, V1, V2, V3) or
1235
    PointInNode(Onode^.MinExtent, Onode^.MaxExtent, V1) or
1236
    PointInNode(Onode^.MinExtent, Onode^.MaxExtent, V2) or
1237
    PointInNode(Onode^.MinExtent, Onode^.MaxExtent, V3) then
1238
  begin
1239
    if Onode^.ChildArray[0] <> NIL then
1240
      for M := 0 to 7 do
1241
        WalkTriToLeafx(Onode^.ChildArray[M], V1, V2, V3)
1242
    else
1243
    begin
1244
      SetLength(Resultarray, Length(Resultarray) + 1);
1245
      Resultarray[High(Resultarray)] := Onode;
1246
    end;
1247
  end;
1248
end;
1249

1250
// RayCastIntersectAABB
1251
//
1252
function TOctree.RayCastIntersect(const RayStart, RayVector: TVector;
1253
  IntersectPoint: PVector = nil; IntersectNormal: PVector = nil;
1254
  TriangleInfo: POctreeTriangleInfo = nil): Boolean;
1255
const
1256
  CInitialMinD: Single = 1E40;
1257
var
1258
  I, T, K: Integer;
1259
  D, MinD: Single;
1260
  P: POctreeNode;
1261
  IPoint, INormal: TVector;
1262
begin
1263
  WalkRayToLeaf(RootNode, RayStart, RayVector);
1264

1265
  if Resultarray = nil then
1266
  begin
1267
    Result := False;
1268
    Exit;
1269
  end;
1270

1271
  MinD := CInitialMinD;
1272
  for I := 0 to High(Resultarray) do
1273
  begin
1274
    P := ResultArray[I];
1275
    for T := 0 to High(P^.TriArray) do
1276
    begin
1277
      K := P^.Triarray[T];
1278
      if RayCastTriangleIntersect(RayStart, RayVector, TriangleFiler.List^[K],
1279
        TriangleFiler.List^[K + 1], TriangleFiler.List^[K + 2], @IPoint,
1280
        @INormal) then
1281
      begin
1282
        D := VectorDistance2(RayStart, IPoint);
1283
        if D < MinD then
1284
        begin
1285
          MinD := D;
1286
          if IntersectPoint <> nil then
1287
            IntersectPoint^ := IPoint;
1288
          if IntersectNormal <> nil then
1289
            IntersectNormal^ := INormal;
1290
          if TriangleInfo <> nil then
1291
          begin
1292
            TriangleInfo^.Index := K;
1293
            TriangleInfo^.Vertex[0] := TriangleFiler.List^[K];
1294
            TriangleInfo^.Vertex[1] := TriangleFiler.List^[K + 1];
1295
            TriangleInfo^.Vertex[2] := TriangleFiler.List^[K + 2];
1296
          end;
1297
        end;
1298
      end;
1299
    end;
1300
  end;
1301
  Result := (MinD <> CInitialMinD);
1302
end;
1303

1304
// SphereIntersectAABB -- Walk a sphere through an Octree, given a velocity, and return the nearest polygon
1305
// intersection point on that sphere, and its plane normal.
1306
//
1307
// **** This function is the result of a LOT of work and experimentation with both Paul Nettle's method
1308
// (www.fluidstudios.com) and Telemachos' method (www.peroxide.dk) over a period of about 2 months. If
1309
// you find ways to optimize the general structure, please let me know at rmch@cadvision.com. ****
1310
//
1311
// TO DO: R4 conversion (routine already exists for this) for ellipsoid space.
1312
//
1313
// Method for caclulating CD vs polygon: (Robert Hayes method)
1314
// ...for each triangle:
1315
// 1. Cast a ray from sphere origin to triangle's plane along plane's negative normal (set to length
1316
// of sphere radius).  If no hit, skip this triangle.  Otherwise this is the default plane
1317
// intersection point.
1318
// 2. If the distance is =< the sphere radius, the plane is embedded in the sphere.  Go to step 6 with
1319
// plane intersection point from above step.
1320
// 3. If the distance > sphere radius, calculate the sphere intersection point to this plane by
1321
// subtracting the plane's normal from the sphere's origin.
1322
// 4. Cast a new ray from the sphere intersection point to the plane; this is the new plane
1323
// intersection point.
1324
// 5. Cast a ray from the sphere intersection point to the triangle.  If it is a direct hit, then
1325
// this point is the polygon intersection point.
1326
// 6. Else, find the point on the triangle that is closest to the plane intersection point; this becomes
1327
// the polygon intersection point (ie: hit an edge or corner)
1328
// 7. Cast a ray from the polygon intersection point along the negative velocity vector of the sphere
1329
// (note: for accuracy reasons - SphereIntersect replaced with PointInSphere)
1330
// 8. If there is no intersection, the sphere cannot possibly collide with this triangle
1331
// 9. Else, save the distance from step 8 if, and only if, it is the shortest collision distance so far.
1332
//
1333
// Return the polygon intersection point and the closest triangle's normal if hit.
1334
//
1335
function TOctree.SphereSweepIntersect(const RayStart, RayVector: TVector;
1336
  const Velocity, Radius: Single; IntersectPoint: PVector = nil;
1337
  IntersectNormal: PVector = nil): Boolean;
1338
const
1339
  CInitialMinD2: Single = 1E40;
1340
  CEpsilon: Single = 0.05;
1341

1342
var
1343
  I, T, K: Integer;
1344
  MinD2, Sd2, Radius2: Single;
1345
  DistanceToTravel, DistanceToTravelMinusRadius2: Single;
1346
  P: POctreeNode;
1347
  PNormal: TAffineVector;
1348
  PNormal4: TVector;
1349
  NEGpNormal4: TVector;
1350
  SIPoint, SIPoint2: TVector; // sphere intersection point
1351
  PIPoint: TVector; // plane intersection point
1352
  PolyIPoint: TVector; // polygon intersection point
1353
  NEGVelocity: TVector; // sphere's forward velocity
1354
  DirectHit: Boolean;
1355

1356
  P1, P2, P3: PAffineVector;
1357

1358
  // SphereSweepAABB:TAABB;
1359

1360
  // response identifiers (for future use)
1361
  // destinationPoint, newdestinationPoint: TVector;
1362
  // slidePlaneOrigin, slidePlaneNormal: TVector;
1363
  // newvelocityVector: TVector;
1364
  // v: single;
1365
  // L: double;
1366
begin
1367
  // Note: Current implementation only accurate for FreeForm:Radius at 1:1 ratio.
1368

1369
  Result := False; // default: no collision
1370

1371
  // quit if no movement
1372
  if (Velocity = 0) or (not(VectorNorm(RayVector) > 0)) then
1373
    Exit;
1374
  // How far ahead to check for collisions.
1375
  DistanceToTravel := Velocity + Radius + CEpsilon;
1376
  DistanceToTravelMinusRadius2 := Sqr(Velocity + CEpsilon);
1377
  Radius2 := Sqr(Radius);
1378

1379
  // Determine all the octree nodes this sphere intersects with.
1380
  // NOTE: would be more efficient to find the bounding box that includes the
1381
  // startpoint and endpoint (+sphere diameter)... especially with a large sphere
1382
  // and/or a large velocity.
1383
  WalkSphereToLeaf(RootNode, RayStart, DistanceToTravel);
1384

1385
  // This method may be more effective if sphere sweeps from one point to another and stops.
1386
  // NOTE: If it recursively slides of planes, then WalkSphereToLeaf would probably be better, as
1387
  // it will determine all possible triangles that could intersect over the whole motion
1388
  // AABBFromSweep(SphereSweepAABB,rayStart,destinationPoint,Radius+cEpsilon);
1389
  // GetTrianglesFromNodesIntersectingAABB(SphereSweepAABB);
1390

1391
  if not Assigned(Resultarray) then
1392
    Exit;
1393

1394
  // Negative velocity vector for use with ray-sphere check.
1395
  VectorScale(RayVector, -Velocity / VectorLength(RayVector), NEGVelocity);
1396

1397
  MinD2 := CInitialMinD2;
1398
  for I := 0 to High(Resultarray) do
1399
  begin
1400
    P := ResultArray[I];
1401
    for T := 0 to High(P^.TriArray) do
1402
    begin
1403
      K := P^.Triarray[T];
1404
      // These are the vertices of the triangle to check
1405
      P1 := @Trianglefiler.List[K];
1406
      P2 := @Trianglefiler.List[K + 1];
1407
      P3 := @Trianglefiler.List[K + 2];
1408

1409
      // Create the normal for this triangle
1410
      PNormal := CalcPlaneNormal(P1^, P2^, P3^);
1411

1412
      // Ignore backfacing planes
1413
      if VectorDotProduct(PNormal, PAffineVector(@RayVector)^) > 0.0 then
1414
        Continue;
1415

1416
      // Set the normal to the radius of the sphere
1417
      ScaleVector(PNormal, Radius);
1418
      // Make some TVectors
1419
      MakeVector(PNormal4, PNormal);
1420
      NEGpNormal4 := VectorNegate(PNormal4);
1421

1422
      // Calculate the plane intersection point (sphere origin to plane)
1423
      if RayCastPlaneIntersect(RayStart, NEGpNormal4, VectorMake(P1^), PNormal4,
1424
        @PIPoint) then
1425
      begin
1426
        DirectHit := False;
1427
        Sd2 := VectorDistance2(RayStart, PIPoint);
1428

1429
        // If sd <= radius, fall through to "not direct hit" code below with pIPoint
1430
        // as the plane intersection point.  Sphere is embedded.
1431
        // Otherwise...
1432
        if Sd2 > Radius2 then
1433
        begin
1434
          // Calculate sphere intersection point (ie: point on sphere that hits plane)
1435
          SetVector(SIPoint, VectorSubtract(RayStart, PNormal4));
1436
          // Get new plane intersection point (in case not a direct hit)
1437
          RayCastPlaneIntersect(SIPoint, RayVector, VectorMake(P1^), PNormal4,
1438
            @PIPoint);
1439
          // Does the velocity vector directly hit the triangle? If yes then that is the
1440
          // polygon intersection point.
1441
          if RayCastTriangleIntersect(SIPoint, RayVector, P1^, P2^, P3^,
1442
            @PolyIPoint, @PNormal4) then
1443
          begin
1444
            Sd2 := VectorDistance2(SIPoint, PolyIPoint);
1445
            DirectHit := True;
1446
          end;
1447
        end;
1448

1449
        // If not a direct hit then check if sphere "nicks" the triangle's edge or corner...
1450
        // If it does then that is the polygon intersection point.
1451
        if not DirectHit then
1452
        begin
1453
          if not CheckPointInTriangle(AffineVectorMake(PiPoint), P1^, P2^, P3^)
1454
          then
1455
            SetVector(PolyIPoint, ClosestPointOnTriangleEdge(P1^, P2^, P3^,
1456
              PAffineVector(@PIPoint)^), 1)
1457
          else
1458
            PolyIPoint := PiPoint;
1459

1460
          // See if this point + negative velocity vector lies within the sphere.
1461
          // (This implementation seems more accurate than RayCastSphereIntersect)
1462
          { if not CheckPointInSphere(VectorAdd(polyIPoint, NEGVelocity), raystart, radius) then
1463
            continue;
1464
            // sd2:=0;  //stops the test too soon (noticable on triangle edges in flat planes)
1465
            sd2:=sqr(VectorDistance(raystart, polyIPoint)-Radius);
1466
          }
1467
          // see if this point + negative velocity vector intersect the sphere.
1468
          // (PointInSphere doesn't work for fast motion)
1469
          if VectorDistance2(PolyIPoint, RayStart) > Radius2 then
1470
          begin
1471
            if RayCastSphereIntersect(PolyIPoint, VectorNormalize(NEGVelocity),
1472
              RayStart, Radius, SIPoint, SIPoint2) = 0 then
1473
              Continue;
1474
            Sd2 := VectorDistance2(SIPoint, PolyIPoint);
1475
          end
1476
          else
1477
            Sd2 := 0;
1478
        end;
1479

1480
        // Allow sphere to get close to triangle (less epsilon which is built into distanceToTravel)
1481
        if Sd2 <= DistanceToTravelMinusRadius2 then
1482
        begin
1483
          Result := True; // flag a collision
1484
          if Sd2 < MinD2 then
1485
          begin
1486
            MinD2 := Sd2;
1487
            if IntersectPoint <> nil then
1488
              IntersectPoint^ := PolyIPoint;
1489
            if IntersectNormal <> nil then
1490
              IntersectNormal^ := PNormal4;
1491
            if Sd2 = 0 then
1492
              Exit;
1493
          end;
1494
        end;
1495
      end;
1496
    end; // end for t triangles
1497
  end; // end for i nodes
1498
end;
1499

1500
function TOctree.TriangleIntersect(const V1, V2, V3: TAffineVector): Boolean;
1501
var
1502
  I, T, K: Integer;
1503
  P: POctreeNode;
1504
  P1, P2, P3: PAffineVector;
1505
begin
1506
  Result := False; // default: no collision
1507
  WalkTriToLeaf(RootNode, V1, V2, V3);
1508
  if not Assigned(Resultarray) then
1509
    Exit;
1510

1511
  for I := 0 to High(Resultarray) do
1512
  begin
1513
    P := ResultArray[I];
1514
    for T := 0 to High(P^.TriArray) do
1515
    begin
1516
      K := P^.Triarray[T];
1517
      // These are the vertices of the triangle to check
1518
      P1 := @Trianglefiler.List[K];
1519
      P2 := @Trianglefiler.List[K + 1];
1520
      P3 := @Trianglefiler.List[K + 2];
1521
      if Tri_tri_intersect(V1, V2, V3, P1^, P2^, P3^) <> 0 then
1522
      begin
1523
        Result := True;
1524
        Exit;
1525
      end;
1526
    end; // end for t triangles
1527
  end; // end for i nodes
1528
end;
1529

1530
// AABBIntersect
1531
//
1532
function TOctree.AABBIntersect(const AABB: TAABB; M1to2, M2to1: TMatrix;
1533
  Triangles: TAffineVectorList = nil): Boolean;
1534
var
1535
  TriList: TAffineVectorList;
1536
  I: Integer;
1537
begin
1538
  // get triangles in nodes intersected by the aabb
1539
  TriList := GetTrianglesFromNodesIntersectingCube(Aabb, M1to2, M2to1);
1540

1541
  Result := False;
1542
  if Trilist.Count > 0 then
1543
  begin
1544
    Trilist.TransformAsPoints(M2to1);
1545
    I := 0;
1546
    // run all faces and check if they're inside the aabb
1547
    // uncoment the * and comment the {//} to check only vertices
1548
    { // } while I < TriList.Count - 1 do
1549
    begin
1550
      // *for i:= 0 to triList.count -1 do begin
1551
      // *  v:=VectorMake(TriList.Items[i]);
1552
      // *  if pointInAABB(AffinevectorMake(v), aabb) then
1553
      { // } if TriangleIntersectAABB(Aabb, TriList[I], TriList[I + 1],
1554
        Trilist[I + 2]) then
1555
      begin
1556
        Result := True;
1557
        if not Assigned(Triangles) then
1558
          Break
1559
        else
1560
          Triangles.Add(TriList[I], TriList[I + 1], Trilist[I + 2]);
1561
      end;
1562
      { // } I := I + 3;
1563
    end;
1564
  end;
1565

1566
  TriList.Free;
1567
end;
1568

1569
// GetTrianglesFromNodesIntersectingAABB
1570
//
1571
function TOctree.GetTrianglesFromNodesIntersectingAABB(const ObjAABB: TAABB)
1572
  : TAffineVectorList;
1573
var
1574
  AABB1: TAABB;
1575

1576
  procedure HandleNode(Onode: POctreeNode);
1577
  var
1578
    AABB2: TAABB;
1579
    I: Integer;
1580
  begin
1581
    AABB2.Min := Onode^.MinExtent;
1582
    AABB2.Max := Onode^.MaxExtent;
1583

1584
    if IntersectAABBsAbsolute(AABB1, AABB2) then
1585
    begin
1586
      if Assigned(Onode^.ChildArray[0]) then
1587
      begin
1588
        for I := 0 to 7 do
1589
          HandleNode(Onode^.ChildArray[I])
1590
      end
1591
      else
1592
      begin
1593
        SetLength(ResultArray, Length(ResultArray) + 1);
1594
        ResultArray[High(ResultArray)] := Onode;
1595
      end;
1596
    end;
1597
  end;
1598

1599
var
1600
  I, K: Integer;
1601
  P: POctreeNode;
1602
  TriangleIndices: TIntegerList;
1603

1604
begin
1605
  // Calc AABBs
1606
  AABB1 := ObjAABB;
1607

1608
  SetLength(ResultArray, 0);
1609
  if Assigned(RootNode) then
1610
    HandleNode(RootNode);
1611

1612
  Result := TAffineVectorList.Create;
1613
  TriangleIndices := TIntegerList.Create;
1614
  try
1615
    // fill the triangles from all nodes in the resultarray to AL
1616
    for I := 0 to High(ResultArray) do
1617
    begin
1618
      P := ResultArray[I];
1619
      TriangleIndices.AddIntegers(P^.TriArray);
1620
    end;
1621
    TriangleIndices.SortAndRemoveDuplicates;
1622
    Result.Capacity := TriangleIndices.Count * 3;
1623
    for I := 0 to TriangleIndices.Count - 1 do
1624
    begin
1625
      K := TriangleIndices[I];
1626
      Result.Add(TriangleFiler.List^[K], TriangleFiler.List^[K + 1],
1627
        TriangleFiler.List^[K + 2]);
1628
    end;
1629
  finally
1630
    TriangleIndices.Free;
1631
  end;
1632

1633
end;
1634

1635
// GetTrianglesFromNodesIntersectingCube
1636
//
1637
function TOctree.GetTrianglesFromNodesIntersectingCube(const ObjAABB: TAABB;
1638
  const ObjToSelf, SelfToObj: TMatrix): TAffineVectorList;
1639
var
1640
  AABB1: TAABB;
1641
  M1To2, M2To1: TMatrix;
1642

1643
  procedure HandleNode(Onode: POctreeNode);
1644
  var
1645
    AABB2: TAABB;
1646
    I: Integer;
1647
  begin
1648
    AABB2.Min := Onode^.MinExtent;
1649
    AABB2.Max := Onode^.MaxExtent;
1650

1651
    if IntersectAABBs(AABB1, AABB2, M1To2, M2To1) then
1652
    begin
1653
      if Assigned(Onode^.ChildArray[0]) then
1654
      begin
1655
        for I := 0 to 7 do
1656
          HandleNode(Onode^.ChildArray[I])
1657
      end
1658
      else
1659
      begin
1660
        SetLength(ResultArray, Length(ResultArray) + 1);
1661
        ResultArray[High(ResultArray)] := Onode;
1662
      end;
1663
    end;
1664
  end;
1665

1666
var
1667
  I, K: Integer;
1668
  P: POctreeNode;
1669
  TriangleIndices: TIntegerList;
1670
begin
1671
  // Calc AABBs
1672
  AABB1 := ObjAABB;
1673
  // Calc Conversion Matrixes
1674
  M1To2 := ObjToSelf;
1675
  M2To1 := SelfToObj;
1676

1677
  SetLength(ResultArray, 0);
1678
  if Assigned(RootNode) then
1679
    HandleNode(RootNode);
1680

1681
  Result := TAffineVectorList.Create;
1682
  TriangleIndices := TIntegerList.Create;
1683
  try
1684
    // fill the triangles from all nodes in the resultarray to AL
1685
    for I := 0 to High(ResultArray) do
1686
    begin
1687
      P := ResultArray[I];
1688
      TriangleIndices.AddIntegers(P^.TriArray);
1689
    end;
1690
    TriangleIndices.SortAndRemoveDuplicates;
1691
    Result.Capacity := TriangleIndices.Count * 3;
1692
    for I := 0 to TriangleIndices.Count - 1 do
1693
    begin
1694
      K := TriangleIndices[I];
1695
      Result.Add(TriangleFiler.List^[K], TriangleFiler.List^[K + 1],
1696
        TriangleFiler.List^[K + 2]);
1697
    end;
1698
  finally
1699
    TriangleIndices.Free;
1700
  end;
1701
end;
1702

1703
end.
1704

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.