GXS.Octree.pas 47 KB

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