GLVectorRecTypes.pas 36 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385
  1. //
  2. // This unit is part of the GLScene Engine, http://glscene.org
  3. //
  4. unit GLVectorRecTypes;
  5. (* Defines common vector types as advanced records *)
  6. interface
  7. {$I GLScene.inc}
  8. uses
  9. System.Types,
  10. System.SysUtils,
  11. System.Rtti,
  12. System.Math,
  13. System.Math.Vectors,
  14. GLVectorTypes;
  15. type
  16. TAbstractVector = array of Extended;
  17. TAbstractMatrix = array of array of Extended;
  18. TxQuaternion = record
  19. private
  20. FData: array[0..3] of Extended;
  21. procedure SetElement(Index: Byte; Value: Extended);
  22. function GetElement(Index: Byte): Extended;
  23. public
  24. constructor Create(Q: TAbstractVector);
  25. class operator Multiply(Q1, Q2: TxQuaternion): TxQuaternion;
  26. class operator Multiply(Q: TxQuaternion; Sc: Extended): TxQuaternion;
  27. class operator Multiply(Scalar: Extended; Q: TxQuaternion): TxQuaternion;
  28. class operator Implicit(V: TAbstractVector): TxQuaternion;
  29. function Inv: TxQuaternion;
  30. function TruncateSTI: TxQuaternion;
  31. property Element[index: Byte]: Extended read GetElement
  32. write SetElement; default;
  33. end;
  34. PxVector = ^TxVector;
  35. TxVector = record
  36. private
  37. FData: TAbstractVector;
  38. FCount: Word;
  39. procedure SetElement(Index: Word; Value: Extended);
  40. function GetElement(Index: Word): Extended;
  41. procedure CheckUnique;
  42. public
  43. constructor Create(ElementsCount: Word); overload;
  44. constructor Create(V: TAbstractVector); overload;
  45. class operator Add(V1, V2: TxVector): TxVector;
  46. class operator Add(V: TxVector; Scalar: Extended): TxVector;
  47. class operator Add(Scalar: Extended; V: TxVector): TxVector;
  48. class operator Subtract(V1, V2: TxVector): TxVector;
  49. class operator Subtract(Scalar: Extended; V: TxVector): TxVector;
  50. class operator Subtract(V: TxVector; Scalar: Extended): TxVector;
  51. class operator Multiply(V1, V2: TxVector): TxVector;
  52. class operator Multiply(V: TxVector; Scalar: Extended): TxVector;
  53. class operator Multiply(Scalar: Extended; V: TxVector): TxVector;
  54. class operator Divide(V: TxVector; Scalar: Extended): TxVector;
  55. class operator Divide(V1, V2: TxVector): TxVector;
  56. class operator Implicit(V: TAbstractVector): TxVector;
  57. function Norm: Extended;
  58. function SumOfSquares: Extended;
  59. function SumOfElments: Extended;
  60. function TruncateSTI: TxVector;
  61. function ToQuat: TxQuaternion;
  62. procedure Fill(Value: Extended);
  63. function ScalarMult(V: TxVector): Extended;
  64. property Count: Word read FCount;
  65. property Elements[index: Word]: Extended read GetElement
  66. write SetElement; default;
  67. end;
  68. PxMatrix = ^TxMatrix;
  69. TxMatrix = record
  70. private
  71. FData: TAbstractMatrix;
  72. FRowsCount: Word;
  73. FColsCount: Word;
  74. procedure SetElement(Row, Col: Word; Value: Extended);
  75. function GetElement(Row, Col: Word): Extended;
  76. function GetRow(Row: Word): TxVector;
  77. procedure SetRow(Row: Word; Value: TxVector);
  78. function GetCol(Col: Word): TxVector;
  79. procedure SetCol(Col: Word; Value: TxVector);
  80. function Del(A: TxMatrix; I, J: Integer; M: Integer): TxMatrix;
  81. function Det(A: TxMatrix; M: Integer): Extended;
  82. procedure CheckUnique;
  83. public
  84. constructor Create(RowsCount, ColsCount: Word); overload;
  85. constructor CreateDiag(Dim: Word; Value: Extended = 1.0);
  86. constructor Create(M: TAbstractMatrix); overload;
  87. class operator Add(M1, M2: TxMatrix): TxMatrix;
  88. class operator Subtract(M1, M2: TxMatrix): TxMatrix;
  89. class operator Multiply(M1, M2: TxMatrix): TxMatrix;
  90. class operator Multiply(M: TxMatrix; V: TxVector): TxVector;
  91. class operator Multiply(V: TxVector; M: TxMatrix): TxVector;
  92. class operator Multiply(M: TxMatrix; Scalar: Extended): TxMatrix;
  93. class operator Multiply(Scalar: Extended; M: TxMatrix): TxMatrix;
  94. class operator Multiply(M: TxMatrix; Q: TxQuaternion): TxQuaternion;
  95. class operator Implicit(M: TAbstractMatrix): TxMatrix;
  96. function Transp: TxMatrix;
  97. function Inv: TxMatrix;
  98. function ToQuat: TxQuaternion;
  99. function Determinant: Extended;
  100. function TruncateSTI: TxMatrix;
  101. function Trace: Extended; // sum on diagonal elements
  102. procedure Fill(Scalar: Extended);
  103. property RowCount: Word read FRowsCount;
  104. property ColCount: Word read FColsCount;
  105. property Row[Row: Word]: TxVector read GetRow write SetRow;
  106. property Col[Col: Word]: TxVector read GetCol write SetCol;
  107. property Elements[Row, Col: Word]: Extended read GetElement
  108. write SetElement; default;
  109. end;
  110. TxQuatHelper = record helper for TxQuaternion
  111. function ToMatrix: TxMatrix;
  112. end;
  113. TxVecHelper = record helper for TxVector
  114. function ToDiagMatrix: TxMatrix;
  115. end;
  116. TxDim = class(TCustomAttribute)
  117. private
  118. FRowCount: Integer;
  119. FColCount: Integer;
  120. public
  121. constructor Create(ARowCount: Integer; AColCount: Integer = 0); overload;
  122. property RowCount: Integer read FRowCount;
  123. property ColCount: Integer read FColCount;
  124. end;
  125. function TxVec(V: TAbstractVector): TxVector;
  126. function TxMat(M: TAbstractMatrix): TxMatrix;
  127. function TxQuat(Q: TAbstractVector): TxQuaternion;
  128. procedure Init(Obj, TypeInfoOfObj: Pointer; Offset: Integer = 0);
  129. //-----------------------
  130. // Point types
  131. //-----------------------
  132. type
  133. TxScalarValue = Single;
  134. TxScalarField = function(X, Y, Z: Single): TxScalarValue;
  135. // If data are made on integer XYZ index
  136. TxScalarFieldInt = function(iX, iY, iZ: Integer): TxScalarValue of object;
  137. TxVertex = record
  138. P, N: TVector3f; //Point and Normal
  139. Density: Single;
  140. end;
  141. TxFace = record
  142. Normal: TVector3f;
  143. V1: TVector3f; // vertex 1
  144. V2: TVector3f; // vertex 2
  145. V3: TVector3f; // vertex 3
  146. Padding: array [0 .. 1] of Byte;
  147. end;
  148. PxPoint2D = ^TxPoint2D;
  149. TxPoint2D = record
  150. X: Single;
  151. Y: Single;
  152. public
  153. function Create(X, Y : Single): TxPoint2D;
  154. procedure SetPosition(const X, Y : Single);
  155. function Add(const APoint2D: TxPoint2D): TxPoint2D;
  156. function Length: Single; //distance to origin
  157. function Distance(const APoint2D : TxPoint2D) : Single;
  158. class function PointInCircle(const Point, Center: TxPoint2D;
  159. const Radius: Integer):Boolean; static; inline;
  160. procedure Offset(const ADeltaX, ADeltaY : Single);
  161. end;
  162. PxPoint3D = ^TxPoint3D;
  163. TxPoint3D = record
  164. X: Single;
  165. Y: Single;
  166. Z: Single;
  167. public
  168. function Create(X, Y, Z: Single): TxPoint3D;
  169. procedure SetPosition(const X, Y, Z : Single);
  170. function Add(const AGLPoint3D: TxPoint3D): TxPoint3D;
  171. function Length: Single; //distance to origin
  172. function Distance(const APoint3D : TxPoint3D) : Single;
  173. procedure Offset(const ADeltaX, ADeltaY, ADeltaZ : Single);
  174. end;
  175. TxPoint2DArray = array of TxPoint2D;
  176. TxPoint3DArray = array of TxPoint3D;
  177. // Voxel types
  178. TxVoxelStatus = (bpExternal, bpInternal);
  179. TxVoxel = record
  180. P: TVector3f;
  181. Density: TxScalarValue;
  182. Status: TxVoxelStatus;
  183. end;
  184. PxVoxel = ^TxVoxel;
  185. TxVoxelData = array [0 .. (MaxInt shr 8)] of TxVoxel;
  186. PxVoxelData = ^TxVoxelData;
  187. //-----------------------
  188. // Vector types
  189. //-----------------------
  190. TxVector2DType = array [0..1] of Single;
  191. TxVector3DType = array [0..2] of Single;
  192. TxVector2D = record
  193. function Create(const AX, AY, AW : Single): TxVector2D;
  194. function Add(const AVector2D: TxVector2D): TxVector2D;
  195. function Length: Single;
  196. function Norm: Single;
  197. function Normalize: TxVector2D;
  198. function CrossProduct(const AVector: TxVector2D): TxVector2D;
  199. function DotProduct(const AVector: TxVector2D): Single;
  200. case Integer of
  201. 0: (V: TxVector2DType;);
  202. 1: (X: Single;
  203. Y: Single;
  204. W: Single;)
  205. end;
  206. TxVector3D = record
  207. function Create(const AX, AY, AZ, AW : Single): TxVector3D;
  208. function Add(const AVector3D: TxVector3D): TxVector3D;
  209. function Length: Single;
  210. function Norm: Single;
  211. function Normalize: TxVector3D;
  212. function CrossProduct(const AVector3D: TVector3D): TVector3D;
  213. function DotProduct(const AVector3D: TVector3D): Single; inline;
  214. case Integer of
  215. 0: (V: TxVector3DType;);
  216. 1: (X: Single;
  217. Y: Single;
  218. Z: Single;
  219. W: Single;)
  220. end;
  221. // Vector Arrays
  222. TxVector2DArray = array of TxVector2D;
  223. TxVector3DArray = array of TxVector3D;
  224. //-----------------------
  225. // Matrix types
  226. //-----------------------
  227. TxMatrix2DType = array[0..3] of TxVector2D;
  228. TxMatrix3DType = array[0..3] of TxVector3D;
  229. TxMatrix2D = record
  230. private
  231. public
  232. case Integer of
  233. 0: (M: TxMatrix2DType;);
  234. 1: (e11, e12, e13: Single;
  235. e21, e22, e23: Single;
  236. e31, e32, e33: Single);
  237. end;
  238. TxMatrix3D = record
  239. private
  240. public
  241. case Integer of
  242. 0: (M: TxMatrix3DType;);
  243. 1: (e11, e12, e13, e14: Single;
  244. e21, e22, e23, e24: Single;
  245. e31, e32, e33, e34: Single;
  246. e41, e42, e43, e44: Single);
  247. end;
  248. // Matrix Arrays
  249. TxMatrix2DArray = array of TxMatrix2D;
  250. TxMatrix3DArray = array of TxMatrix3D;
  251. //-----------------------
  252. // Polygon types
  253. //-----------------------
  254. TxPolygon2D = TxPoint2DArray;
  255. TxPolygon3D = TxPoint3DArray;
  256. {
  257. TxPolygon3D = record
  258. Vertices: array of TxPoint3D;
  259. function Area;
  260. end;
  261. }
  262. const
  263. ClosedPolygon2D: TxPoint2D = (X: $FFFF; Y: $FFFF);
  264. ClosedPolygon3D: TxPoint3D = (X: $FFFF; Y: $FFFF; Z: $FFFF);
  265. type
  266. PxVertexArray = ^TxVertexArray;
  267. TxVertexArray = array [0 .. (MaxInt shr 8)] of TxVertex;
  268. type
  269. TxTriangle = record
  270. v1, v2, v3: Integer;
  271. ///Vertices: array[0..2] of TxPoint3D;
  272. ///function Area;
  273. end;
  274. PxTriangleArray = ^TxTriangleArray;
  275. TxTriangleArray = array [0 .. (MaxInt shr 8)] of TxTriangle;
  276. //-----------------------
  277. // Polyhedron types
  278. //-----------------------
  279. type
  280. TxPolyhedron = array of TxPolygon3D;
  281. (*
  282. TxPolyhedron = record
  283. Facets: array of TxPolygon3D;
  284. function NetLength;
  285. function Area;
  286. function Volume;
  287. end;
  288. *)
  289. //--------------------------
  290. // Mesh simple record types
  291. //--------------------------
  292. type
  293. TxMesh2DVertex = record
  294. X, Y: Single;
  295. NX, NY: Single;
  296. tU, tV: Single;
  297. end;
  298. TxMesh3DVertex = packed record
  299. X, Y, Z: Single;
  300. NX, NY, NZ: Single;
  301. tU, tV: Single;
  302. end;
  303. TxMesh2D = array of TxMesh2DVertex;
  304. TxMesh3D = array of TxMesh3DVertex;
  305. //--------------------------
  306. // Quaternion record types
  307. //--------------------------
  308. type
  309. TxQuaternion3D = record
  310. ImPart: TxVector3D;
  311. RePart: Single;
  312. end;
  313. TxQuaternionArray = array of TxQuaternion3D;
  314. type
  315. TxBox = record
  316. ALeft, ATop, ANear, ARight, ABottom, AFar: Single;
  317. end;
  318. const
  319. sWRONG_ELEMENT = 'Wrong element';
  320. sWRONG_SIZE = 'Wrong size';
  321. sNOT_QUAD = 'Matrix not quadratic';
  322. sSINGULAR = 'Singular matrix founded';
  323. //---------------------------------------------------------------
  324. implementation
  325. //---------------------------------------------------------------
  326. function TxVec(V: TAbstractVector): TxVector;
  327. begin
  328. Result.Create(V);
  329. end;
  330. function TxMat(M: TAbstractMatrix): TxMatrix;
  331. begin
  332. Result.Create(M);
  333. end;
  334. function TxQuat(Q: TAbstractVector): TxQuaternion;
  335. begin
  336. Result.Create(Q);
  337. end;
  338. {$POINTERMATH ON}
  339. function NotUnique(PArr: PCardinal): Boolean;
  340. begin
  341. Result := (PArr - 2)^ > 1;
  342. end;
  343. { TxMatrix }
  344. // Removing i-th row and j-th col
  345. function TxMatrix.Del(A: TxMatrix; I, J: Integer; M: Integer): TxMatrix;
  346. var
  347. K, G: Integer;
  348. begin
  349. for G := I to M - 1 do
  350. for K := 1 to M do
  351. A[G, K] := A[G + 1, K];
  352. for G := J to M - 1 do
  353. for K := 1 to M - 1 do
  354. A[K, G] := A[K, G + 1];
  355. Result := A;
  356. end;
  357. // Recursive calculation of det for matrix
  358. function TxMatrix.Det(A: TxMatrix; M: Integer): Extended;
  359. var
  360. I: Integer;
  361. Buf: Extended;
  362. begin
  363. Buf := 0;
  364. if M = 1 then
  365. Buf := A[1, 1]
  366. else
  367. for I := 1 to M do
  368. Buf := Buf + Power10(-1, I + 1) * A[I, 1] *
  369. Det(Del(A, I, 1, M), M - 1);
  370. Result := Buf;
  371. end;
  372. class operator TxMatrix.Add(M1, M2: TxMatrix): TxMatrix;
  373. var
  374. I, J: Integer;
  375. begin
  376. if (M1.FRowsCount <> M2.FRowsCount) or (M1.FColsCount <> M2.FColsCount) then
  377. raise EMathError.Create(sWRONG_SIZE);
  378. Result.Create(M1.FRowsCount, M1.FColsCount);
  379. for I := 0 to M1.FRowsCount - 1 do
  380. for J := 0 to M1.FColsCount - 1 do
  381. Result.FData[I, J] := M1.FData[I, J] + M2.FData[I, J];
  382. end;
  383. procedure TxMatrix.CheckUnique;
  384. var
  385. I: Integer;
  386. begin
  387. if NotUnique(@FData) then
  388. begin
  389. FData := Copy(FData);
  390. for I := 0 to Pred(FRowsCount) do
  391. FData[i] := Copy(FData[i]);
  392. end;
  393. end;
  394. constructor TxMatrix.Create(RowsCount, ColsCount: Word);
  395. begin
  396. FRowsCount := RowsCount;
  397. FColsCount := ColsCount;
  398. FData := nil;
  399. SetLength(FData, FRowsCount, FColsCount);
  400. end;
  401. constructor TxMatrix.Create(M: TAbstractMatrix);
  402. var
  403. I: Integer;
  404. begin
  405. FRowsCount := Length(M);
  406. FColsCount := Length(M[0]);
  407. FData := nil;
  408. SetLength(FData, FRowsCount, FColsCount);
  409. for I := 0 to Pred(FRowsCount) do
  410. begin
  411. if Length(M[I]) <> FColsCount then
  412. raise EMathError.Create('Wrong matrix proportions');
  413. FData[I] := Copy(M[I]);
  414. end;
  415. end;
  416. constructor TxMatrix.CreateDiag(Dim: Word; Value: Extended = 1.0);
  417. var
  418. I: Integer;
  419. begin
  420. Create(Dim, Dim);
  421. for I := 0 to Dim - 1 do
  422. FData[I, I] := Value;
  423. end;
  424. function TxMatrix.Determinant: Extended;
  425. begin
  426. if (FRowsCount <> FColsCount) then
  427. raise EMathError.Create(sNOT_QUAD);
  428. Result := Det(Self, FRowsCount);
  429. end;
  430. procedure TxMatrix.Fill(Scalar: Extended);
  431. var
  432. I, J: Integer;
  433. begin
  434. if Scalar = 0 then
  435. begin
  436. FData := nil;
  437. SetLength(FData, FRowsCount, FColsCount);
  438. end
  439. else
  440. for I := 0 to FRowsCount - 1 do
  441. for J := 0 to FColsCount - 1 do
  442. FData[I, J] := Scalar;
  443. end;
  444. function TxMatrix.GetCol(Col: Word): TxVector;
  445. var
  446. I: Integer;
  447. begin
  448. if (Col = 0) or (Col > FColsCount) then
  449. raise EMathError.Create(sWRONG_ELEMENT);
  450. Result.Create(FRowsCount);
  451. for I := 0 to FRowsCount - 1 do
  452. Result.FData[I] := FData[I, Col - 1];
  453. end;
  454. function TxMatrix.GetElement(Row, Col: Word): Extended;
  455. begin
  456. {$R+}
  457. Result := FData[Pred(Row), Pred(Col)];
  458. end;
  459. function TxMatrix.GetRow(Row: Word): TxVector;
  460. var
  461. I: Integer;
  462. begin
  463. if (Row = 0) or (Row > FRowsCount) then
  464. raise EMathError.Create(sWRONG_ELEMENT);
  465. Result.Create(FColsCount);
  466. for I := 0 to FColsCount - 1 do
  467. Result.FData[I] := FData[Row - 1, I];
  468. end;
  469. class operator TxMatrix.Implicit(M: TAbstractMatrix): TxMatrix;
  470. begin
  471. Result.Create(M);
  472. end;
  473. function TxMatrix.Inv: TxMatrix;
  474. var
  475. Ipiv, Indxr, Indxc: array of Integer;
  476. DimMat, I, J, K, L, N, ICol, IRow: Integer;
  477. Big, Dum, Pivinv: Extended;
  478. begin
  479. // Jordan algorithm
  480. if (FRowsCount <> FColsCount) then
  481. raise EMathError.Create(sNOT_QUAD);
  482. Result := Self;
  483. DimMat := FRowsCount;
  484. SetLength(Ipiv, DimMat);
  485. SetLength(Indxr, DimMat);
  486. SetLength(Indxc, DimMat);
  487. IRow := 1;
  488. ICol := 1;
  489. for I := 1 to DimMat do
  490. begin
  491. Big := 0;
  492. for J := 1 to DimMat do
  493. if (Ipiv[J - 1] <> 1) then
  494. for K := 1 to DimMat do
  495. if (Ipiv[K - 1] = 0) then
  496. if (Abs(Result[J, K]) >= Big) then
  497. begin
  498. Big := Abs(Result[J, K]);
  499. IRow := J;
  500. ICol := K;
  501. end;
  502. Ipiv[ICol - 1] := Ipiv[ICol - 1] + 1;
  503. if (IRow <> ICol) then
  504. for L := 1 to DimMat do
  505. begin
  506. Dum := Result[IRow, L];
  507. Result[IRow, L] := Result[ICol, L];
  508. Result[ICol, L] := Dum;
  509. end;
  510. Indxr[I - 1] := IRow;
  511. Indxc[I - 1] := ICol;
  512. if Result[ICol, ICol] = 0 then
  513. raise EMathError.Create(sSINGULAR);
  514. Pivinv := 1.0 / Result[ICol, ICol];
  515. Result[ICol, ICol] := 1.0;
  516. for L := 1 to DimMat do
  517. Result[ICol, L] := Result[ICol, L] * Pivinv;
  518. for N := 1 to DimMat do
  519. if (N <> ICol) then
  520. begin
  521. Dum := Result[N, ICol];
  522. Result[N, ICol] := 0.0;
  523. for L := 1 to DimMat do
  524. Result[N, L] := Result[N, L] - Result[ICol, L] * Dum;
  525. end;
  526. end;
  527. for L := DimMat downto 1 do
  528. if (Indxr[L - 1] <> Indxc[L - 1]) then
  529. for K := 1 to DimMat do
  530. begin
  531. Dum := Result[K, Indxr[L - 1]];
  532. Result[K, Indxr[L - 1]] := Result[K, Indxc[L - 1]];
  533. Result[K, Indxc[L - 1]] := Dum;
  534. end;
  535. end;
  536. function TxMatrix.ToQuat: TxQuaternion;
  537. begin
  538. Result[0] := 0.5 * Sqrt(Abs(1 + Self[1,1] + Self[2,2] + Self[3,3]));
  539. Result[1] := 0.5 * Sqrt(Abs(1 + Self[1,1] - Self[2,2] - Self[3,3]));
  540. if Self[3,2] < Self[2,3] then
  541. Result[1] := -Result[1];
  542. Result[2] := 0.5 * Sqrt(Abs(1 - Self[1,1] + Self[2,2] - Self[3,3]));
  543. if Self[1,3] < Self[3,1] then
  544. Result[2] := -Result[2];
  545. Result[3] := 0.5 * Sqrt(Abs(1 - Self[1,1] - Self[2,2] + Self[3,3]));
  546. if Self[2,1] < Self[1,2] then
  547. Result[3] := -Result[3];
  548. end;
  549. class operator TxMatrix.Multiply(M: TxMatrix; Q: TxQuaternion): TxQuaternion;
  550. var
  551. I, J: Integer;
  552. begin
  553. if (M.FRowsCount <> 4) or (M.FRowsCount <> M.FColsCount) then
  554. raise EMathError.Create(sWRONG_SIZE);
  555. FillChar(Result.FData, SizeOf(Result.FData), 0);
  556. for I := 0 to 3 do
  557. for J := 0 to 3 do
  558. Result.FData[I] := Result.FData[I] + M.FData[I, J] * Q.FData[J];
  559. end;
  560. class operator TxMatrix.Multiply(Scalar: Extended; M: TxMatrix): TxMatrix;
  561. begin
  562. Result := M * Scalar;
  563. end;
  564. class operator TxMatrix.Multiply(V: TxVector; M: TxMatrix): TxVector;
  565. var
  566. I, J: Integer;
  567. begin
  568. if (V.FCount <> M.FRowsCount) then
  569. raise EMathError.Create(sWRONG_SIZE);
  570. Result.Create(V.FCount);
  571. for I := 0 to V.FCount - 1 do
  572. for J := 0 to V.FCount - 1 do
  573. Result.FData[I] := Result.FData[I] + V.FData[J] * M.FData[J, I];
  574. end;
  575. class operator TxMatrix.Multiply(M: TxMatrix; V: TxVector): TxVector;
  576. var
  577. I, J: Integer;
  578. begin
  579. if (M.FColsCount <> V.FCount) then
  580. raise EMathError.Create(sWRONG_SIZE);
  581. Result.Create(M.FRowsCount);
  582. for I := 0 to M.FRowsCount - 1 do
  583. for J := 0 to M.FColsCount - 1 do
  584. Result.FData[I] := Result.FData[I] + M.FData[I, J] * V.FData[J];
  585. end;
  586. class operator TxMatrix.Multiply(M: TxMatrix; Scalar: Extended): TxMatrix;
  587. var
  588. I, J: Integer;
  589. begin
  590. Result.Create(M.FRowsCount, M.FColsCount);
  591. for I := 0 to M.FRowsCount - 1 do
  592. for J := 0 to M.FColsCount - 1 do
  593. Result.FData[I, J] := M.FData[I, J] * Scalar;
  594. end;
  595. class operator TxMatrix.Multiply(M1, M2: TxMatrix): TxMatrix;
  596. var
  597. I, J, K: Integer;
  598. begin
  599. if (M1.FColsCount <> M2.FRowsCount) then
  600. raise EMathError.Create(sWRONG_SIZE);
  601. Result.Create(M1.FRowsCount, M2.FColsCount);
  602. for I := 0 to M1.FRowsCount - 1 do
  603. for J := 0 to M2.FColsCount - 1 do
  604. for K := 0 to M1.FColsCount - 1 do
  605. Result.FData[I, J] := Result.FData[I, J] + M1.FData[I, K] * M2.FData[K, J];
  606. end;
  607. procedure TxMatrix.SetCol(Col: Word; Value: TxVector);
  608. var
  609. I: Integer;
  610. begin
  611. if (Col = 0) or (Col > FColsCount) then
  612. raise EMathError.Create(sWRONG_ELEMENT);
  613. if (Value.Count <> FRowsCount) then
  614. raise EMathError.Create(sWRONG_SIZE);
  615. for I := 0 to FRowsCount - 1 do
  616. FData[I, Col - 1] := Value.FData[I];
  617. end;
  618. procedure TxMatrix.SetElement(Row, Col: Word; Value: Extended);
  619. begin
  620. {$R+}
  621. CheckUnique;
  622. FData[Pred(Row), Pred(Col)] := Value;
  623. end;
  624. procedure TxMatrix.SetRow(Row: Word; Value: TxVector);
  625. var
  626. I: Integer;
  627. begin
  628. if (Row = 0) or (Row > FRowsCount) then
  629. raise EMathError.Create(sWRONG_ELEMENT);
  630. if (Value.Count <> FColsCount) then
  631. raise EMathError.Create(sWRONG_SIZE);
  632. for I := 0 to FColsCount - 1 do
  633. FData[Row - 1, I] := Value.FData[I];
  634. end;
  635. class operator TxMatrix.Subtract(M1, M2: TxMatrix): TxMatrix;
  636. var
  637. I, J: Integer;
  638. begin
  639. if (M1.FColsCount <> M2.FColsCount) or (M1.FRowsCount <> M2.FRowsCount) then
  640. raise EMathError.Create(sWRONG_SIZE);
  641. Result.Create(M1.FRowsCount, M1.FColsCount);
  642. for I := 0 to M1.FRowsCount - 1 do
  643. for J := 0 to M1.FColsCount - 1 do
  644. Result.FData[I, J] := M1.FData[I, J] - M2.FData[I, J];
  645. end;
  646. function TxMatrix.Trace: Extended;
  647. var
  648. I: Integer;
  649. begin
  650. Result := 0;
  651. if FColsCount <> FRowsCount then
  652. raise EMathError.Create(sNOT_QUAD);
  653. for I := 0 to FColsCount - 1 do
  654. Result := Result + FData[I, I];
  655. end;
  656. function TxMatrix.Transp: TxMatrix;
  657. var
  658. I, J: Integer;
  659. begin
  660. Result.Create(FColsCount, FRowsCount);
  661. for I := 0 to FColsCount - 1 do
  662. for J := 0 to FRowsCount - 1 do
  663. Result.FData[I, J] := FData[J, I];
  664. end;
  665. function TxMatrix.TruncateSTI: TxMatrix;
  666. const
  667. Int32Max: Double = Integer.MaxValue;
  668. Int32Min: Double = Integer.MinValue;
  669. var
  670. I, J: Integer;
  671. begin
  672. Result.Create(FRowsCount, FColsCount);
  673. for I := 0 to FRowsCount - 1 do
  674. for J := 0 to FColsCount - 1 do
  675. begin
  676. if (FData[I, J] >= Int32Min) and (FData[I, J] <= Int32Max) then
  677. Result.FData[I, J] := Trunc(FData[I, J])
  678. else
  679. if (FData[I, J] < Int32Min) then
  680. Result.FData[I, J] := Int32Min
  681. else
  682. Result.FData[I, J] := Int32Max;
  683. end;
  684. end;
  685. //-----------------------------
  686. // TxVector
  687. //-----------------------------
  688. constructor TxVector.Create(V: TAbstractVector);
  689. begin
  690. FCount := Length(V);
  691. FData := Copy(V);
  692. end;
  693. constructor TxVector.Create(ElementsCount: Word);
  694. begin
  695. FCount := ElementsCount;
  696. FData := nil;
  697. SetLength(FData, FCount);
  698. end;
  699. class operator TxVector.Add(V1, V2: TxVector): TxVector;
  700. var
  701. i: Integer;
  702. begin
  703. if (V1.FCount <> V2.FCount) then
  704. raise EMathError.Create(sWRONG_SIZE);
  705. Result := TxVector.Create(V1.FCount);
  706. for i := 0 to V1.FCount - 1 do
  707. Result.FData[i] := V1.FData[i] + V2.FData[i];
  708. end;
  709. class operator TxVector.Add(V: TxVector; Scalar: Extended): TxVector;
  710. var
  711. I: Integer;
  712. begin
  713. Result.Create(V.FCount);
  714. for I := 0 to V.FCount - 1 do
  715. Result.FData[I] := V.FData[I] + Scalar;
  716. end;
  717. class operator TxVector.Add(Scalar: Extended; V: TxVector): TxVector;
  718. begin
  719. Result := V + Scalar;
  720. end;
  721. procedure TxVector.CheckUnique;
  722. begin
  723. if NotUnique(@FData) then
  724. FData := Copy(FData);
  725. end;
  726. class operator TxVector.Divide(V1, V2: TxVector): TxVector;
  727. var
  728. I: Integer;
  729. begin
  730. if (V1.FCount <> V2.FCount) then
  731. raise EMathError.Create(sWRONG_SIZE);
  732. Result.Create(V1.FCount);
  733. for I := 0 to V1.FCount - 1 do
  734. Result.FData[I] := V1.FData[I] / V2.FData[I];
  735. end;
  736. class operator TxVector.Divide(V: TxVector; Scalar: Extended): TxVector;
  737. begin
  738. Result := V * (1 / Scalar);
  739. end;
  740. class operator TxVector.Implicit(V: TAbstractVector): TxVector;
  741. begin
  742. Result.Create(V);
  743. end;
  744. procedure TxVector.Fill(Value: Extended);
  745. var
  746. I: Integer;
  747. begin
  748. if Value = 0 then
  749. begin
  750. FData := nil;
  751. SetLength(FData, FCount);
  752. end
  753. else
  754. for I := 0 to FCount - 1 do
  755. FData[I] := Value;
  756. end;
  757. function TxVector.GetElement(Index: Word): Extended;
  758. begin
  759. if (Index = 0) or (Index > FCount) then
  760. raise EMathError.Create(sWRONG_ELEMENT);
  761. Result := FData[Pred(Index)];
  762. end;
  763. class operator TxVector.Multiply(V: TxVector; Scalar: Extended): TxVector;
  764. var
  765. I: Integer;
  766. begin
  767. Result.Create(V.FCount);
  768. for I := 0 to V.FCount - 1 do
  769. Result.FData[I] := V.FData[I] * Scalar;
  770. end;
  771. class operator TxVector.Multiply(Scalar: Extended; V: TxVector): TxVector;
  772. begin
  773. Result := V * Scalar;
  774. end;
  775. function TxVector.Norm: Extended;
  776. begin
  777. Result := System.Math.Norm(FData);
  778. end;
  779. class operator TxVector.Multiply(V1, V2: TxVector): TxVector;
  780. begin
  781. if (V1.FCount <> 3) or (V2.FCount <> 3) then
  782. raise EMathError.Create(sWRONG_SIZE);
  783. Result.Create(V1.FCount);
  784. Result.FData[0] := V1.FData[1] * V2.FData[2] - V1.FData[2] * V2.FData[1];
  785. Result.FData[1] := V1.FData[2] * V2.FData[0] - V1.FData[0] * V2.FData[2];
  786. Result.FData[2] := V1.FData[0] * V2.FData[1] - V1.FData[1] * V2.FData[0];
  787. end;
  788. function TxVector.ScalarMult(V: TxVector): Extended;
  789. var
  790. I: Integer;
  791. begin
  792. if V.FCount <> FCount then
  793. raise EMathError.Create(sWRONG_SIZE);
  794. Result := 0.0;
  795. for I := 0 to FCount - 1 do
  796. Result := Result + FData[I] * V.FData[I];
  797. end;
  798. procedure TxVector.SetElement(Index: Word; Value: Extended);
  799. begin
  800. if (Index = 0) or (Index > FCount) then
  801. raise EMathError.Create(sWRONG_ELEMENT);
  802. CheckUnique;
  803. FData[Pred(Index)] := Value;
  804. end;
  805. class operator TxVector.Subtract(V1, V2: TxVector): TxVector;
  806. var
  807. I: Integer;
  808. begin
  809. if (V1.FCount <> V2.FCount) then
  810. raise EMathError.Create(sWRONG_SIZE);
  811. Result.Create(V1.FCount);
  812. for I := 0 to V1.FCount - 1 do
  813. Result.FData[I] := V1.FData[I] - V2.FData[I];
  814. end;
  815. class operator TxVector.Subtract(Scalar: Extended; V: TxVector): TxVector;
  816. var
  817. I: Integer;
  818. begin
  819. Result.Create(V.FCount);
  820. for I := 0 to V.FCount - 1 do
  821. Result.FData[I] := Scalar - V.FData[I];
  822. end;
  823. class operator TxVector.Subtract(V: TxVector; Scalar: Extended): TxVector;
  824. var
  825. I: Integer;
  826. begin
  827. Result.Create(V.FCount);
  828. for I := 0 to V.Count - 1 do
  829. Result.FData[I] := V.FData[I] - Scalar;
  830. end;
  831. function TxVector.SumOfElments: Extended;
  832. begin
  833. Result := Sum(FData);
  834. end;
  835. function TxVector.SumOfSquares: Extended;
  836. begin
  837. Result := System.Math.SumOfSquares(FData);
  838. end;
  839. function TxVector.ToQuat: TxQuaternion;
  840. var
  841. ModVec: Extended;
  842. C1, C2: Extended;
  843. begin
  844. if (FCount <> 3) then
  845. raise EMathError.Create(sWRONG_SIZE);
  846. ModVec := Norm;
  847. C1 := Cos(ModVec / 2);
  848. if ModVec > 1e-15 then
  849. C2 := Sin(ModVec / 2) / ModVec
  850. else
  851. C2 := 1;
  852. Result := [C1, FData[0] * C2, FData[1] * C2, FData[2] * C2];
  853. end;
  854. function TxVector.TruncateSTI: TxVector;
  855. const
  856. Int32Max: Double = Integer.MaxValue;
  857. Int32Min: Double = Integer.MinValue;
  858. var
  859. I: Integer;
  860. begin
  861. Result.Create(FCount);
  862. for I := 0 to FCount - 1 do
  863. begin
  864. if (FData[I] >= Int32Min) and (FData[I] <= Int32Max) then
  865. Result.FData[I] := Trunc(FData[I])
  866. else
  867. if (FData[I] < Int32Min) then
  868. Result.FData[I] := Int32Min
  869. else
  870. Result.FData[I] := Int32Max;
  871. end;
  872. end;
  873. //-----------------------------
  874. // TxQuatHelper
  875. //-----------------------------
  876. function TxQuatHelper.ToMatrix: TxMatrix;
  877. begin
  878. Result.Create(3, 3);
  879. Result[1, 1] := Sqr(FData[0]) + Sqr(FData[1]) - Sqr(FData[2]) - Sqr(FData[3]);
  880. Result[1, 2] := 2 * (FData[1] * FData[2] - FData[0] * FData[3]);
  881. Result[1, 3] := 2 * (FData[1] * FData[3] + FData[0] * FData[2]);
  882. Result[2, 1] := 2 * (FData[1] * FData[2] + FData[0] * FData[3]);
  883. Result[2, 2] := Sqr(FData[0]) - Sqr(FData[1]) + Sqr(FData[2]) - Sqr(FData[3]);
  884. Result[2, 3] := 2 * (FData[2] * FData[3] - FData[0] * FData[1]);
  885. Result[3, 1] := 2 * (FData[1] * FData[3] - FData[0] * FData[2]);
  886. Result[3, 2] := 2 * (FData[2] * FData[3] + FData[0] * FData[1]);
  887. Result[3, 3] := Sqr(FData[0]) - Sqr(FData[1]) - Sqr(FData[2]) + Sqr(FData[3]);
  888. end;
  889. //-----------------------------
  890. // TxVecHelper
  891. //-----------------------------
  892. function TxVecHelper.ToDiagMatrix: TxMatrix;
  893. var
  894. I: Integer;
  895. begin
  896. Result.Create(FCount, FCount);
  897. for I := 0 to FCount - 1 do
  898. Result.FData[I, I] := FData[I];
  899. end;
  900. procedure Init(Obj, TypeInfoOfObj: Pointer; Offset: Integer = 0);
  901. const
  902. DefaultRowCount = 3;
  903. DefaultColCount = 3;
  904. VectorTypeName = 'TVector';
  905. MatrixTypeName = 'TMatrix';
  906. var
  907. RTTIContext: TRttiContext;
  908. Field : TRttiField;
  909. ArrFld: TRttiArrayType;
  910. I: Integer;
  911. Dim: TCustomAttribute;
  912. RowCount, ColCount: Integer;
  913. OffsetFromArray: Integer;
  914. begin
  915. for Field in RTTIContext.GetType(TypeInfoOfObj).GetFields do
  916. begin
  917. if Field.FieldType <> nil then
  918. begin
  919. RowCount := DefaultRowCount;
  920. ColCount := DefaultColCount;
  921. for Dim in Field.GetAttributes do
  922. begin
  923. RowCount := (Dim as TxDim).RowCount;
  924. ColCount := (Dim as TxDim).ColCount;
  925. end;
  926. if Field.FieldType.TypeKind = tkArray then
  927. begin
  928. ArrFld := TRttiArrayType(Field.FieldType);
  929. if ArrFld.ElementType.TypeKind = tkRecord then
  930. begin
  931. for I := 0 to ArrFld.TotalElementCount - 1 do
  932. begin
  933. OffsetFromArray := I * ArrFld.ElementType.TypeSize;
  934. if ArrFld.ElementType.Name = VectorTypeName then
  935. PxVector(Integer(Obj) +
  936. Field.Offset +
  937. OffsetFromArray +
  938. Offset)^ := TxVector.Create(RowCount)
  939. else if ArrFld.ElementType.Name = MatrixTypeName then
  940. PxMatrix(Integer(Obj) +
  941. Field.Offset +
  942. OffsetFromArray +
  943. Offset)^ := TxMatrix.Create(RowCount, ColCount)
  944. else
  945. Init(Obj, ArrFld.ElementType.Handle, Field.Offset + OffsetFromArray);
  946. end;
  947. end;
  948. end
  949. else if Field.FieldType.TypeKind = tkRecord then
  950. begin
  951. if Field.FieldType.Name = VectorTypeName then
  952. PxVector(Integer(Obj) +
  953. Field.Offset +
  954. Offset)^ := TxVector.Create(RowCount)
  955. else if Field.FieldType.Name = MatrixTypeName then
  956. PxMatrix(Integer(Obj) +
  957. Field.Offset +
  958. Offset)^ := TxMatrix.Create(RowCount, ColCount)
  959. else
  960. Init(Obj, Field.FieldType.Handle, Field.Offset)
  961. end;
  962. end;
  963. end;
  964. end;
  965. //-----------------------------
  966. // TxDim
  967. //-----------------------------
  968. constructor TxDim.Create(ARowCount: Integer; AColCount: Integer = 0);
  969. begin
  970. FRowCount := ARowCount;
  971. FColCount := AColCount;
  972. end;
  973. //-----------------------------
  974. // TxPoint2D
  975. //-----------------------------
  976. function TxPoint2D.Create(X, Y : Single): TxPoint2D;
  977. begin
  978. Result.X := X;
  979. Result.Y := Y;
  980. end;
  981. procedure TxPoint2D.SetPosition(const X, Y: Single);
  982. begin
  983. Self.X := X;
  984. Self.Y := Y;
  985. end;
  986. function TxPoint2D.Length: Single;
  987. begin
  988. Result := Sqrt(Self.X * Self.X + Self.Y * Self.Y);
  989. end;
  990. function TxPoint2D.Add(const APoint2D: TxPoint2D): TxPoint2D;
  991. begin
  992. Result.SetPosition(Self.X + APoint2D.X, Self.Y + APoint2D.Y);
  993. end;
  994. function TxPoint2D.Distance(const APoint2D: TxPoint2D): Single;
  995. begin
  996. Result := Sqrt(Sqr(Self.X - APoint2D.X) + Sqr(Self.Y - APoint2D.Y));
  997. end;
  998. procedure TxPoint2D.Offset(const ADeltaX, ADeltaY: Single);
  999. begin
  1000. Self.X := Self.X + ADeltaX;
  1001. Self.Y := Self.Y + ADeltaY;
  1002. end;
  1003. class function TxPoint2D.PointInCircle(const Point, Center: TxPoint2D;
  1004. const Radius: Integer): Boolean;
  1005. begin
  1006. Result := Point.Distance(Center) <= Radius;
  1007. end;
  1008. //-----------------------------
  1009. // TxPoint3D
  1010. //-----------------------------
  1011. function TxPoint3D.Create(X, Y, Z: Single): TxPoint3D;
  1012. begin
  1013. Result.X := X;
  1014. Result.Y := Y;
  1015. Result.Z := Z;
  1016. end;
  1017. function TxPoint3D.Add(const AGLPoint3D: TxPoint3D): TxPoint3D;
  1018. begin
  1019. Result.X := Self.X + AGLPoint3D.X;
  1020. Result.Y := Self.Y + AGLPoint3D.Y;
  1021. Result.Z := Self.Z + AGLPoint3D.Z;
  1022. end;
  1023. function TxPoint3D.Distance(const APoint3D: TxPoint3D): Single;
  1024. begin
  1025. Result := Self.Length - APoint3D.Length;
  1026. end;
  1027. function TxPoint3D.Length: Single;
  1028. begin
  1029. Result := Sqrt(Self.X * Self.X + Self.Y * Self.Y + Self.Z * Self.Z);
  1030. end;
  1031. procedure TxPoint3D.Offset(const ADeltaX, ADeltaY, ADeltaZ: Single);
  1032. begin
  1033. Self.X := Self.X + ADeltaX;
  1034. Self.Y := Self.Y + ADeltaY;
  1035. Self.Z := Self.Z + ADeltaZ;
  1036. end;
  1037. procedure TxPoint3D.SetPosition(const X, Y, Z: Single);
  1038. begin
  1039. Self.X := X;
  1040. Self.Y := Y;
  1041. Self.Z := Z;
  1042. end;
  1043. //-----------------------------
  1044. // TxVector2D
  1045. //-----------------------------
  1046. function TxVector2D.Create(const AX, AY, AW: Single): TxVector2D;
  1047. begin
  1048. Result.X := AX;
  1049. Result.Y := AY;
  1050. Result.W := AW;
  1051. end;
  1052. function TxVector2D.CrossProduct(const AVector: TxVector2D): TxVector2D;
  1053. begin
  1054. Result.X := (Self.Y * AVector.W) - (Self.W * AVector.Y);
  1055. Result.Y := (Self.W * AVector.X) - (Self.X * AVector.W);
  1056. Result.W := (Self.X * AVector.Y) - (Self.Y * AVector.X);
  1057. end;
  1058. function TxVector2D.DotProduct(const AVector: TxVector2D): Single;
  1059. begin
  1060. Result := (Self.X * AVector.X) + (Self.Y * AVector.Y) + (Self.W * AVector.W);
  1061. end;
  1062. function TxVector2D.Add(const AVector2D: TxVector2D): TxVector2D;
  1063. begin
  1064. Result.X := Self.X + AVector2D.X;
  1065. Result.Y := Self.Y + AVector2D.Y;
  1066. Result.W := 1.0;
  1067. end;
  1068. function TxVector2D.Length: Single;
  1069. begin
  1070. Result := Sqrt((Self.X * Self.X) + (Self.Y * Self.Y));
  1071. end;
  1072. function TxVector2D.Norm: Single;
  1073. begin
  1074. Result := Sqr(Self.X) + Sqr(Self.Y);
  1075. end;
  1076. function TxVector2D.Normalize: TxVector2D;
  1077. var
  1078. invLen: Single;
  1079. vn: Single;
  1080. const
  1081. Tolerance: Single = 1E-12;
  1082. begin
  1083. vn := Self.Norm;
  1084. if vn > Tolerance then
  1085. begin
  1086. invLen := 1/Sqrt(vn);
  1087. Result.X := Self.X * invLen;
  1088. Result.Y := Self.Y * invLen;
  1089. end
  1090. else
  1091. Result := Self;
  1092. end;
  1093. //---------------------------------
  1094. // TxVector3D
  1095. //---------------------------------
  1096. function TxVector3D.Create(const AX, AY, AZ, AW: Single): TxVector3D;
  1097. begin
  1098. Result.X := AX;
  1099. Result.Y := AY;
  1100. Result.Z := AZ;
  1101. Result.W := AW;
  1102. end;
  1103. function TxVector3D.Add(const AVector3D: TxVector3D): TxVector3D;
  1104. begin
  1105. Result.X := Self.X + AVector3D.X;
  1106. Result.Y := Self.Y + AVector3D.Y;
  1107. Result.Z := Self.Z + AVector3D.Z;
  1108. Result.W := 1.0;
  1109. end;
  1110. function TxVector3D.Norm: Single;
  1111. begin
  1112. result := Self.X * Self.X + Self.Y * Self.Y + Self.Z * Self.Z;
  1113. end;
  1114. function TxVector3D.Normalize: TxVector3D;
  1115. var
  1116. invLen: Single;
  1117. vn: Single;
  1118. const
  1119. Tolerance: Single = 1E-12;
  1120. begin
  1121. vn := Self.Norm;
  1122. if vn > 0 then
  1123. begin
  1124. invLen := 1/Sqrt(vn);
  1125. Result.X := Self.X * invLen;
  1126. Result.Y := Self.Y * invLen;
  1127. Result.Z := Self.Z * invLen;
  1128. Result.W := 0;
  1129. end
  1130. else
  1131. Result := Self;
  1132. end;
  1133. function TxVector3D.DotProduct(const AVector3D: TVector3D): Single;
  1134. begin
  1135. Result := (Self.X * AVector3D.X) + (Self.Y * AVector3D.Y) + (Self.Z * AVector3D.Z);
  1136. end;
  1137. function TxVector3D.CrossProduct(const AVector3D: TVector3D): TVector3D;
  1138. begin
  1139. Result.X := (Self.Y * AVector3D.Z) - (Self.Z * AVector3D.Y);
  1140. Result.Y := (Self.Z * AVector3D.X) - (Self.X * AVector3D.Z);
  1141. Result.Z := (Self.X * AVector3D.Y) - (Self.Y * AVector3D.X);
  1142. end;
  1143. function TxVector3D.Length: Single;
  1144. begin
  1145. Result := Sqrt((Self.X * Self.X) + (Self.Y * Self.Y) + (Self.Z * Self.Z));
  1146. end;
  1147. //---------------------------------
  1148. // TxQuaternion
  1149. //---------------------------------
  1150. function TxQuaternion.GetElement(Index: Byte): Extended;
  1151. begin
  1152. if (Index > 3) then
  1153. raise EMathError.Create(sWRONG_ELEMENT);
  1154. Result := FData[Index];
  1155. end;
  1156. class operator TxQuaternion.Implicit(V: TAbstractVector): TxQuaternion;
  1157. begin
  1158. if (Length(V) <> 4) then
  1159. raise EMathError.Create(sWRONG_SIZE);
  1160. Move(V[0], Result.FData, SizeOf(Result.FData));
  1161. end;
  1162. function TxQuaternion.Inv: TxQuaternion;
  1163. begin
  1164. Result := [FData[0], -FData[1], -FData[2], -FData[3]];
  1165. end;
  1166. class operator TxQuaternion.Multiply(Scalar: Extended; Q: TxQuaternion): TxQuaternion;
  1167. begin
  1168. Result := Q * Scalar;
  1169. end;
  1170. class operator TxQuaternion.Multiply(Q: TxQuaternion; Sc: Extended): TxQuaternion;
  1171. begin
  1172. Result := [Q.FData[0] * Sc, Q.FData[1] * Sc, Q.FData[2] * Sc, Q.FData[3] * Sc];
  1173. end;
  1174. class operator TxQuaternion.Multiply(Q1, Q2: TxQuaternion): TxQuaternion;
  1175. var
  1176. Mat: TxMatrix;
  1177. begin
  1178. Mat := [[Q1.FData[0], -Q1.FData[1], -Q1.FData[2], -Q1.FData[3]],
  1179. [Q1.FData[1], Q1.FData[0], -Q1.FData[3], Q1.FData[2]],
  1180. [Q1.FData[2], Q1.FData[3], Q1.FData[0], -Q1.FData[1]],
  1181. [Q1.FData[3], -Q1.FData[2], Q1.FData[1], Q1.FData[0]]];
  1182. Result := Mat * Q2;
  1183. end;
  1184. constructor TxQuaternion.Create(Q: TAbstractVector);
  1185. begin
  1186. if Length(Q) <> 4 then
  1187. raise EMathError.Create(sWRONG_SIZE);
  1188. Move(Q[0], FData[0], SizeOf(FData));
  1189. end;
  1190. procedure TxQuaternion.SetElement(Index: Byte; Value: Extended);
  1191. begin
  1192. if (Index > 3) then
  1193. raise EMathError.Create(sWRONG_ELEMENT);
  1194. FData[Index] := Value;
  1195. end;
  1196. function TxQuaternion.TruncateSTI: TxQuaternion;
  1197. const
  1198. Int32Max: Double = Integer.MaxValue;
  1199. Int32Min: Double = Integer.MinValue;
  1200. function xTrunc(Value: Extended): Double;
  1201. begin
  1202. if (Value >= Int32Min) and (Value <= Int32Max) then
  1203. Result := Trunc(Value)
  1204. else
  1205. if (Value < Int32Min) then
  1206. Result := Int32Min
  1207. else
  1208. Result := Int32Max;
  1209. end;
  1210. begin
  1211. Result[0] := xTrunc(FData[0]);
  1212. Result[1] := xTrunc(FData[1]);
  1213. Result[2] := xTrunc(FData[2]);
  1214. Result[3] := xTrunc(FData[3]);
  1215. end;
  1216. end.