GLS.Octree.pas 46 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579
  1. //
  2. // The graphics engine GLScene
  3. //
  4. unit GLS.Octree;
  5. (*
  6. Octree management classes and structures.
  7. TODO: move some public vars/fields to private/protected
  8. *)
  9. interface
  10. {$I Stage.Defines.inc}
  11. uses
  12. System.Math,
  13. System.Classes,
  14. Stage.VectorTypes,
  15. Stage.VectorGeometry,
  16. GLS.VectorLists,
  17. GLS.GeometryBB,
  18. GLS.Context;
  19. type
  20. TProcInt = procedure(I: Integer) of object;
  21. TProcAffineAffineAffine = procedure(V1, V2, V3: TAffineFLTVector) of object;
  22. // Stores information about an intersected triangle
  23. POctreeTriangleInfo = ^TOctreeTriangleInfo;
  24. TOctreeTriangleInfo = record
  25. Index: Integer;
  26. Vertex: array [0 .. 2] of TAffineVector;
  27. end;
  28. PGLOctreeNode = ^TGLOctreeNode;
  29. TGLOctreeNode = record
  30. MinExtent: TAffineFLTVector;
  31. MaxExtent: TAffineFLTVector;
  32. // TextureHandle:TGLTextureHandle;
  33. ListHandle: TGLListHandle;
  34. WillDraw: Boolean; // temporary change
  35. // Are duplicates possible?
  36. TriArray: array of Integer; // array of triangle references
  37. ChildArray: array [0 .. 7] of PGLOctreeNode; // Octree's 8 children
  38. end;
  39. // Manages an Octree containing references to triangles.
  40. TGLOctree = class(TObject)
  41. private
  42. {$IFDEF DEBUG}
  43. Intersections: Integer;
  44. // for debugging - number of triangles intersecting an AABB plane
  45. {$ENDIF}
  46. protected
  47. // Find the exact centre of an AABB
  48. function GetMidPoint(Min, Max: Single): Single;
  49. // Check if a point lies within the AABB specified by min and max entents
  50. function PointInNode(const Min, Max, APoint: TAffineFLTVector): Boolean;
  51. // Check if a triangle (vertices v1, v2, v3) lies within the AABB specified by min and max entents
  52. function TriIntersectNode(const MinExtent, MaxExtent, V1, V2,
  53. V3: TAffineFLTVector): BOOLEAN;
  54. // Check if a sphere (at point C with radius) lies within the AABB specified by min and max entents
  55. function SphereInNode(const MinExtent, MaxExtent: TAffineVector;
  56. const C: TGLVector; Radius: Single): Boolean;
  57. procedure WalkTriToLeafx(Onode: PGLOctreeNode;
  58. const V1, V2, V3: TAffineFLTVector);
  59. procedure WalkPointToLeafx(ONode: PGLOctreeNode; const P: TAffineVector);
  60. procedure WalkSphereToLeafx(Onode: PGLOctreeNode; const P: TGLVector;
  61. Radius: Single);
  62. procedure WalkRayToLeafx(Onode: PGLOctreeNode; const P, V: TGLVector);
  63. function GetExtent(const Flags: array of Byte; ParentNode: PGLOctreeNode)
  64. : TAffineFLTVector;
  65. // Recursive routine to build nodes from parent to max depth level.
  66. procedure Refine(ParentNode: PGLOctreeNode; Level: Integer);
  67. // Main "walking" routines. Walks the item through the Octree down to a leaf node.
  68. procedure WalkPointToLeaf(ONode: PGLOctreeNode; const P: TAffineVector);
  69. procedure WalkTriToLeaf(Onode: PGLOctreeNode;
  70. const V1, V2, V3: TAffineVector);
  71. procedure WalkRayToLeaf(Onode: PGLOctreeNode; const P, V: TGLVector);
  72. // Example of how to process each node in the tree
  73. procedure ConvertR4(ONode: PGLOctreeNode; const Scale: TAffineFLTVector);
  74. procedure CreateTree(Depth: Integer);
  75. procedure CutMesh;
  76. public
  77. WorldMinExtent, WorldMaxExtent: TAffineFLTVector;
  78. RootNode: PGLOctreeNode; // always points to root node
  79. MaxOlevel: Integer; // max depth level of TGLOctreeNode
  80. NodeCount: Integer;
  81. // number of nodes (ex: 8 for level 1, 72 for level 2 etc).
  82. TriCountMesh: Integer; // total number of triangles in the mesh
  83. TriCountOctree: Integer; // total number of triangles cut into the octree
  84. MeshCount: Integer; // number of meshes currently cut into the Octree
  85. ResultArray: array of PGLOctreeNode;
  86. // holds the result nodes of various calls
  87. TriangleFiler: TGLAffineVectorList;
  88. procedure WalkSphereToLeaf(Onode: PGLOctreeNode; const P: TGLVector;
  89. Radius: Single);
  90. (* Initializes the tree from the triangle list.
  91. All triangles must be contained in the world extent to be properly
  92. taken into account. *)
  93. procedure InitializeTree(const AWorldMinExtent, AWorldMaxExtent
  94. : TAffineVector; const ATriangles: TGLAffineVectorList;
  95. const ATreeDepth: Integer);
  96. procedure DisposeTree;
  97. destructor Destroy; override;
  98. function RayCastIntersect(const RayStart, RayVector: TGLVector;
  99. IntersectPoint: PGLVector = nil; IntersectNormal: PGLVector = nil;
  100. TriangleInfo: POctreeTriangleInfo = nil): Boolean;
  101. function SphereSweepIntersect(const RayStart, RayVector: TGLVector;
  102. const Velocity, Radius: Single; IntersectPoint: PGLVector = nil;
  103. IntersectNormal: PGLVector = nil): Boolean;
  104. function TriangleIntersect(const V1, V2, V3: TAffineVector): Boolean;
  105. // Returns all triangles in the AABB.
  106. function GetTrianglesFromNodesIntersectingAABB(const ObjAABB: TAABB)
  107. : TGLAffineVectorList;
  108. // Returns all triangles in an arbitrarily placed cube
  109. function GetTrianglesFromNodesIntersectingCube(const ObjAABB: TAABB;
  110. const ObjToSelf, SelfToObj: TGLMatrix): TGLAffineVectorList;
  111. // Checks if an AABB intersects a face on the octree
  112. function AABBIntersect(const AABB: TAABB; const M1to2, M2to1: TGLMatrix;
  113. Triangles: TGLAffineVectorList = nil): Boolean;
  114. // function SphereIntersect(position:TAffineVector; radius:single);
  115. end;
  116. // ------------------------------------------------------------------
  117. implementation
  118. // ------------------------------------------------------------------
  119. // ----------------------------------------------------------------------
  120. // Name : CheckPointInSphere()
  121. // Input : point - point we wish to check for inclusion
  122. // sO - Origin of sphere
  123. // sR - radius of sphere
  124. // Notes :
  125. // Return: TRUE if point is in sphere, FALSE if not.
  126. // -----------------------------------------------------------------------
  127. function CheckPointInSphere(const Point, SO: TGLVector; const SR: Single)
  128. : Boolean;
  129. begin
  130. // Allow small margin of error
  131. Result := (VectorDistance2(Point, SO) <= Sqr(SR));
  132. end;
  133. // ----------------------------------------------------------------------
  134. // Name : CheckPointInTriangle()
  135. // Input : point - point we wish to check for inclusion
  136. // a - first vertex in triangle
  137. // b - second vertex in triangle
  138. // c - third vertex in triangle
  139. // Notes : Triangle should be defined in clockwise order a,b,c
  140. // Return: TRUE if point is in triangle, FALSE if not.
  141. // -----------------------------------------------------------------------
  142. function CheckPointInTriangle(const Point, A, B, C: TAffineVector): Boolean;
  143. var
  144. Total_angles: Single;
  145. V1, V2, V3: TAffineVector;
  146. begin
  147. Total_angles := 0;
  148. // make the 3 vectors
  149. V1 := VectorSubtract(Point, A);
  150. V2 := VectorSubtract(Point, B);
  151. V3 := VectorSubtract(Point, C);
  152. NormalizeVector(V1);
  153. NormalizeVector(V2);
  154. NormalizeVector(V3);
  155. Total_angles := Total_angles + Arccos(VectorDotProduct(V1, V2));
  156. Total_angles := Total_angles + Arccos(VectorDotProduct(V2, V3));
  157. Total_angles := Total_angles + Arccos(VectorDotProduct(V3, V1));
  158. if (Abs(Total_angles - 2 * PI) <= 0.005) then
  159. Result := TRUE
  160. else
  161. Result := FALSE;
  162. end;
  163. // ----------------------------------------------------------------------
  164. // Name : ClosestPointOnLine()
  165. // Input : a - first end of line segment
  166. // b - second end of line segment
  167. // p - point we wish to find closest point on line from
  168. // Notes : Helper function for closestPointOnTriangle()
  169. // Return: closest point on line segment
  170. // -----------------------------------------------------------------------
  171. function ClosestPointOnLine(const A, B, P: TAffineVector): TAffineVector;
  172. var
  173. D, T: Double;
  174. C, V: TAffineFLTVector;
  175. begin
  176. VectorSubtract(P, A, C);
  177. VectorSubtract(B, A, V);
  178. D := VectorLength(V);
  179. NormalizeVector(V);
  180. T := VectorDotProduct(V, C);
  181. // Check to see if t is beyond the extents of the line segment
  182. if (T < 0.0) then
  183. Result := A
  184. else if (T > D) then
  185. Result := B
  186. else
  187. begin
  188. V.X := V.X * T;
  189. V.Y := V.Y * T;
  190. V.Z := V.Z * T;
  191. Result := VectorAdd(A, V);
  192. end;
  193. end;
  194. // ----------------------------------------------------------------------
  195. // Name : ClosestPointOnTriangle()
  196. // Input : a - first vertex in triangle
  197. // b - second vertex in triangle
  198. // c - third vertex in triangle
  199. // p - point we wish to find closest point on triangle from
  200. // Notes :
  201. // Return: closest point on triangle
  202. // -----------------------------------------------------------------------
  203. (*
  204. function ClosestPointOnTriangle(const a, b, c, n, p: TAffineVector): TAffineVector;
  205. var
  206. dAB, dBC, dCA : Single;
  207. Rab, Rbc, Rca, intPoint : TAffineFLTVector;
  208. hit:boolean;
  209. begin
  210. //this would be faster if RayCastTriangleIntersect detected backwards hits
  211. hit:=RayCastTriangleIntersect(VectorMake(p),VectorMake(n),a,b,c,@intPoint) or
  212. RayCastTriangleIntersect(VectorMake(p),VectorMake(VectorNegate(n)),a,b,c,@intPoint);
  213. if (hit) then
  214. begin
  215. Result:=intPoint;
  216. end
  217. else
  218. begin
  219. Rab:=ClosestPointOnLine(a, b, p);
  220. Rbc:=ClosestPointOnLine(b, c, p);
  221. Rca:=ClosestPointOnLine(c, a, p);
  222. dAB:=VectorDistance2(p, Rab);
  223. dBC:=VectorDistance2(p, Rbc);
  224. dCA:=VectorDistance2(p, Rca);
  225. if dBC<dAB then
  226. if dCA<dBC then
  227. Result:=Rca
  228. else Result:=Rbc
  229. else if dCA<dAB then
  230. Result:=Rca
  231. else Result:=Rab;
  232. end;
  233. end;
  234. *)
  235. // ----------------------------------------------------------------------
  236. // Name : ClosestPointOnTriangleEdge()
  237. // Input : a - first vertex in triangle
  238. // b - second vertex in triangle
  239. // c - third vertex in triangle
  240. // p - point we wish to find closest point on triangle from
  241. // Notes :
  242. // Return: closest point on line triangle edge
  243. // -----------------------------------------------------------------------
  244. function ClosestPointOnTriangleEdge(const A, B, C, P: TAffineVector)
  245. : TAffineVector;
  246. var
  247. DAB, DBC, DCA: Single;
  248. Rab, Rbc, Rca: TAffineFLTVector;
  249. begin
  250. Rab := ClosestPointOnLine(A, B, P);
  251. Rbc := ClosestPointOnLine(B, C, P);
  252. Rca := ClosestPointOnLine(C, A, P);
  253. DAB := VectorDistance2(P, Rab);
  254. DBC := VectorDistance2(P, Rbc);
  255. DCA := VectorDistance2(P, Rca);
  256. if DBC < DAB then
  257. if DCA < DBC then
  258. Result := Rca
  259. else
  260. Result := Rbc
  261. else if DCA < DAB then
  262. Result := Rca
  263. else
  264. Result := Rab;
  265. end;
  266. function HitBoundingBox(const MinB, MaxB: TAffineFLTVector;
  267. const Origin, Dir: TGLVector; var Coord: TGLVector): BOOLEAN;
  268. const
  269. NUMDIM = 2;
  270. RIGHT = 0;
  271. LEFT = 1;
  272. MIDDLE = 2;
  273. var
  274. I, Whichplane: Integer;
  275. Inside: BOOLEAN;
  276. Quadrant: array [0 .. NUMDIM] of Byte;
  277. MaxT: array [0 .. NUMDIM] of Double;
  278. CandidatePlane: array [0 .. NUMDIM] of Double;
  279. begin
  280. Inside := TRUE;
  281. // Find candidate planes; this loop can be avoided if
  282. // rays cast all from the eye(assume perpsective view)
  283. for I := 0 to NUMDIM do
  284. begin
  285. if (Origin.V[I] < MinB.V[I]) then
  286. begin
  287. Quadrant[I] := LEFT;
  288. CandidatePlane[I] := MinB.V[I];
  289. Inside := FALSE;
  290. end
  291. else if (Origin.V[I] > MaxB.V[I]) then
  292. begin
  293. Quadrant[I] := RIGHT;
  294. CandidatePlane[I] := MaxB.V[I];
  295. Inside := FALSE;
  296. end
  297. else
  298. Quadrant[I] := MIDDLE;
  299. end;
  300. // * Ray origin inside bounding box */
  301. if Inside then
  302. begin
  303. SetVector(Coord, Origin);
  304. Result := TRUE;
  305. Exit;
  306. end;
  307. // * Calculate T distances to candidate planes */
  308. for I := 0 to NUMDIM do
  309. begin
  310. if (Quadrant[I] <> MIDDLE) AND (Dir.V[I] <> 0) then
  311. MaxT[I] := (CandidatePlane[I] - Origin.V[I]) / Dir.V[I]
  312. else
  313. MaxT[I] := -1;
  314. end;
  315. // * Get largest of the maxT's for final choice of intersection */
  316. WhichPlane := 0;
  317. for I := 1 to NUMDIM do
  318. if (MaxT[WhichPlane] < MaxT[I]) then
  319. WhichPlane := I;
  320. // * Check final candidate actually inside box */
  321. if (MaxT[WhichPlane] < 0) then
  322. begin
  323. Result := FALSE;
  324. Exit;
  325. end;
  326. for I := 0 to NUMDIM do
  327. begin
  328. if WhichPlane <> I then
  329. begin
  330. Coord.V[I] := Origin.V[I] + MaxT[WhichPlane] * Dir.V[I];
  331. if (Coord.V[I] < MinB.V[I]) OR (Coord.V[I] > MaxB.V[I])
  332. then
  333. begin
  334. Result := FALSE;
  335. Exit;
  336. end;
  337. end
  338. else
  339. Coord.V[I] := CandidatePlane[I];
  340. end;
  341. Result := TRUE; // * ray hits box */
  342. end;
  343. const
  344. USE_EPSILON_TEST = TRUE;
  345. EPSILON = 0.000001;
  346. function Coplanar_tri_tri(const N, V0, V1, V2, U0, U1,
  347. U2: TAffineFLTVEctor): Integer;
  348. var
  349. A: TAffineFLTVector;
  350. I0, I1: Shortint;
  351. function EDGE_AGAINST_TRI_EDGES(const V0, V1, U0, U1,
  352. U2: TAffineFLTVector): Integer;
  353. var
  354. Ax, Ay, Bx, By, Cx, Cy, E, D, F: Single;
  355. // * this edge to edge test is based on Franlin Antonio's gem:
  356. // "Faster Line Segment Intersection", in Graphics Gems III,
  357. // pp. 199-202 */
  358. function EDGE_EDGE_TEST(const V0, U0, U1: TAffineFLTVector): Integer;
  359. begin
  360. Result := 0;
  361. Bx := U0.V[I0] - U1.V[I0];
  362. By := U0.V[I1] - U1.V[I1];
  363. Cx := V0.V[I0] - U0.V[I0];
  364. Cy := V0.V[I1] - U0.V[I1];
  365. F := Ay * Bx - Ax * By;
  366. D := By * Cx - Bx * Cy;
  367. if ((F > 0) and (D >= 0) and (D <= F)) or
  368. ((F < 0) and (D <= 0) and (D >= F)) then
  369. begin
  370. E := Ax * Cy - Ay * Cx;
  371. if (F > 0) then
  372. begin
  373. if (E >= 0) and (E <= F) then
  374. Result := 1
  375. end
  376. else if (E <= 0) and (E >= F) then
  377. Result := 1;
  378. end;
  379. end;
  380. begin
  381. Ax := V1.V[I0] - V0.V[I0];
  382. Ay := V1.V[I1] - V0.V[I1];
  383. // * test edge U0,U1 against V0,V1 */
  384. Result := EDGE_EDGE_TEST(V0, U0, U1);
  385. if Result = 1 then
  386. Exit;
  387. // * test edge U1,U2 against V0,V1 */
  388. Result := EDGE_EDGE_TEST(V0, U1, U2);
  389. if Result = 1 then
  390. Exit;
  391. // * test edge U2,U1 against V0,V1 */
  392. Result := EDGE_EDGE_TEST(V0, U2, U0);
  393. end;
  394. function POINT_IN_TRI(const V0, U0, U1, U2: TAffineFLTVector): Integer;
  395. var
  396. A, B, C, D0, D1, D2: Single;
  397. begin
  398. Result := 0;
  399. // * is T1 completly inside T2? */
  400. // * check if V0 is inside tri(U0,U1,U2) */
  401. A := U1.V[I1] - U0.V[I1];
  402. B := -(U1.V[I0] - U0.V[I0]);
  403. C := -A * U0.V[I0] - B * U0.V[I1];
  404. D0 := A * V0.V[I0] + B * V0.V[I1] + C;
  405. A := U2.V[I1] - U1.V[I1];
  406. B := -(U2.V[I0] - U1.V[I0]);
  407. C := -A * U1.V[I0] - B * U1.V[I1];
  408. D1 := A * V0.V[I0] + B * V0.V[I1] + C;
  409. A := U0.V[I1] - U2.V[I1];
  410. B := -(U0.V[I0] - U2.V[I0]);
  411. C := -A * U2.V[I0] - B * U2.V[I1];
  412. D2 := A * V0.V[I0] + B * V0.V[I1] + C;
  413. if (D0 * D1 > 0.0) then
  414. if (D0 * D2 > 0.0) then
  415. Result := 1;
  416. end;
  417. /// Begin Main logic ///////////////////////////////
  418. begin
  419. // * first project onto an axis-aligned plane, that maximizes the area */
  420. // * of the triangles, compute indices: i0,i1. */
  421. A.X := Abs(N.X);
  422. A.Y := Abs(N.Y);
  423. A.Z := Abs(N.Z);
  424. if (A.X > A.Y) then
  425. begin
  426. if (A.X > A.Z) then
  427. begin
  428. I0 := 1; // * A[0] is greatest */
  429. I1 := 2;
  430. end
  431. else
  432. begin
  433. I0 := 0; // * A[2] is greatest */
  434. I1 := 1;
  435. end
  436. end
  437. else
  438. begin // * A[0]<=A[1] */
  439. if (A.Z > A.Y) then
  440. begin
  441. I0 := 0; // * A[2] is greatest */
  442. I1 := 1;
  443. end
  444. else
  445. begin
  446. I0 := 0; // * A[1] is greatest */
  447. I1 := 2;
  448. end
  449. end;
  450. // * test all edges of triangle 1 against the edges of triangle 2 */
  451. Result := EDGE_AGAINST_TRI_EDGES(V0, V1, U0, U1, U2);
  452. if Result = 1 then
  453. Exit;
  454. Result := EDGE_AGAINST_TRI_EDGES(V1, V2, U0, U1, U2);
  455. if Result = 1 then
  456. Exit;
  457. Result := EDGE_AGAINST_TRI_EDGES(V2, V0, U0, U1, U2);
  458. if Result = 1 then
  459. Exit;
  460. // * finally, test if tri1 is totally contained in tri2 or vice versa */
  461. Result := POINT_IN_TRI(V0, U0, U1, U2);
  462. if Result = 1 then
  463. Exit;
  464. Result := POINT_IN_TRI(U0, V0, V1, V2);
  465. end;
  466. function Tri_tri_intersect(const V0, V1, V2, U0, U1,
  467. U2: TAFFineFLTVector): Integer;
  468. var
  469. E1, E2: TAffineFLTVector;
  470. N1, N2: TAffineFLTVector;
  471. D1, D2: Single;
  472. Du0, Du1, Du2, Dv0, Dv1, Dv2: Single;
  473. D: TAffineFLTVector;
  474. Isect1: array [0 .. 1] of Single;
  475. Isect2: array [0 .. 1] of Single;
  476. Du0du1, Du0du2, Dv0dv1, Dv0dv2: Single;
  477. Index: Shortint;
  478. Vp0, Vp1, Vp2: Single;
  479. Up0, Up1, Up2: Single;
  480. B, C, Max: Single;
  481. procedure ISECT(VV0, VV1, VV2, D0, D1, D2: Single;
  482. out Isect0, Isect1: Single);
  483. begin
  484. Isect0 := VV0 + (VV1 - VV0) * D0 / (D0 - D1);
  485. Isect1 := VV0 + (VV2 - VV0) * D0 / (D0 - D2);
  486. end;
  487. function COMPUTE_INTERVALS(VV0, VV1, VV2, D0, D1, D2, D0D1, D0D2: Single;
  488. out Isect0, Isect1: Single): Integer;
  489. begin
  490. Result := 0;
  491. if (D0D1 > 0.0) then
  492. // * here we know that D0D2<=0.0 */
  493. // * that is D0, D1 are on the same side, D2 on the other or on the plane */ \
  494. ISECT(VV2, VV0, VV1, D2, D0, D1, Isect0, Isect1)
  495. else if (D0D2 > 0.0) then
  496. // * here we know that d0d1<=0.0 */
  497. ISECT(VV1, VV0, VV2, D1, D0, D2, Isect0, Isect1)
  498. else if (D1 * D2 > 0.0) or (D0 <> 0.0) then
  499. // * here we know that d0d1<=0.0 or that D0!=0.0 */
  500. ISECT(VV0, VV1, VV2, D0, D1, D2, Isect0, Isect1)
  501. else if (D1 <> 0.0) then
  502. ISECT(VV1, VV0, VV2, D1, D0, D2, Isect0, Isect1)
  503. else if (D2 <> 0.0) then
  504. ISECT(VV2, VV0, VV1, D2, D0, D1, Isect0, Isect1)
  505. else
  506. // * triangles are coplanar */
  507. Result := Coplanar_tri_tri(N1, V0, V1, V2, U0, U1, U2);
  508. end;
  509. // * sort so that a<=b */
  510. procedure SORT(var A: Single; var B: Single);
  511. var
  512. C: Single;
  513. begin
  514. if (A > B) then
  515. begin
  516. C := A;
  517. A := B;
  518. B := C;
  519. end;
  520. end;
  521. begin
  522. // * compute plane equation of triangle(V0,V1,V2) */
  523. E1 := VectorSubtract(V1, V0);
  524. E2 := VectorSubtract(V2, V0);
  525. N1 := VectorCrossProduct(E1, E2);
  526. D1 := -VectorDotProduct(N1, V0);
  527. // * plane equation 1: N1.X+d1=0 */
  528. // * put U0,U1,U2 into plane equation 1 to compute signed distances to the plane*/
  529. Du0 := VectorDotProduct(N1, U0) + D1;
  530. Du1 := VectorDotProduct(N1, U1) + D1;
  531. Du2 := VectorDotProduct(N1, U2) + D1;
  532. // * coplanarity robustness check */
  533. if USE_EPSILON_TEST = TRUE then
  534. begin
  535. if (Abs(Du0) < EPSILON) then
  536. Du0 := 0.0;
  537. if (Abs(Du1) < EPSILON) then
  538. Du1 := 0.0;
  539. if (Abs(Du2) < EPSILON) then
  540. Du2 := 0.0;
  541. end;
  542. Du0du1 := Du0 * Du1;
  543. Du0du2 := Du0 * Du2;
  544. if (Du0du1 > 0.0) and (Du0du2 > 0.0) then
  545. begin // * same sign on all of them + not equal 0 ? */
  546. Result := 0; // * no intersection occurs */
  547. Exit;
  548. end;
  549. // * compute plane of triangle (U0,U1,U2) */
  550. E1 := VectorSubtract(U1, U0);
  551. E2 := VectorSubtract(U2, U0);
  552. N2 := VectorCrossProduct(E1, E2);
  553. D2 := -VectorDotProduct(N2, U0);
  554. // * plane equation 2: N2.X+d2=0 */
  555. // * put V0,V1,V2 into plane equation 2 */
  556. Dv0 := VectorDotProduct(N2, V0) + D2;
  557. Dv1 := VectorDotProduct(N2, V1) + D2;
  558. Dv2 := VectorDotProduct(N2, V2) + D2;
  559. if USE_EPSILON_TEST = TRUE then
  560. begin
  561. if (Abs(Dv0) < EPSILON) then
  562. Dv0 := 0.0;
  563. if (Abs(Dv1) < EPSILON) then
  564. Dv1 := 0.0;
  565. if (Abs(Dv2) < EPSILON) then
  566. Dv2 := 0.0;
  567. end;
  568. Dv0dv1 := Dv0 * Dv1;
  569. Dv0dv2 := Dv0 * Dv2;
  570. if (Dv0dv1 > 0.0) and (Dv0dv2 > 0.0) then
  571. begin // * same sign on all of them + not equal 0 ? */
  572. Result := 0; // * no intersection occurs */
  573. Exit;
  574. end;
  575. // * compute direction of intersection line */
  576. D := VectorCrossProduct(N1, N2);
  577. // * compute and index to the largest component of D */
  578. Max := Abs(D.X);
  579. index := 0;
  580. B := Abs(D.Y);
  581. C := Abs(D.Z);
  582. if (B > Max) then
  583. begin
  584. Max := B;
  585. index := 1;
  586. end;
  587. if (C > Max) then
  588. begin
  589. // max:=c; why?
  590. index := 2;
  591. end;
  592. // * this is the simplified projection onto L*/
  593. Vp0 := V0.V[index];
  594. Vp1 := V1.V[index];
  595. Vp2 := V2.V[index];
  596. Up0 := U0.V[index];
  597. Up1 := U1.V[index];
  598. Up2 := U2.V[index];
  599. // * compute interval for triangle 1 */
  600. COMPUTE_INTERVALS(Vp0, Vp1, Vp2, Dv0, Dv1, Dv2, Dv0dv1, Dv0dv2, Isect1[0],
  601. Isect1[1]);
  602. // * compute interval for triangle 2 */
  603. COMPUTE_INTERVALS(Up0, Up1, Up2, Du0, Du1, Du2, Du0du1, Du0du2, Isect2[0],
  604. Isect2[1]);
  605. SORT(Isect1[0], Isect1[1]);
  606. SORT(Isect2[0], Isect2[1]);
  607. if (Isect1[1] < Isect2[0]) or (Isect2[1] < Isect1[0]) then
  608. Result := 0
  609. else
  610. Result := 1;
  611. end;
  612. // ------------------
  613. // ------------------ TGLOctree ------------------
  614. // ------------------
  615. const
  616. MIN = 0;
  617. MID = 1;
  618. MAX = 2;
  619. POINT = 0;
  620. TRIANGLE = 1;
  621. TOPFACE = 0;
  622. BOTTOMFACE = 1;
  623. LEFTFACE = 2;
  624. RIGHTFACE = 3;
  625. FRONTFACE = 4;
  626. BACKFACE = 5;
  627. TOPLEFT = 0;
  628. TOPRIGHT = 1;
  629. BOTTOMLEFT = 2;
  630. BOTTOMRIGHT = 3;
  631. // Theory on FlagMax and FlagMin:
  632. // When a node is subdivided, each of the 8 children assumes 1/8th ownership of its
  633. // parent's bounding box (defined by parent extents). Calculating a child's min/max
  634. // extent only requires 3 values: the parent's min extent, the parent's max extent
  635. // and the midpoint of the parent's extents (since the cube is divided in half twice).
  636. // The following arrays assume that the children are numbered from 0 to 7, named Upper
  637. // and Lower (Upper = top 4 cubes on Y axis, Bottom = lower 4 cubes), Left and Right, and
  638. // Fore and Back (Fore facing furthest away from you the viewer).
  639. // Each node can use its corresponding element in the array to flag the operation needed
  640. // to find its new min/max extent. Note that min, mid and max refer to an array of
  641. // 3 coordinates (x,y,z); each of which are flagged separately. Also note that these
  642. // flags are based on the Y vector being the up vector.
  643. const
  644. FlagMax: array [0 .. 7] of array [0 .. 2] of Byte = ((MID, MAX, MAX),
  645. // Upper Fore Left
  646. (MAX, MAX, MAX), // Upper Fore Right
  647. (MID, MAX, MID), // Upper Back Left
  648. (MAX, MAX, MID), // Upper Back Right
  649. (MID, MID, MAX), // Lower Fore Left (similar to above except height/2)
  650. (MAX, MID, MAX), // Lower Fore Right
  651. (MID, MID, MID), // Lower Back Left
  652. (MAX, MID, MID) // Lower Back Right
  653. );
  654. FlagMin: array [0 .. 7] of array [0 .. 2] of Byte = ((MIN, MID, MID),
  655. // Upper Fore Left
  656. (MID, MID, MID), // Upper Fore Right
  657. (MIN, MID, MIN), // Upper Back Left
  658. (MID, MID, MIN), // Upper Back Right
  659. (MIN, MIN, MID), // Lower Fore Left (similar to above except height/2)
  660. (MID, MIN, MID), // Lower Fore Right
  661. (MIN, MIN, MIN), // Lower Back Left
  662. (MID, MIN, MIN) // Lower Back Right
  663. );
  664. // Design of the AABB faces, using similar method to above.. Note than normals are not
  665. // correct, but not needed for current tri-intersection test.
  666. // Could be removed if the tri-plane collision is replaced with a tri-box routine.
  667. FlagFaces: array [0 .. 23] of array [0 .. 2] of Byte = (
  668. // Top Face
  669. (MIN, MAX, MAX), // Upper left corner
  670. (MAX, MAX, MAX), // Upper right corner
  671. (MAX, MIN, MAX), // Bottom right corner
  672. (MIN, MIN, MAX),
  673. // Bottom Face
  674. (MIN, MAX, MIN), // Upper left corner
  675. (MAX, MAX, MIN), // Upper right corner
  676. (MAX, MIN, MIN), // Bottom right corner
  677. (MIN, MIN, MIN),
  678. // Back Face
  679. (MIN, MAX, MAX), // Upper left corner
  680. (MAX, MAX, MAX), // Upper right corner
  681. (MAX, MAX, MIN), // Bottom right corner
  682. (MIN, MAX, MIN),
  683. // Front Face
  684. (MIN, MIN, MAX), // Upper left corner
  685. (MAX, MIN, MAX), // Upper right corner
  686. (MAX, MIN, MIN), // Bottom right corner
  687. (MIN, MIN, MIN),
  688. // Left Face
  689. (MIN, MAX, MAX), // Upper left corner
  690. (MIN, MIN, MAX), // Upper right corner
  691. (MIN, MIN, MIN), // Bottom right corner
  692. (MIN, MAX, MIN),
  693. // Right Face
  694. (MAX, MIN, MAX), // Upper left corner
  695. (MAX, MAX, MAX), // Upper right corner
  696. (MAX, MAX, MIN), // Bottom right corner
  697. (MAX, MIN, MIN));
  698. destructor TGLOctree.Destroy;
  699. begin
  700. DisposeTree;
  701. inherited Destroy;
  702. end;
  703. procedure TGLOctree.DisposeTree;
  704. procedure WalkDispose(var Node: PGLOctreeNode);
  705. var
  706. I: Integer;
  707. begin
  708. if Assigned(Node) then
  709. begin
  710. for I := 0 to 7 do
  711. WalkDispose(Node^.ChildArray[I]);
  712. Dispose(Node);
  713. end;
  714. end;
  715. begin
  716. WalkDispose(RootNode);
  717. RootNode := nil;
  718. TriangleFiler.Free;
  719. TriangleFiler := nil;
  720. end;
  721. procedure TGLOctree.CreateTree(Depth: Integer);
  722. begin
  723. MaxOlevel := Depth; // initialize max depth.
  724. Refine(Rootnode, 0);
  725. end;
  726. // "cuts" all the triangles in the mesh into the octree.
  727. procedure TGLOctree.CutMesh;
  728. procedure AddTriangleToNodes(N: Integer);
  729. var
  730. X, K: Integer;
  731. P: PGLOctreeNode;
  732. begin
  733. for X := 0 to High(ResultArray) do
  734. begin
  735. P := Resultarray[X]; // Pointer to a node.
  736. K := Length(P^.TriArray);
  737. SetLength(P^.TriArray, K + 1); // Increase array by 1.
  738. P^.TriArray[K] := N; // Store triangle # reference.
  739. {$IFDEF DEBUG}
  740. Inc(Intersections);
  741. {$ENDIF}
  742. end;
  743. end;
  744. var
  745. N: Integer; // n = triangle # in mesh
  746. begin
  747. TriCountMesh := TriangleFiler.Count div 3;
  748. N := 0;
  749. while N < TriangleFiler.Count do
  750. begin
  751. WalkTriToLeaf(RootNode, TriangleFiler.List^[N], TriangleFiler.List^[N + 1],
  752. TriangleFiler.List^[N + 2]);
  753. if ResultArray <> NIL then
  754. begin
  755. AddTriangleToNodes(N);
  756. Inc(TriCountOctree, 1);
  757. end;
  758. Inc(N, 3);
  759. end;
  760. end;
  761. function TGLOctree.GetMidPoint(Min, Max: Single): Single;
  762. begin
  763. Result := Max / 2 + Min / 2;
  764. // This formula is non-quadrant specific; ie: good.
  765. end;
  766. function TGLOctree.GetExtent(const Flags: array of Byte; ParentNode: PGLOctreeNode)
  767. : TAffineFLTVector;
  768. var
  769. Emin, Emax: TAffineFLTVector;
  770. N: Integer;
  771. begin
  772. Emin := ParentNode^.MinExtent; // Some easy to work with variables.
  773. Emax := ParentNode^.MaxExtent;
  774. for N := 0 to 2 do
  775. begin
  776. case Flags[N] of
  777. MIN:
  778. Result.V[N] := Emin.V[N];
  779. MID:
  780. Result.V[N] := GetMidPoint(Emin.V[N], Emax.V[N]);
  781. MAX:
  782. Result.V[N] := Emax.V[N];
  783. end;
  784. end;
  785. end;
  786. procedure TGLOctree.InitializeTree(const AWorldMinExtent, AWorldMaxExtent
  787. : TAffineVector; const ATriangles: TGLAffineVectorList;
  788. const ATreeDepth: Integer);
  789. var
  790. N: Integer;
  791. Newnode: PGLOctreeNode;
  792. begin
  793. Self.WorldMinExtent := AWorldMinExtent;
  794. Self.WorldMaxExtent := AWorldMaxExtent;
  795. // set up the filer data for this mesh
  796. if TriangleFiler = nil then
  797. TriangleFiler := TGLAffineVectorList.Create;
  798. TriangleFiler.Assign(ATriangles);
  799. New(Newnode);
  800. Newnode^.MinExtent := AWorldMinExtent;
  801. Newnode^.MaxExtent := AWorldMaxExtent;
  802. Newnode^.TriArray := NIL;
  803. for N := 0 to 7 do
  804. Newnode^.ChildArray[N] := NIL;
  805. // Initialize work variables for new tree.
  806. Rootnode := Newnode; // rootnode always points to root.
  807. NodeCount := 0; // initialize node count
  808. CreateTree(ATreeDepth);
  809. CutMesh;
  810. end;
  811. procedure TGLOctree.Refine(ParentNode: PGLOctreeNode; Level: Integer);
  812. var
  813. N, X, Z: Integer;
  814. Pwork: array [0 .. 7] of PGLOctreeNode;
  815. // Stores addresses of newly created children.
  816. Newnode: PGLOctreeNode;
  817. begin
  818. if Level < MaxOlevel then
  819. begin
  820. for N := 0 to 7 do
  821. begin // Creates 8 new children under this parent.
  822. Inc(NodeCount);
  823. New(Newnode);
  824. Pwork[N] := Newnode; // Creates work pointers for the next for loop.
  825. // Generate new extents based on parent's extents
  826. Newnode^.MinExtent := GetExtent(FlagMin[N], ParentNode);
  827. Newnode^.MaxExtent := GetExtent(FlagMax[N], ParentNode);
  828. Newnode^.TriArray := nil; // Initialize.
  829. for Z := 0 to 7 do
  830. Newnode^.ChildArray[Z] := nil; // initialize all child pointers to NIL
  831. ParentNode^.ChildArray[N] := Newnode;
  832. // initialize parent's child pointer to this node
  833. end;
  834. for X := 0 to 7 do // Now recursively Refine each child we just made
  835. Refine(Pwork[X], Level + 1);
  836. end; // end if
  837. end;
  838. procedure TGLOctree.ConvertR4(ONode: PGLOctreeNode; const Scale: TAffineFLTVector);
  839. var
  840. N: Smallint;
  841. begin
  842. ScaleVector(Onode^.MinExtent, Scale);
  843. ScaleVector(Onode^.MaxExtent, Scale);
  844. if ONode^.ChildArray[0] <> NIL then
  845. begin // ie: if not a leaf then loop through children.
  846. for N := 0 to 7 do
  847. begin
  848. ConvertR4(Onode^.ChildArray[N], Scale);
  849. end;
  850. end
  851. end;
  852. function TGLOctree.PointInNode(const Min, Max, APoint: TAffineFLTVector): BOOLEAN;
  853. begin
  854. Result := (APoint.X >= Min.X) and
  855. (APoint.Y >= Min.Y) and (APoint.Z >= Min.Z) and
  856. (APoint.X <= Max.X) and (APoint.Y <= Max.Y) and
  857. (APoint.Z <= Max.Z);
  858. end;
  859. procedure TGLOctree.WalkPointToLeaf(Onode: PGLOctreeNode; const P: TAffineVector);
  860. begin
  861. Finalize(Resultarray);
  862. WalkPointToLeafx(Onode, P);
  863. end;
  864. procedure TGLOctree.WalkPointToLeafx(Onode: PGLOctreeNode; const P: TAffineVector);
  865. var
  866. N: Integer;
  867. begin
  868. if PointInNode(Onode^.MinExtent, Onode^.MaxExtent, P) then
  869. begin
  870. if Assigned(Onode^.ChildArray[0]) then
  871. for N := 0 to 7 do
  872. WalkPointToLeafx(Onode^.ChildArray[N], P)
  873. else
  874. begin
  875. SetLength(Resultarray, Length(Resultarray) + 1);
  876. Resultarray[High(Resultarray)] := Onode;
  877. end;
  878. end;
  879. end;
  880. function TGLOctree.SphereInNode(const MinExtent, MaxExtent: TAffineVector;
  881. const C: TGLVector; Radius: Single): Boolean;
  882. // Sphere-AABB intersection by Miguel Gomez
  883. var
  884. S, D: Single;
  885. I: Integer;
  886. begin
  887. // find the square of the distance
  888. // from the sphere to the box
  889. D := 0;
  890. for I := 0 to 2 do
  891. begin
  892. if (C.V[I] < MinExtent.V[I]) then
  893. begin
  894. S := C.V[I] - MinExtent.V[I];
  895. D := D + S * S;
  896. end
  897. else if (C.V[I] > MaxExtent.V[I]) then
  898. begin
  899. S := C.V[I] - MaxExtent.V[I];
  900. D := D + S * S;
  901. end;
  902. end; // end for
  903. if D <= Radius * Radius then
  904. Result := TRUE
  905. else
  906. Result := FALSE;
  907. end;
  908. procedure TGLOctree.WalkSphereToLeaf(Onode: PGLOctreeNode; const P: TGLVector;
  909. Radius: Single);
  910. begin
  911. Finalize(Resultarray);
  912. WalkSphereToLeafx(Onode, P, Radius);
  913. end;
  914. procedure TGLOctree.WalkSphereToLeafx(Onode: PGLOctreeNode; const P: TGLVector;
  915. Radius: Single);
  916. var
  917. N: Integer;
  918. begin
  919. if SphereInNode(Onode^.MinExtent, Onode^.MaxExtent, P, Radius) then
  920. begin
  921. if Assigned(Onode^.ChildArray[0]) then
  922. for N := 0 to 7 do
  923. WalkSphereToLeafx(Onode^.ChildArray[N], P, Radius)
  924. else
  925. begin
  926. SetLength(Resultarray, Length(Resultarray) + 1);
  927. Resultarray[High(Resultarray)] := Onode;
  928. end;
  929. end;
  930. end;
  931. // Cast a ray (point p, vector v) into the Octree (ie: ray-box intersect).
  932. procedure TGLOctree.WalkRayToLeaf(Onode: PGLOctreeNode; const P, V: TGLVector);
  933. begin
  934. Finalize(Resultarray);
  935. WalkRayToLeafx(Onode, P, V);
  936. end;
  937. procedure TGLOctree.WalkRayToLeafx(Onode: PGLOctreeNode; const P, V: TGLVector);
  938. var
  939. N: Integer;
  940. Coord: TGLVector;
  941. begin
  942. if HitBoundingBox(Onode^.MinExtent, Onode^.MaxExtent, P, V, Coord) then
  943. begin
  944. if Assigned(Onode^.ChildArray[0]) then
  945. for N := 0 to 7 do
  946. WalkRayToLeafx(Onode^.ChildArray[N], P, V)
  947. else
  948. begin
  949. SetLength(Resultarray, Length(Resultarray) + 1);
  950. Resultarray[High(Resultarray)] := Onode;
  951. end;
  952. end;
  953. end;
  954. // Check triangle intersect with any of the node's faces.
  955. // Could be replaced with a tri-box check.
  956. function TGLOctree.TriIntersectNode(const MinExtent, MaxExtent, V1, V2,
  957. V3: TAffineVector): Boolean;
  958. var
  959. F0, F1, F2, F3: TAffineFLTVector;
  960. N, O, P: Integer;
  961. AFace: array [0 .. 3] of TAffineFLTVector; // A face's 4 corners.
  962. begin
  963. for N := 0 to 5 do
  964. begin // Do all 6 faces.
  965. for O := 0 to 3 do
  966. begin // Do all 4 vertices for the face.
  967. for P := 0 to 2 do
  968. begin // Do x,y,z for each vertex.
  969. if FlagFaces[O + N * 4, P] = MIN then
  970. AFace[O].V[P] := MinExtent.V[P]
  971. else
  972. AFace[O].V[P] := MaxExtent.V[P];
  973. end; // end for o
  974. end; // end for p
  975. F0 := AFace[0];
  976. F1 := AFace[1];
  977. F2 := AFace[2];
  978. F3 := AFace[3];
  979. // Now check the two triangles in the face against the mesh triangle.
  980. if Tri_tri_intersect(V1, V2, V3, F0, F1, F2) = 1 then
  981. Result := TRUE
  982. else if Tri_tri_intersect(V1, V2, V3, F2, F3, F0) = 1 then
  983. Result := TRUE
  984. else
  985. Result := FALSE;
  986. if Result then
  987. Exit;
  988. end; // end for n
  989. end;
  990. procedure TGLOctree.WalkTriToLeaf(Onode: PGLOctreeNode;
  991. const V1, V2, V3: TAffineFLTVector);
  992. begin
  993. Finalize(Resultarray);
  994. WalkTriToLeafx(Onode, V1, V2, V3);
  995. end;
  996. procedure TGLOctree.WalkTriToLeafx(Onode: PGLOctreeNode;
  997. const V1, V2, V3: TAffineFLTVector);
  998. var
  999. M: Integer;
  1000. begin
  1001. if TriIntersectNode(Onode^.MinExtent, Onode^.MaxExtent, V1, V2, V3) or
  1002. PointInNode(Onode^.MinExtent, Onode^.MaxExtent, V1) or
  1003. PointInNode(Onode^.MinExtent, Onode^.MaxExtent, V2) or
  1004. PointInNode(Onode^.MinExtent, Onode^.MaxExtent, V3) then
  1005. begin
  1006. if Onode^.ChildArray[0] <> NIL then
  1007. for M := 0 to 7 do
  1008. WalkTriToLeafx(Onode^.ChildArray[M], V1, V2, V3)
  1009. else
  1010. begin
  1011. SetLength(Resultarray, Length(Resultarray) + 1);
  1012. Resultarray[High(Resultarray)] := Onode;
  1013. end;
  1014. end;
  1015. end;
  1016. function TGLOctree.RayCastIntersect(const RayStart, RayVector: TGLVector;
  1017. IntersectPoint: PGLVector = nil; IntersectNormal: PGLVector = nil;
  1018. TriangleInfo: POctreeTriangleInfo = nil): Boolean;
  1019. const
  1020. CInitialMinD: Single = 1E40;
  1021. var
  1022. I, T, K: Integer;
  1023. D, MinD: Single;
  1024. P: PGLOctreeNode;
  1025. IPoint, INormal: TGLVector;
  1026. begin
  1027. WalkRayToLeaf(RootNode, RayStart, RayVector);
  1028. if Resultarray = nil then
  1029. begin
  1030. Result := False;
  1031. Exit;
  1032. end;
  1033. MinD := CInitialMinD;
  1034. for I := 0 to High(Resultarray) do
  1035. begin
  1036. P := ResultArray[I];
  1037. for T := 0 to High(P^.TriArray) do
  1038. begin
  1039. K := P^.Triarray[T];
  1040. if RayCastTriangleIntersect(RayStart, RayVector, TriangleFiler.List^[K],
  1041. TriangleFiler.List^[K + 1], TriangleFiler.List^[K + 2], @IPoint,
  1042. @INormal) then
  1043. begin
  1044. D := VectorDistance2(RayStart, IPoint);
  1045. if D < MinD then
  1046. begin
  1047. MinD := D;
  1048. if IntersectPoint <> nil then
  1049. IntersectPoint^ := IPoint;
  1050. if IntersectNormal <> nil then
  1051. IntersectNormal^ := INormal;
  1052. if TriangleInfo <> nil then
  1053. begin
  1054. TriangleInfo^.Index := K;
  1055. TriangleInfo^.Vertex[0] := TriangleFiler.List^[K];
  1056. TriangleInfo^.Vertex[1] := TriangleFiler.List^[K + 1];
  1057. TriangleInfo^.Vertex[2] := TriangleFiler.List^[K + 2];
  1058. end;
  1059. end;
  1060. end;
  1061. end;
  1062. end;
  1063. Result := (MinD <> CInitialMinD);
  1064. end;
  1065. // SphereIntersectAABB -- Walk a sphere through an Octree, given a velocity, and return the nearest polygon
  1066. // intersection point on that sphere, and its plane normal.
  1067. //
  1068. // **** This function is the result of a LOT of work and experimentation with both Paul Nettle's method
  1069. // (www.fluidstudios.com) and Telemachos' method (www.peroxide.dk) over a period of about 2 months. If
  1070. // you find ways to optimize the general structure, please let me know at [email protected]. ****
  1071. //
  1072. // TO DO: R4 conversion (routine already exists for this) for ellipsoid space.
  1073. //
  1074. // Method for caclulating CD vs polygon: (Robert Hayes method)
  1075. // ...for each triangle:
  1076. // 1. Cast a ray from sphere origin to triangle's plane along plane's negative normal (set to length
  1077. // of sphere radius). If no hit, skip this triangle. Otherwise this is the default plane
  1078. // intersection point.
  1079. // 2. If the distance is =< the sphere radius, the plane is embedded in the sphere. Go to step 6 with
  1080. // plane intersection point from above step.
  1081. // 3. If the distance > sphere radius, calculate the sphere intersection point to this plane by
  1082. // subtracting the plane's normal from the sphere's origin.
  1083. // 4. Cast a new ray from the sphere intersection point to the plane; this is the new plane
  1084. // intersection point.
  1085. // 5. Cast a ray from the sphere intersection point to the triangle. If it is a direct hit, then
  1086. // this point is the polygon intersection point.
  1087. // 6. Else, find the point on the triangle that is closest to the plane intersection point; this becomes
  1088. // the polygon intersection point (ie: hit an edge or corner)
  1089. // 7. Cast a ray from the polygon intersection point along the negative velocity vector of the sphere
  1090. // (note: for accuracy reasons - SphereIntersect replaced with PointInSphere)
  1091. // 8. If there is no intersection, the sphere cannot possibly collide with this triangle
  1092. // 9. Else, save the distance from step 8 if, and only if, it is the shortest collision distance so far.
  1093. //
  1094. // Return the polygon intersection point and the closest triangle's normal if hit.
  1095. //
  1096. function TGLOctree.SphereSweepIntersect(const RayStart, RayVector: TGLVector;
  1097. const Velocity, Radius: Single; IntersectPoint: PGLVector = nil;
  1098. IntersectNormal: PGLVector = nil): Boolean;
  1099. const
  1100. CInitialMinD2: Single = 1E40;
  1101. CEpsilon: Single = 0.05;
  1102. var
  1103. I, T, K: Integer;
  1104. MinD2, Sd2, Radius2: Single;
  1105. DistanceToTravel, DistanceToTravelMinusRadius2: Single;
  1106. P: PGLOctreeNode;
  1107. PNormal: TAffineVector;
  1108. PNormal4: TGLVector;
  1109. NEGpNormal4: TGLVector;
  1110. SIPoint, SIPoint2: TGLVector; // sphere intersection point
  1111. PIPoint: TGLVector; // plane intersection point
  1112. PolyIPoint: TGLVector; // polygon intersection point
  1113. NEGVelocity: TGLVector; // sphere's forward velocity
  1114. DirectHit: Boolean;
  1115. P1, P2, P3: PAffineVector;
  1116. // SphereSweepAABB:TAABB;
  1117. // response identifiers (for future use)
  1118. // destinationPoint, newdestinationPoint: TGLVector;
  1119. // slidePlaneOrigin, slidePlaneNormal: TGLVector;
  1120. // newvelocityVector: TGLVector;
  1121. // v: single;
  1122. // L: double;
  1123. begin
  1124. // Note: Current implementation only accurate for FreeForm:Radius at 1:1 ratio.
  1125. Result := False; // default: no collision
  1126. // quit if no movement
  1127. if (Velocity = 0) or (not(VectorNorm(RayVector) > 0)) then
  1128. Exit;
  1129. // How far ahead to check for collisions.
  1130. DistanceToTravel := Velocity + Radius + CEpsilon;
  1131. DistanceToTravelMinusRadius2 := Sqr(Velocity + CEpsilon);
  1132. Radius2 := Sqr(Radius);
  1133. // Determine all the octree nodes this sphere intersects with.
  1134. // NOTE: would be more efficient to find the bounding box that includes the
  1135. // startpoint and endpoint (+sphere diameter)... especially with a large sphere
  1136. // and/or a large velocity.
  1137. WalkSphereToLeaf(RootNode, RayStart, DistanceToTravel);
  1138. // This method may be more effective if sphere sweeps from one point to another and stops.
  1139. // NOTE: If it recursively slides of planes, then WalkSphereToLeaf would probably be better, as
  1140. // it will determine all possible triangles that could intersect over the whole motion
  1141. // AABBFromSweep(SphereSweepAABB,rayStart,destinationPoint,Radius+cEpsilon);
  1142. // GetTrianglesFromNodesIntersectingAABB(SphereSweepAABB);
  1143. if not Assigned(Resultarray) then
  1144. Exit;
  1145. // Negative velocity vector for use with ray-sphere check.
  1146. VectorScale(RayVector, -Velocity / VectorLength(RayVector), NEGVelocity);
  1147. MinD2 := CInitialMinD2;
  1148. for I := 0 to High(Resultarray) do
  1149. begin
  1150. P := ResultArray[I];
  1151. for T := 0 to High(P^.TriArray) do
  1152. begin
  1153. K := P^.Triarray[T];
  1154. // These are the vertices of the triangle to check
  1155. P1 := @Trianglefiler.List[K];
  1156. P2 := @Trianglefiler.List[K + 1];
  1157. P3 := @Trianglefiler.List[K + 2];
  1158. // Creates the normal for this triangle
  1159. PNormal := CalcPlaneNormal(P1^, P2^, P3^);
  1160. // Ignore backfacing planes
  1161. if VectorDotProduct(PNormal, PAffineVector(@RayVector)^) > 0.0 then
  1162. Continue;
  1163. // Set the normal to the radius of the sphere
  1164. ScaleVector(PNormal, Radius);
  1165. // Make some TVectors
  1166. MakeVector(PNormal4, PNormal);
  1167. NEGpNormal4 := VectorNegate(PNormal4);
  1168. // Calculate the plane intersection point (sphere origin to plane)
  1169. if RayCastPlaneIntersect(RayStart, NEGpNormal4, VectorMake(P1^), PNormal4,
  1170. @PIPoint) then
  1171. begin
  1172. DirectHit := False;
  1173. Sd2 := VectorDistance2(RayStart, PIPoint);
  1174. // If sd <= radius, fall through to "not direct hit" code below with pIPoint
  1175. // as the plane intersection point. Sphere is embedded.
  1176. // Otherwise...
  1177. if Sd2 > Radius2 then
  1178. begin
  1179. // Calculate sphere intersection point (ie: point on sphere that hits plane)
  1180. SetVector(SIPoint, VectorSubtract(RayStart, PNormal4));
  1181. // Get new plane intersection point (in case not a direct hit)
  1182. RayCastPlaneIntersect(SIPoint, RayVector, VectorMake(P1^), PNormal4,
  1183. @PIPoint);
  1184. // Does the velocity vector directly hit the triangle? If yes then that is the
  1185. // polygon intersection point.
  1186. if RayCastTriangleIntersect(SIPoint, RayVector, P1^, P2^, P3^,
  1187. @PolyIPoint, @PNormal4) then
  1188. begin
  1189. Sd2 := VectorDistance2(SIPoint, PolyIPoint);
  1190. DirectHit := True;
  1191. end;
  1192. end;
  1193. // If not a direct hit then check if sphere "nicks" the triangle's edge or corner...
  1194. // If it does then that is the polygon intersection point.
  1195. if not DirectHit then
  1196. begin
  1197. if not CheckPointInTriangle(AffineVectorMake(PiPoint), P1^, P2^, P3^)
  1198. then
  1199. SetVector(PolyIPoint, ClosestPointOnTriangleEdge(P1^, P2^, P3^,
  1200. PAffineVector(@PIPoint)^), 1)
  1201. else
  1202. PolyIPoint := PiPoint;
  1203. // See if this point + negative velocity vector lies within the sphere.
  1204. // (This implementation seems more accurate than RayCastSphereIntersect)
  1205. { if not CheckPointInSphere(VectorAdd(polyIPoint, NEGVelocity), raystart, radius) then
  1206. continue;
  1207. // sd2:=0; //stops the test too soon (noticable on triangle edges in flat planes)
  1208. sd2:=sqr(VectorDistance(raystart, polyIPoint)-Radius);
  1209. }
  1210. // see if this point + negative velocity vector intersect the sphere.
  1211. // (PointInSphere doesn't work for fast motion)
  1212. if VectorDistance2(PolyIPoint, RayStart) > Radius2 then
  1213. begin
  1214. if RayCastSphereIntersect(PolyIPoint, VectorNormalize(NEGVelocity),
  1215. RayStart, Radius, SIPoint, SIPoint2) = 0 then
  1216. Continue;
  1217. Sd2 := VectorDistance2(SIPoint, PolyIPoint);
  1218. end
  1219. else
  1220. Sd2 := 0;
  1221. end;
  1222. // Allow sphere to get close to triangle (less epsilon which is built into distanceToTravel)
  1223. if Sd2 <= DistanceToTravelMinusRadius2 then
  1224. begin
  1225. Result := True; // flag a collision
  1226. if Sd2 < MinD2 then
  1227. begin
  1228. MinD2 := Sd2;
  1229. if IntersectPoint <> nil then
  1230. IntersectPoint^ := PolyIPoint;
  1231. if IntersectNormal <> nil then
  1232. IntersectNormal^ := PNormal4;
  1233. if Sd2 = 0 then
  1234. Exit;
  1235. end;
  1236. end;
  1237. end;
  1238. end; // end for t triangles
  1239. end; // end for i nodes
  1240. end;
  1241. function TGLOctree.TriangleIntersect(const V1, V2, V3: TAffineVector): Boolean;
  1242. var
  1243. I, T, K: Integer;
  1244. P: PGLOctreeNode;
  1245. P1, P2, P3: PAffineVector;
  1246. begin
  1247. Result := False; // default: no collision
  1248. WalkTriToLeaf(RootNode, V1, V2, V3);
  1249. if not Assigned(Resultarray) then
  1250. Exit;
  1251. for I := 0 to High(Resultarray) do
  1252. begin
  1253. P := ResultArray[I];
  1254. for T := 0 to High(P^.TriArray) do
  1255. begin
  1256. K := P^.Triarray[T];
  1257. // These are the vertices of the triangle to check
  1258. P1 := @Trianglefiler.List[K];
  1259. P2 := @Trianglefiler.List[K + 1];
  1260. P3 := @Trianglefiler.List[K + 2];
  1261. if Tri_tri_intersect(V1, V2, V3, P1^, P2^, P3^) <> 0 then
  1262. begin
  1263. Result := True;
  1264. Exit;
  1265. end;
  1266. end; // end for t triangles
  1267. end; // end for i nodes
  1268. end;
  1269. function TGLOctree.AABBIntersect(const AABB: TAABB; const M1to2, M2to1: TGLMatrix;
  1270. Triangles: TGLAffineVectorList = nil): Boolean;
  1271. var
  1272. TriList: TGLAffineVectorList;
  1273. I: Integer;
  1274. begin
  1275. // get triangles in nodes intersected by the aabb
  1276. TriList := GetTrianglesFromNodesIntersectingCube(Aabb, M1to2, M2to1);
  1277. Result := False;
  1278. if Trilist.Count > 0 then
  1279. begin
  1280. Trilist.TransformAsPoints(M2to1);
  1281. I := 0;
  1282. // run all faces and check if they're inside the aabb
  1283. // uncoment the * and comment the {//} to check only vertices
  1284. { // } while I < TriList.Count - 1 do
  1285. begin
  1286. // *for i:= 0 to triList.count -1 do begin
  1287. // * v:=VectorMake(TriList.Items[i]);
  1288. // * if pointInAABB(AffinevectorMake(v), aabb) then
  1289. { // } if TriangleIntersectAABB(Aabb, TriList[I], TriList[I + 1],
  1290. Trilist[I + 2]) then
  1291. begin
  1292. Result := True;
  1293. if not Assigned(Triangles) then
  1294. Break
  1295. else
  1296. Triangles.Add(TriList[I], TriList[I + 1], Trilist[I + 2]);
  1297. end;
  1298. { // } I := I + 3;
  1299. end;
  1300. end;
  1301. TriList.Free;
  1302. end;
  1303. function TGLOctree.GetTrianglesFromNodesIntersectingAABB(const ObjAABB: TAABB)
  1304. : TGLAffineVectorList;
  1305. var
  1306. AABB1: TAABB;
  1307. procedure HandleNode(Onode: PGLOctreeNode);
  1308. var
  1309. AABB2: TAABB;
  1310. I: Integer;
  1311. begin
  1312. AABB2.Min := Onode^.MinExtent;
  1313. AABB2.Max := Onode^.MaxExtent;
  1314. if IntersectAABBsAbsolute(AABB1, AABB2) then
  1315. begin
  1316. if Assigned(Onode^.ChildArray[0]) then
  1317. begin
  1318. for I := 0 to 7 do
  1319. HandleNode(Onode^.ChildArray[I])
  1320. end
  1321. else
  1322. begin
  1323. SetLength(ResultArray, Length(ResultArray) + 1);
  1324. ResultArray[High(ResultArray)] := Onode;
  1325. end;
  1326. end;
  1327. end;
  1328. var
  1329. I, K: Integer;
  1330. P: PGLOctreeNode;
  1331. TriangleIndices: TGLIntegerList;
  1332. begin
  1333. // Calc AABBs
  1334. AABB1 := ObjAABB;
  1335. SetLength(ResultArray, 0);
  1336. if Assigned(RootNode) then
  1337. HandleNode(RootNode);
  1338. Result := TGLAffineVectorList.Create;
  1339. TriangleIndices := TGLIntegerList.Create;
  1340. try
  1341. // fill the triangles from all nodes in the resultarray to AL
  1342. for I := 0 to High(ResultArray) do
  1343. begin
  1344. P := ResultArray[I];
  1345. TriangleIndices.AddIntegers(P^.TriArray);
  1346. end;
  1347. TriangleIndices.SortAndRemoveDuplicates;
  1348. Result.Capacity := TriangleIndices.Count * 3;
  1349. for I := 0 to TriangleIndices.Count - 1 do
  1350. begin
  1351. K := TriangleIndices[I];
  1352. Result.Add(TriangleFiler.List^[K], TriangleFiler.List^[K + 1],
  1353. TriangleFiler.List^[K + 2]);
  1354. end;
  1355. finally
  1356. TriangleIndices.Free;
  1357. end;
  1358. end;
  1359. function TGLOctree.GetTrianglesFromNodesIntersectingCube(const ObjAABB: TAABB;
  1360. const ObjToSelf, SelfToObj: TGLMatrix): TGLAffineVectorList;
  1361. var
  1362. AABB1: TAABB;
  1363. M1To2, M2To1: TGLMatrix;
  1364. procedure HandleNode(Onode: PGLOctreeNode);
  1365. var
  1366. AABB2: TAABB;
  1367. I: Integer;
  1368. begin
  1369. AABB2.Min := Onode^.MinExtent;
  1370. AABB2.Max := Onode^.MaxExtent;
  1371. if IntersectAABBs(AABB1, AABB2, M1To2, M2To1) then
  1372. begin
  1373. if Assigned(Onode^.ChildArray[0]) then
  1374. begin
  1375. for I := 0 to 7 do
  1376. HandleNode(Onode^.ChildArray[I])
  1377. end
  1378. else
  1379. begin
  1380. SetLength(ResultArray, Length(ResultArray) + 1);
  1381. ResultArray[High(ResultArray)] := Onode;
  1382. end;
  1383. end;
  1384. end;
  1385. var
  1386. I, K: Integer;
  1387. P: PGLOctreeNode;
  1388. TriangleIndices: TGLIntegerList;
  1389. begin
  1390. // Calc AABBs
  1391. AABB1 := ObjAABB;
  1392. // Calc Conversion Matrixes
  1393. M1To2 := ObjToSelf;
  1394. M2To1 := SelfToObj;
  1395. SetLength(ResultArray, 0);
  1396. if Assigned(RootNode) then
  1397. HandleNode(RootNode);
  1398. Result := TGLAffineVectorList.Create;
  1399. TriangleIndices := TGLIntegerList.Create;
  1400. try
  1401. // fill the triangles from all nodes in the resultarray to AL
  1402. for I := 0 to High(ResultArray) do
  1403. begin
  1404. P := ResultArray[I];
  1405. TriangleIndices.AddIntegers(P^.TriArray);
  1406. end;
  1407. TriangleIndices.SortAndRemoveDuplicates;
  1408. Result.Capacity := TriangleIndices.Count * 3;
  1409. for I := 0 to TriangleIndices.Count - 1 do
  1410. begin
  1411. K := TriangleIndices[I];
  1412. Result.Add(TriangleFiler.List^[K], TriangleFiler.List^[K + 1],
  1413. TriangleFiler.List^[K + 2]);
  1414. end;
  1415. finally
  1416. TriangleIndices.Free;
  1417. end;
  1418. end;
  1419. end.