| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385 |
- //
- // This unit is part of the GLScene Engine, http://glscene.org
- //
- unit GLVectorRecTypes;
- (* Defines common vector types as advanced records *)
- interface
- {$I GLScene.inc}
- uses
- System.Types,
- System.SysUtils,
- System.Rtti,
- System.Math,
- System.Math.Vectors,
- GLVectorTypes;
- type
- TAbstractVector = array of Extended;
- TAbstractMatrix = array of array of Extended;
- TxQuaternion = record
- private
- FData: array[0..3] of Extended;
- procedure SetElement(Index: Byte; Value: Extended);
- function GetElement(Index: Byte): Extended;
- public
- constructor Create(Q: TAbstractVector);
- class operator Multiply(Q1, Q2: TxQuaternion): TxQuaternion;
- class operator Multiply(Q: TxQuaternion; Sc: Extended): TxQuaternion;
- class operator Multiply(Scalar: Extended; Q: TxQuaternion): TxQuaternion;
- class operator Implicit(V: TAbstractVector): TxQuaternion;
- function Inv: TxQuaternion;
- function TruncateSTI: TxQuaternion;
- property Element[index: Byte]: Extended read GetElement
- write SetElement; default;
- end;
- PxVector = ^TxVector;
- TxVector = record
- private
- FData: TAbstractVector;
- FCount: Word;
- procedure SetElement(Index: Word; Value: Extended);
- function GetElement(Index: Word): Extended;
- procedure CheckUnique;
- public
- constructor Create(ElementsCount: Word); overload;
- constructor Create(V: TAbstractVector); overload;
- class operator Add(V1, V2: TxVector): TxVector;
- class operator Add(V: TxVector; Scalar: Extended): TxVector;
- class operator Add(Scalar: Extended; V: TxVector): TxVector;
- class operator Subtract(V1, V2: TxVector): TxVector;
- class operator Subtract(Scalar: Extended; V: TxVector): TxVector;
- class operator Subtract(V: TxVector; Scalar: Extended): TxVector;
- class operator Multiply(V1, V2: TxVector): TxVector;
- class operator Multiply(V: TxVector; Scalar: Extended): TxVector;
- class operator Multiply(Scalar: Extended; V: TxVector): TxVector;
- class operator Divide(V: TxVector; Scalar: Extended): TxVector;
- class operator Divide(V1, V2: TxVector): TxVector;
- class operator Implicit(V: TAbstractVector): TxVector;
- function Norm: Extended;
- function SumOfSquares: Extended;
- function SumOfElments: Extended;
- function TruncateSTI: TxVector;
- function ToQuat: TxQuaternion;
- procedure Fill(Value: Extended);
- function ScalarMult(V: TxVector): Extended;
- property Count: Word read FCount;
- property Elements[index: Word]: Extended read GetElement
- write SetElement; default;
- end;
- PxMatrix = ^TxMatrix;
- TxMatrix = record
- private
- FData: TAbstractMatrix;
- FRowsCount: Word;
- FColsCount: Word;
- procedure SetElement(Row, Col: Word; Value: Extended);
- function GetElement(Row, Col: Word): Extended;
- function GetRow(Row: Word): TxVector;
- procedure SetRow(Row: Word; Value: TxVector);
- function GetCol(Col: Word): TxVector;
- procedure SetCol(Col: Word; Value: TxVector);
- function Del(A: TxMatrix; I, J: Integer; M: Integer): TxMatrix;
- function Det(A: TxMatrix; M: Integer): Extended;
- procedure CheckUnique;
- public
- constructor Create(RowsCount, ColsCount: Word); overload;
- constructor CreateDiag(Dim: Word; Value: Extended = 1.0);
- constructor Create(M: TAbstractMatrix); overload;
- class operator Add(M1, M2: TxMatrix): TxMatrix;
- class operator Subtract(M1, M2: TxMatrix): TxMatrix;
- class operator Multiply(M1, M2: TxMatrix): TxMatrix;
- class operator Multiply(M: TxMatrix; V: TxVector): TxVector;
- class operator Multiply(V: TxVector; M: TxMatrix): TxVector;
- class operator Multiply(M: TxMatrix; Scalar: Extended): TxMatrix;
- class operator Multiply(Scalar: Extended; M: TxMatrix): TxMatrix;
- class operator Multiply(M: TxMatrix; Q: TxQuaternion): TxQuaternion;
- class operator Implicit(M: TAbstractMatrix): TxMatrix;
- function Transp: TxMatrix;
- function Inv: TxMatrix;
- function ToQuat: TxQuaternion;
- function Determinant: Extended;
- function TruncateSTI: TxMatrix;
- function Trace: Extended; // sum on diagonal elements
- procedure Fill(Scalar: Extended);
- property RowCount: Word read FRowsCount;
- property ColCount: Word read FColsCount;
- property Row[Row: Word]: TxVector read GetRow write SetRow;
- property Col[Col: Word]: TxVector read GetCol write SetCol;
- property Elements[Row, Col: Word]: Extended read GetElement
- write SetElement; default;
- end;
- TxQuatHelper = record helper for TxQuaternion
- function ToMatrix: TxMatrix;
- end;
- TxVecHelper = record helper for TxVector
- function ToDiagMatrix: TxMatrix;
- end;
- TxDim = class(TCustomAttribute)
- private
- FRowCount: Integer;
- FColCount: Integer;
- public
- constructor Create(ARowCount: Integer; AColCount: Integer = 0); overload;
- property RowCount: Integer read FRowCount;
- property ColCount: Integer read FColCount;
- end;
- function TxVec(V: TAbstractVector): TxVector;
- function TxMat(M: TAbstractMatrix): TxMatrix;
- function TxQuat(Q: TAbstractVector): TxQuaternion;
- procedure Init(Obj, TypeInfoOfObj: Pointer; Offset: Integer = 0);
- //-----------------------
- // Point types
- //-----------------------
- type
- TxScalarValue = Single;
- TxScalarField = function(X, Y, Z: Single): TxScalarValue;
- // If data are made on integer XYZ index
- TxScalarFieldInt = function(iX, iY, iZ: Integer): TxScalarValue of object;
- TxVertex = record
- P, N: TVector3f; //Point and Normal
- Density: Single;
- end;
- TxFace = record
- Normal: TVector3f;
- V1: TVector3f; // vertex 1
- V2: TVector3f; // vertex 2
- V3: TVector3f; // vertex 3
- Padding: array [0 .. 1] of Byte;
- end;
-
- PxPoint2D = ^TxPoint2D;
- TxPoint2D = record
- X: Single;
- Y: Single;
- public
- function Create(X, Y : Single): TxPoint2D;
- procedure SetPosition(const X, Y : Single);
- function Add(const APoint2D: TxPoint2D): TxPoint2D;
- function Length: Single; //distance to origin
- function Distance(const APoint2D : TxPoint2D) : Single;
- class function PointInCircle(const Point, Center: TxPoint2D;
- const Radius: Integer):Boolean; static; inline;
- procedure Offset(const ADeltaX, ADeltaY : Single);
- end;
- PxPoint3D = ^TxPoint3D;
- TxPoint3D = record
- X: Single;
- Y: Single;
- Z: Single;
- public
- function Create(X, Y, Z: Single): TxPoint3D;
- procedure SetPosition(const X, Y, Z : Single);
- function Add(const AGLPoint3D: TxPoint3D): TxPoint3D;
- function Length: Single; //distance to origin
- function Distance(const APoint3D : TxPoint3D) : Single;
- procedure Offset(const ADeltaX, ADeltaY, ADeltaZ : Single);
- end;
- TxPoint2DArray = array of TxPoint2D;
- TxPoint3DArray = array of TxPoint3D;
- // Voxel types
- TxVoxelStatus = (bpExternal, bpInternal);
- TxVoxel = record
- P: TVector3f;
- Density: TxScalarValue;
- Status: TxVoxelStatus;
- end;
- PxVoxel = ^TxVoxel;
- TxVoxelData = array [0 .. (MaxInt shr 8)] of TxVoxel;
- PxVoxelData = ^TxVoxelData;
- //-----------------------
- // Vector types
- //-----------------------
- TxVector2DType = array [0..1] of Single;
- TxVector3DType = array [0..2] of Single;
- TxVector2D = record
- function Create(const AX, AY, AW : Single): TxVector2D;
- function Add(const AVector2D: TxVector2D): TxVector2D;
- function Length: Single;
- function Norm: Single;
- function Normalize: TxVector2D;
- function CrossProduct(const AVector: TxVector2D): TxVector2D;
- function DotProduct(const AVector: TxVector2D): Single;
- case Integer of
- 0: (V: TxVector2DType;);
- 1: (X: Single;
- Y: Single;
- W: Single;)
- end;
- TxVector3D = record
- function Create(const AX, AY, AZ, AW : Single): TxVector3D;
- function Add(const AVector3D: TxVector3D): TxVector3D;
- function Length: Single;
- function Norm: Single;
- function Normalize: TxVector3D;
- function CrossProduct(const AVector3D: TVector3D): TVector3D;
- function DotProduct(const AVector3D: TVector3D): Single; inline;
- case Integer of
- 0: (V: TxVector3DType;);
- 1: (X: Single;
- Y: Single;
- Z: Single;
- W: Single;)
- end;
- // Vector Arrays
- TxVector2DArray = array of TxVector2D;
- TxVector3DArray = array of TxVector3D;
- //-----------------------
- // Matrix types
- //-----------------------
- TxMatrix2DType = array[0..3] of TxVector2D;
- TxMatrix3DType = array[0..3] of TxVector3D;
- TxMatrix2D = record
- private
- public
- case Integer of
- 0: (M: TxMatrix2DType;);
- 1: (e11, e12, e13: Single;
- e21, e22, e23: Single;
- e31, e32, e33: Single);
- end;
- TxMatrix3D = record
- private
- public
- case Integer of
- 0: (M: TxMatrix3DType;);
- 1: (e11, e12, e13, e14: Single;
- e21, e22, e23, e24: Single;
- e31, e32, e33, e34: Single;
- e41, e42, e43, e44: Single);
- end;
- // Matrix Arrays
- TxMatrix2DArray = array of TxMatrix2D;
- TxMatrix3DArray = array of TxMatrix3D;
- //-----------------------
- // Polygon types
- //-----------------------
- TxPolygon2D = TxPoint2DArray;
- TxPolygon3D = TxPoint3DArray;
- {
- TxPolygon3D = record
- Vertices: array of TxPoint3D;
- function Area;
- end;
- }
- const
- ClosedPolygon2D: TxPoint2D = (X: $FFFF; Y: $FFFF);
- ClosedPolygon3D: TxPoint3D = (X: $FFFF; Y: $FFFF; Z: $FFFF);
- type
- PxVertexArray = ^TxVertexArray;
- TxVertexArray = array [0 .. (MaxInt shr 8)] of TxVertex;
- type
- TxTriangle = record
- v1, v2, v3: Integer;
- ///Vertices: array[0..2] of TxPoint3D;
- ///function Area;
- end;
- PxTriangleArray = ^TxTriangleArray;
- TxTriangleArray = array [0 .. (MaxInt shr 8)] of TxTriangle;
- //-----------------------
- // Polyhedron types
- //-----------------------
- type
- TxPolyhedron = array of TxPolygon3D;
- (*
- TxPolyhedron = record
- Facets: array of TxPolygon3D;
- function NetLength;
- function Area;
- function Volume;
- end;
- *)
- //--------------------------
- // Mesh simple record types
- //--------------------------
- type
- TxMesh2DVertex = record
- X, Y: Single;
- NX, NY: Single;
- tU, tV: Single;
- end;
- TxMesh3DVertex = packed record
- X, Y, Z: Single;
- NX, NY, NZ: Single;
- tU, tV: Single;
- end;
- TxMesh2D = array of TxMesh2DVertex;
- TxMesh3D = array of TxMesh3DVertex;
- //--------------------------
- // Quaternion record types
- //--------------------------
- type
- TxQuaternion3D = record
- ImPart: TxVector3D;
- RePart: Single;
- end;
- TxQuaternionArray = array of TxQuaternion3D;
- type
- TxBox = record
- ALeft, ATop, ANear, ARight, ABottom, AFar: Single;
- end;
- const
- sWRONG_ELEMENT = 'Wrong element';
- sWRONG_SIZE = 'Wrong size';
- sNOT_QUAD = 'Matrix not quadratic';
- sSINGULAR = 'Singular matrix founded';
- //---------------------------------------------------------------
- implementation
- //---------------------------------------------------------------
- function TxVec(V: TAbstractVector): TxVector;
- begin
- Result.Create(V);
- end;
- function TxMat(M: TAbstractMatrix): TxMatrix;
- begin
- Result.Create(M);
- end;
- function TxQuat(Q: TAbstractVector): TxQuaternion;
- begin
- Result.Create(Q);
- end;
- {$POINTERMATH ON}
- function NotUnique(PArr: PCardinal): Boolean;
- begin
- Result := (PArr - 2)^ > 1;
- end;
- { TxMatrix }
- // Removing i-th row and j-th col
- function TxMatrix.Del(A: TxMatrix; I, J: Integer; M: Integer): TxMatrix;
- var
- K, G: Integer;
- begin
- for G := I to M - 1 do
- for K := 1 to M do
- A[G, K] := A[G + 1, K];
- for G := J to M - 1 do
- for K := 1 to M - 1 do
- A[K, G] := A[K, G + 1];
- Result := A;
- end;
- // Recursive calculation of det for matrix
- function TxMatrix.Det(A: TxMatrix; M: Integer): Extended;
- var
- I: Integer;
- Buf: Extended;
- begin
- Buf := 0;
- if M = 1 then
- Buf := A[1, 1]
- else
- for I := 1 to M do
- Buf := Buf + Power10(-1, I + 1) * A[I, 1] *
- Det(Del(A, I, 1, M), M - 1);
- Result := Buf;
- end;
- class operator TxMatrix.Add(M1, M2: TxMatrix): TxMatrix;
- var
- I, J: Integer;
- begin
- if (M1.FRowsCount <> M2.FRowsCount) or (M1.FColsCount <> M2.FColsCount) then
- raise EMathError.Create(sWRONG_SIZE);
- Result.Create(M1.FRowsCount, M1.FColsCount);
- for I := 0 to M1.FRowsCount - 1 do
- for J := 0 to M1.FColsCount - 1 do
- Result.FData[I, J] := M1.FData[I, J] + M2.FData[I, J];
- end;
- procedure TxMatrix.CheckUnique;
- var
- I: Integer;
- begin
- if NotUnique(@FData) then
- begin
- FData := Copy(FData);
- for I := 0 to Pred(FRowsCount) do
- FData[i] := Copy(FData[i]);
- end;
- end;
- constructor TxMatrix.Create(RowsCount, ColsCount: Word);
- begin
- FRowsCount := RowsCount;
- FColsCount := ColsCount;
- FData := nil;
- SetLength(FData, FRowsCount, FColsCount);
- end;
- constructor TxMatrix.Create(M: TAbstractMatrix);
- var
- I: Integer;
- begin
- FRowsCount := Length(M);
- FColsCount := Length(M[0]);
- FData := nil;
- SetLength(FData, FRowsCount, FColsCount);
- for I := 0 to Pred(FRowsCount) do
- begin
- if Length(M[I]) <> FColsCount then
- raise EMathError.Create('Wrong matrix proportions');
- FData[I] := Copy(M[I]);
- end;
- end;
- constructor TxMatrix.CreateDiag(Dim: Word; Value: Extended = 1.0);
- var
- I: Integer;
- begin
- Create(Dim, Dim);
- for I := 0 to Dim - 1 do
- FData[I, I] := Value;
- end;
- function TxMatrix.Determinant: Extended;
- begin
- if (FRowsCount <> FColsCount) then
- raise EMathError.Create(sNOT_QUAD);
- Result := Det(Self, FRowsCount);
- end;
- procedure TxMatrix.Fill(Scalar: Extended);
- var
- I, J: Integer;
- begin
- if Scalar = 0 then
- begin
- FData := nil;
- SetLength(FData, FRowsCount, FColsCount);
- end
- else
- for I := 0 to FRowsCount - 1 do
- for J := 0 to FColsCount - 1 do
- FData[I, J] := Scalar;
- end;
- function TxMatrix.GetCol(Col: Word): TxVector;
- var
- I: Integer;
- begin
- if (Col = 0) or (Col > FColsCount) then
- raise EMathError.Create(sWRONG_ELEMENT);
- Result.Create(FRowsCount);
- for I := 0 to FRowsCount - 1 do
- Result.FData[I] := FData[I, Col - 1];
- end;
- function TxMatrix.GetElement(Row, Col: Word): Extended;
- begin
- {$R+}
- Result := FData[Pred(Row), Pred(Col)];
- end;
- function TxMatrix.GetRow(Row: Word): TxVector;
- var
- I: Integer;
- begin
- if (Row = 0) or (Row > FRowsCount) then
- raise EMathError.Create(sWRONG_ELEMENT);
- Result.Create(FColsCount);
- for I := 0 to FColsCount - 1 do
- Result.FData[I] := FData[Row - 1, I];
- end;
- class operator TxMatrix.Implicit(M: TAbstractMatrix): TxMatrix;
- begin
- Result.Create(M);
- end;
- function TxMatrix.Inv: TxMatrix;
- var
- Ipiv, Indxr, Indxc: array of Integer;
- DimMat, I, J, K, L, N, ICol, IRow: Integer;
- Big, Dum, Pivinv: Extended;
- begin
- // Jordan algorithm
- if (FRowsCount <> FColsCount) then
- raise EMathError.Create(sNOT_QUAD);
- Result := Self;
- DimMat := FRowsCount;
- SetLength(Ipiv, DimMat);
- SetLength(Indxr, DimMat);
- SetLength(Indxc, DimMat);
- IRow := 1;
- ICol := 1;
- for I := 1 to DimMat do
- begin
- Big := 0;
- for J := 1 to DimMat do
- if (Ipiv[J - 1] <> 1) then
- for K := 1 to DimMat do
- if (Ipiv[K - 1] = 0) then
- if (Abs(Result[J, K]) >= Big) then
- begin
- Big := Abs(Result[J, K]);
- IRow := J;
- ICol := K;
- end;
- Ipiv[ICol - 1] := Ipiv[ICol - 1] + 1;
- if (IRow <> ICol) then
- for L := 1 to DimMat do
- begin
- Dum := Result[IRow, L];
- Result[IRow, L] := Result[ICol, L];
- Result[ICol, L] := Dum;
- end;
- Indxr[I - 1] := IRow;
- Indxc[I - 1] := ICol;
- if Result[ICol, ICol] = 0 then
- raise EMathError.Create(sSINGULAR);
- Pivinv := 1.0 / Result[ICol, ICol];
- Result[ICol, ICol] := 1.0;
- for L := 1 to DimMat do
- Result[ICol, L] := Result[ICol, L] * Pivinv;
- for N := 1 to DimMat do
- if (N <> ICol) then
- begin
- Dum := Result[N, ICol];
- Result[N, ICol] := 0.0;
- for L := 1 to DimMat do
- Result[N, L] := Result[N, L] - Result[ICol, L] * Dum;
- end;
- end;
- for L := DimMat downto 1 do
- if (Indxr[L - 1] <> Indxc[L - 1]) then
- for K := 1 to DimMat do
- begin
- Dum := Result[K, Indxr[L - 1]];
- Result[K, Indxr[L - 1]] := Result[K, Indxc[L - 1]];
- Result[K, Indxc[L - 1]] := Dum;
- end;
- end;
- function TxMatrix.ToQuat: TxQuaternion;
- begin
- Result[0] := 0.5 * Sqrt(Abs(1 + Self[1,1] + Self[2,2] + Self[3,3]));
- Result[1] := 0.5 * Sqrt(Abs(1 + Self[1,1] - Self[2,2] - Self[3,3]));
- if Self[3,2] < Self[2,3] then
- Result[1] := -Result[1];
- Result[2] := 0.5 * Sqrt(Abs(1 - Self[1,1] + Self[2,2] - Self[3,3]));
- if Self[1,3] < Self[3,1] then
- Result[2] := -Result[2];
- Result[3] := 0.5 * Sqrt(Abs(1 - Self[1,1] - Self[2,2] + Self[3,3]));
- if Self[2,1] < Self[1,2] then
- Result[3] := -Result[3];
- end;
- class operator TxMatrix.Multiply(M: TxMatrix; Q: TxQuaternion): TxQuaternion;
- var
- I, J: Integer;
- begin
- if (M.FRowsCount <> 4) or (M.FRowsCount <> M.FColsCount) then
- raise EMathError.Create(sWRONG_SIZE);
- FillChar(Result.FData, SizeOf(Result.FData), 0);
- for I := 0 to 3 do
- for J := 0 to 3 do
- Result.FData[I] := Result.FData[I] + M.FData[I, J] * Q.FData[J];
- end;
- class operator TxMatrix.Multiply(Scalar: Extended; M: TxMatrix): TxMatrix;
- begin
- Result := M * Scalar;
- end;
- class operator TxMatrix.Multiply(V: TxVector; M: TxMatrix): TxVector;
- var
- I, J: Integer;
- begin
- if (V.FCount <> M.FRowsCount) then
- raise EMathError.Create(sWRONG_SIZE);
- Result.Create(V.FCount);
- for I := 0 to V.FCount - 1 do
- for J := 0 to V.FCount - 1 do
- Result.FData[I] := Result.FData[I] + V.FData[J] * M.FData[J, I];
- end;
- class operator TxMatrix.Multiply(M: TxMatrix; V: TxVector): TxVector;
- var
- I, J: Integer;
- begin
- if (M.FColsCount <> V.FCount) then
- raise EMathError.Create(sWRONG_SIZE);
- Result.Create(M.FRowsCount);
- for I := 0 to M.FRowsCount - 1 do
- for J := 0 to M.FColsCount - 1 do
- Result.FData[I] := Result.FData[I] + M.FData[I, J] * V.FData[J];
- end;
- class operator TxMatrix.Multiply(M: TxMatrix; Scalar: Extended): TxMatrix;
- var
- I, J: Integer;
- begin
- Result.Create(M.FRowsCount, M.FColsCount);
- for I := 0 to M.FRowsCount - 1 do
- for J := 0 to M.FColsCount - 1 do
- Result.FData[I, J] := M.FData[I, J] * Scalar;
- end;
- class operator TxMatrix.Multiply(M1, M2: TxMatrix): TxMatrix;
- var
- I, J, K: Integer;
- begin
- if (M1.FColsCount <> M2.FRowsCount) then
- raise EMathError.Create(sWRONG_SIZE);
- Result.Create(M1.FRowsCount, M2.FColsCount);
- for I := 0 to M1.FRowsCount - 1 do
- for J := 0 to M2.FColsCount - 1 do
- for K := 0 to M1.FColsCount - 1 do
- Result.FData[I, J] := Result.FData[I, J] + M1.FData[I, K] * M2.FData[K, J];
- end;
- procedure TxMatrix.SetCol(Col: Word; Value: TxVector);
- var
- I: Integer;
- begin
- if (Col = 0) or (Col > FColsCount) then
- raise EMathError.Create(sWRONG_ELEMENT);
- if (Value.Count <> FRowsCount) then
- raise EMathError.Create(sWRONG_SIZE);
- for I := 0 to FRowsCount - 1 do
- FData[I, Col - 1] := Value.FData[I];
- end;
- procedure TxMatrix.SetElement(Row, Col: Word; Value: Extended);
- begin
- {$R+}
- CheckUnique;
- FData[Pred(Row), Pred(Col)] := Value;
- end;
- procedure TxMatrix.SetRow(Row: Word; Value: TxVector);
- var
- I: Integer;
- begin
- if (Row = 0) or (Row > FRowsCount) then
- raise EMathError.Create(sWRONG_ELEMENT);
- if (Value.Count <> FColsCount) then
- raise EMathError.Create(sWRONG_SIZE);
- for I := 0 to FColsCount - 1 do
- FData[Row - 1, I] := Value.FData[I];
- end;
- class operator TxMatrix.Subtract(M1, M2: TxMatrix): TxMatrix;
- var
- I, J: Integer;
- begin
- if (M1.FColsCount <> M2.FColsCount) or (M1.FRowsCount <> M2.FRowsCount) then
- raise EMathError.Create(sWRONG_SIZE);
- Result.Create(M1.FRowsCount, M1.FColsCount);
- for I := 0 to M1.FRowsCount - 1 do
- for J := 0 to M1.FColsCount - 1 do
- Result.FData[I, J] := M1.FData[I, J] - M2.FData[I, J];
- end;
- function TxMatrix.Trace: Extended;
- var
- I: Integer;
- begin
- Result := 0;
- if FColsCount <> FRowsCount then
- raise EMathError.Create(sNOT_QUAD);
- for I := 0 to FColsCount - 1 do
- Result := Result + FData[I, I];
- end;
- function TxMatrix.Transp: TxMatrix;
- var
- I, J: Integer;
- begin
- Result.Create(FColsCount, FRowsCount);
- for I := 0 to FColsCount - 1 do
- for J := 0 to FRowsCount - 1 do
- Result.FData[I, J] := FData[J, I];
- end;
- function TxMatrix.TruncateSTI: TxMatrix;
- const
- Int32Max: Double = Integer.MaxValue;
- Int32Min: Double = Integer.MinValue;
- var
- I, J: Integer;
- begin
- Result.Create(FRowsCount, FColsCount);
- for I := 0 to FRowsCount - 1 do
- for J := 0 to FColsCount - 1 do
- begin
- if (FData[I, J] >= Int32Min) and (FData[I, J] <= Int32Max) then
- Result.FData[I, J] := Trunc(FData[I, J])
- else
- if (FData[I, J] < Int32Min) then
- Result.FData[I, J] := Int32Min
- else
- Result.FData[I, J] := Int32Max;
- end;
- end;
- //-----------------------------
- // TxVector
- //-----------------------------
- constructor TxVector.Create(V: TAbstractVector);
- begin
- FCount := Length(V);
- FData := Copy(V);
- end;
- constructor TxVector.Create(ElementsCount: Word);
- begin
- FCount := ElementsCount;
- FData := nil;
- SetLength(FData, FCount);
- end;
- class operator TxVector.Add(V1, V2: TxVector): TxVector;
- var
- i: Integer;
- begin
- if (V1.FCount <> V2.FCount) then
- raise EMathError.Create(sWRONG_SIZE);
- Result := TxVector.Create(V1.FCount);
- for i := 0 to V1.FCount - 1 do
- Result.FData[i] := V1.FData[i] + V2.FData[i];
- end;
- class operator TxVector.Add(V: TxVector; Scalar: Extended): TxVector;
- var
- I: Integer;
- begin
- Result.Create(V.FCount);
- for I := 0 to V.FCount - 1 do
- Result.FData[I] := V.FData[I] + Scalar;
- end;
- class operator TxVector.Add(Scalar: Extended; V: TxVector): TxVector;
- begin
- Result := V + Scalar;
- end;
- procedure TxVector.CheckUnique;
- begin
- if NotUnique(@FData) then
- FData := Copy(FData);
- end;
- class operator TxVector.Divide(V1, V2: TxVector): TxVector;
- var
- I: Integer;
- begin
- if (V1.FCount <> V2.FCount) then
- raise EMathError.Create(sWRONG_SIZE);
- Result.Create(V1.FCount);
- for I := 0 to V1.FCount - 1 do
- Result.FData[I] := V1.FData[I] / V2.FData[I];
- end;
- class operator TxVector.Divide(V: TxVector; Scalar: Extended): TxVector;
- begin
- Result := V * (1 / Scalar);
- end;
- class operator TxVector.Implicit(V: TAbstractVector): TxVector;
- begin
- Result.Create(V);
- end;
- procedure TxVector.Fill(Value: Extended);
- var
- I: Integer;
- begin
- if Value = 0 then
- begin
- FData := nil;
- SetLength(FData, FCount);
- end
- else
- for I := 0 to FCount - 1 do
- FData[I] := Value;
- end;
- function TxVector.GetElement(Index: Word): Extended;
- begin
- if (Index = 0) or (Index > FCount) then
- raise EMathError.Create(sWRONG_ELEMENT);
- Result := FData[Pred(Index)];
- end;
- class operator TxVector.Multiply(V: TxVector; Scalar: Extended): TxVector;
- var
- I: Integer;
- begin
- Result.Create(V.FCount);
- for I := 0 to V.FCount - 1 do
- Result.FData[I] := V.FData[I] * Scalar;
- end;
- class operator TxVector.Multiply(Scalar: Extended; V: TxVector): TxVector;
- begin
- Result := V * Scalar;
- end;
- function TxVector.Norm: Extended;
- begin
- Result := System.Math.Norm(FData);
- end;
- class operator TxVector.Multiply(V1, V2: TxVector): TxVector;
- begin
- if (V1.FCount <> 3) or (V2.FCount <> 3) then
- raise EMathError.Create(sWRONG_SIZE);
- Result.Create(V1.FCount);
- Result.FData[0] := V1.FData[1] * V2.FData[2] - V1.FData[2] * V2.FData[1];
- Result.FData[1] := V1.FData[2] * V2.FData[0] - V1.FData[0] * V2.FData[2];
- Result.FData[2] := V1.FData[0] * V2.FData[1] - V1.FData[1] * V2.FData[0];
- end;
- function TxVector.ScalarMult(V: TxVector): Extended;
- var
- I: Integer;
- begin
- if V.FCount <> FCount then
- raise EMathError.Create(sWRONG_SIZE);
- Result := 0.0;
- for I := 0 to FCount - 1 do
- Result := Result + FData[I] * V.FData[I];
- end;
- procedure TxVector.SetElement(Index: Word; Value: Extended);
- begin
- if (Index = 0) or (Index > FCount) then
- raise EMathError.Create(sWRONG_ELEMENT);
- CheckUnique;
- FData[Pred(Index)] := Value;
- end;
- class operator TxVector.Subtract(V1, V2: TxVector): TxVector;
- var
- I: Integer;
- begin
- if (V1.FCount <> V2.FCount) then
- raise EMathError.Create(sWRONG_SIZE);
- Result.Create(V1.FCount);
- for I := 0 to V1.FCount - 1 do
- Result.FData[I] := V1.FData[I] - V2.FData[I];
- end;
- class operator TxVector.Subtract(Scalar: Extended; V: TxVector): TxVector;
- var
- I: Integer;
- begin
- Result.Create(V.FCount);
- for I := 0 to V.FCount - 1 do
- Result.FData[I] := Scalar - V.FData[I];
- end;
- class operator TxVector.Subtract(V: TxVector; Scalar: Extended): TxVector;
- var
- I: Integer;
- begin
- Result.Create(V.FCount);
- for I := 0 to V.Count - 1 do
- Result.FData[I] := V.FData[I] - Scalar;
- end;
- function TxVector.SumOfElments: Extended;
- begin
- Result := Sum(FData);
- end;
- function TxVector.SumOfSquares: Extended;
- begin
- Result := System.Math.SumOfSquares(FData);
- end;
- function TxVector.ToQuat: TxQuaternion;
- var
- ModVec: Extended;
- C1, C2: Extended;
- begin
- if (FCount <> 3) then
- raise EMathError.Create(sWRONG_SIZE);
- ModVec := Norm;
- C1 := Cos(ModVec / 2);
- if ModVec > 1e-15 then
- C2 := Sin(ModVec / 2) / ModVec
- else
- C2 := 1;
- Result := [C1, FData[0] * C2, FData[1] * C2, FData[2] * C2];
- end;
- function TxVector.TruncateSTI: TxVector;
- const
- Int32Max: Double = Integer.MaxValue;
- Int32Min: Double = Integer.MinValue;
- var
- I: Integer;
- begin
- Result.Create(FCount);
- for I := 0 to FCount - 1 do
- begin
- if (FData[I] >= Int32Min) and (FData[I] <= Int32Max) then
- Result.FData[I] := Trunc(FData[I])
- else
- if (FData[I] < Int32Min) then
- Result.FData[I] := Int32Min
- else
- Result.FData[I] := Int32Max;
- end;
- end;
- //-----------------------------
- // TxQuatHelper
- //-----------------------------
- function TxQuatHelper.ToMatrix: TxMatrix;
- begin
- Result.Create(3, 3);
- Result[1, 1] := Sqr(FData[0]) + Sqr(FData[1]) - Sqr(FData[2]) - Sqr(FData[3]);
- Result[1, 2] := 2 * (FData[1] * FData[2] - FData[0] * FData[3]);
- Result[1, 3] := 2 * (FData[1] * FData[3] + FData[0] * FData[2]);
- Result[2, 1] := 2 * (FData[1] * FData[2] + FData[0] * FData[3]);
- Result[2, 2] := Sqr(FData[0]) - Sqr(FData[1]) + Sqr(FData[2]) - Sqr(FData[3]);
- Result[2, 3] := 2 * (FData[2] * FData[3] - FData[0] * FData[1]);
- Result[3, 1] := 2 * (FData[1] * FData[3] - FData[0] * FData[2]);
- Result[3, 2] := 2 * (FData[2] * FData[3] + FData[0] * FData[1]);
- Result[3, 3] := Sqr(FData[0]) - Sqr(FData[1]) - Sqr(FData[2]) + Sqr(FData[3]);
- end;
- //-----------------------------
- // TxVecHelper
- //-----------------------------
- function TxVecHelper.ToDiagMatrix: TxMatrix;
- var
- I: Integer;
- begin
- Result.Create(FCount, FCount);
- for I := 0 to FCount - 1 do
- Result.FData[I, I] := FData[I];
- end;
- procedure Init(Obj, TypeInfoOfObj: Pointer; Offset: Integer = 0);
- const
- DefaultRowCount = 3;
- DefaultColCount = 3;
- VectorTypeName = 'TVector';
- MatrixTypeName = 'TMatrix';
- var
- RTTIContext: TRttiContext;
- Field : TRttiField;
- ArrFld: TRttiArrayType;
- I: Integer;
- Dim: TCustomAttribute;
- RowCount, ColCount: Integer;
- OffsetFromArray: Integer;
- begin
- for Field in RTTIContext.GetType(TypeInfoOfObj).GetFields do
- begin
- if Field.FieldType <> nil then
- begin
- RowCount := DefaultRowCount;
- ColCount := DefaultColCount;
- for Dim in Field.GetAttributes do
- begin
- RowCount := (Dim as TxDim).RowCount;
- ColCount := (Dim as TxDim).ColCount;
- end;
- if Field.FieldType.TypeKind = tkArray then
- begin
- ArrFld := TRttiArrayType(Field.FieldType);
- if ArrFld.ElementType.TypeKind = tkRecord then
- begin
- for I := 0 to ArrFld.TotalElementCount - 1 do
- begin
- OffsetFromArray := I * ArrFld.ElementType.TypeSize;
- if ArrFld.ElementType.Name = VectorTypeName then
- PxVector(Integer(Obj) +
- Field.Offset +
- OffsetFromArray +
- Offset)^ := TxVector.Create(RowCount)
- else if ArrFld.ElementType.Name = MatrixTypeName then
- PxMatrix(Integer(Obj) +
- Field.Offset +
- OffsetFromArray +
- Offset)^ := TxMatrix.Create(RowCount, ColCount)
- else
- Init(Obj, ArrFld.ElementType.Handle, Field.Offset + OffsetFromArray);
- end;
- end;
- end
- else if Field.FieldType.TypeKind = tkRecord then
- begin
- if Field.FieldType.Name = VectorTypeName then
- PxVector(Integer(Obj) +
- Field.Offset +
- Offset)^ := TxVector.Create(RowCount)
- else if Field.FieldType.Name = MatrixTypeName then
- PxMatrix(Integer(Obj) +
- Field.Offset +
- Offset)^ := TxMatrix.Create(RowCount, ColCount)
- else
- Init(Obj, Field.FieldType.Handle, Field.Offset)
- end;
- end;
- end;
- end;
- //-----------------------------
- // TxDim
- //-----------------------------
- constructor TxDim.Create(ARowCount: Integer; AColCount: Integer = 0);
- begin
- FRowCount := ARowCount;
- FColCount := AColCount;
- end;
- //-----------------------------
- // TxPoint2D
- //-----------------------------
- function TxPoint2D.Create(X, Y : Single): TxPoint2D;
- begin
- Result.X := X;
- Result.Y := Y;
- end;
- procedure TxPoint2D.SetPosition(const X, Y: Single);
- begin
- Self.X := X;
- Self.Y := Y;
- end;
- function TxPoint2D.Length: Single;
- begin
- Result := Sqrt(Self.X * Self.X + Self.Y * Self.Y);
- end;
- function TxPoint2D.Add(const APoint2D: TxPoint2D): TxPoint2D;
- begin
- Result.SetPosition(Self.X + APoint2D.X, Self.Y + APoint2D.Y);
- end;
- function TxPoint2D.Distance(const APoint2D: TxPoint2D): Single;
- begin
- Result := Sqrt(Sqr(Self.X - APoint2D.X) + Sqr(Self.Y - APoint2D.Y));
- end;
- procedure TxPoint2D.Offset(const ADeltaX, ADeltaY: Single);
- begin
- Self.X := Self.X + ADeltaX;
- Self.Y := Self.Y + ADeltaY;
- end;
- class function TxPoint2D.PointInCircle(const Point, Center: TxPoint2D;
- const Radius: Integer): Boolean;
- begin
- Result := Point.Distance(Center) <= Radius;
- end;
- //-----------------------------
- // TxPoint3D
- //-----------------------------
- function TxPoint3D.Create(X, Y, Z: Single): TxPoint3D;
- begin
- Result.X := X;
- Result.Y := Y;
- Result.Z := Z;
- end;
- function TxPoint3D.Add(const AGLPoint3D: TxPoint3D): TxPoint3D;
- begin
- Result.X := Self.X + AGLPoint3D.X;
- Result.Y := Self.Y + AGLPoint3D.Y;
- Result.Z := Self.Z + AGLPoint3D.Z;
- end;
- function TxPoint3D.Distance(const APoint3D: TxPoint3D): Single;
- begin
- Result := Self.Length - APoint3D.Length;
- end;
- function TxPoint3D.Length: Single;
- begin
- Result := Sqrt(Self.X * Self.X + Self.Y * Self.Y + Self.Z * Self.Z);
- end;
- procedure TxPoint3D.Offset(const ADeltaX, ADeltaY, ADeltaZ: Single);
- begin
- Self.X := Self.X + ADeltaX;
- Self.Y := Self.Y + ADeltaY;
- Self.Z := Self.Z + ADeltaZ;
- end;
- procedure TxPoint3D.SetPosition(const X, Y, Z: Single);
- begin
- Self.X := X;
- Self.Y := Y;
- Self.Z := Z;
- end;
- //-----------------------------
- // TxVector2D
- //-----------------------------
- function TxVector2D.Create(const AX, AY, AW: Single): TxVector2D;
- begin
- Result.X := AX;
- Result.Y := AY;
- Result.W := AW;
- end;
- function TxVector2D.CrossProduct(const AVector: TxVector2D): TxVector2D;
- begin
- Result.X := (Self.Y * AVector.W) - (Self.W * AVector.Y);
- Result.Y := (Self.W * AVector.X) - (Self.X * AVector.W);
- Result.W := (Self.X * AVector.Y) - (Self.Y * AVector.X);
- end;
- function TxVector2D.DotProduct(const AVector: TxVector2D): Single;
- begin
- Result := (Self.X * AVector.X) + (Self.Y * AVector.Y) + (Self.W * AVector.W);
- end;
- function TxVector2D.Add(const AVector2D: TxVector2D): TxVector2D;
- begin
- Result.X := Self.X + AVector2D.X;
- Result.Y := Self.Y + AVector2D.Y;
- Result.W := 1.0;
- end;
- function TxVector2D.Length: Single;
- begin
- Result := Sqrt((Self.X * Self.X) + (Self.Y * Self.Y));
- end;
- function TxVector2D.Norm: Single;
- begin
- Result := Sqr(Self.X) + Sqr(Self.Y);
- end;
- function TxVector2D.Normalize: TxVector2D;
- var
- invLen: Single;
- vn: Single;
- const
- Tolerance: Single = 1E-12;
- begin
- vn := Self.Norm;
- if vn > Tolerance then
- begin
- invLen := 1/Sqrt(vn);
- Result.X := Self.X * invLen;
- Result.Y := Self.Y * invLen;
- end
- else
- Result := Self;
- end;
- //---------------------------------
- // TxVector3D
- //---------------------------------
- function TxVector3D.Create(const AX, AY, AZ, AW: Single): TxVector3D;
- begin
- Result.X := AX;
- Result.Y := AY;
- Result.Z := AZ;
- Result.W := AW;
- end;
- function TxVector3D.Add(const AVector3D: TxVector3D): TxVector3D;
- begin
- Result.X := Self.X + AVector3D.X;
- Result.Y := Self.Y + AVector3D.Y;
- Result.Z := Self.Z + AVector3D.Z;
- Result.W := 1.0;
- end;
- function TxVector3D.Norm: Single;
- begin
- result := Self.X * Self.X + Self.Y * Self.Y + Self.Z * Self.Z;
- end;
- function TxVector3D.Normalize: TxVector3D;
- var
- invLen: Single;
- vn: Single;
- const
- Tolerance: Single = 1E-12;
- begin
- vn := Self.Norm;
- if vn > 0 then
- begin
- invLen := 1/Sqrt(vn);
- Result.X := Self.X * invLen;
- Result.Y := Self.Y * invLen;
- Result.Z := Self.Z * invLen;
- Result.W := 0;
- end
- else
- Result := Self;
- end;
- function TxVector3D.DotProduct(const AVector3D: TVector3D): Single;
- begin
- Result := (Self.X * AVector3D.X) + (Self.Y * AVector3D.Y) + (Self.Z * AVector3D.Z);
- end;
- function TxVector3D.CrossProduct(const AVector3D: TVector3D): TVector3D;
- begin
- Result.X := (Self.Y * AVector3D.Z) - (Self.Z * AVector3D.Y);
- Result.Y := (Self.Z * AVector3D.X) - (Self.X * AVector3D.Z);
- Result.Z := (Self.X * AVector3D.Y) - (Self.Y * AVector3D.X);
- end;
- function TxVector3D.Length: Single;
- begin
- Result := Sqrt((Self.X * Self.X) + (Self.Y * Self.Y) + (Self.Z * Self.Z));
- end;
- //---------------------------------
- // TxQuaternion
- //---------------------------------
- function TxQuaternion.GetElement(Index: Byte): Extended;
- begin
- if (Index > 3) then
- raise EMathError.Create(sWRONG_ELEMENT);
- Result := FData[Index];
- end;
- class operator TxQuaternion.Implicit(V: TAbstractVector): TxQuaternion;
- begin
- if (Length(V) <> 4) then
- raise EMathError.Create(sWRONG_SIZE);
- Move(V[0], Result.FData, SizeOf(Result.FData));
- end;
- function TxQuaternion.Inv: TxQuaternion;
- begin
- Result := [FData[0], -FData[1], -FData[2], -FData[3]];
- end;
- class operator TxQuaternion.Multiply(Scalar: Extended; Q: TxQuaternion): TxQuaternion;
- begin
- Result := Q * Scalar;
- end;
- class operator TxQuaternion.Multiply(Q: TxQuaternion; Sc: Extended): TxQuaternion;
- begin
- Result := [Q.FData[0] * Sc, Q.FData[1] * Sc, Q.FData[2] * Sc, Q.FData[3] * Sc];
- end;
- class operator TxQuaternion.Multiply(Q1, Q2: TxQuaternion): TxQuaternion;
- var
- Mat: TxMatrix;
- begin
- Mat := [[Q1.FData[0], -Q1.FData[1], -Q1.FData[2], -Q1.FData[3]],
- [Q1.FData[1], Q1.FData[0], -Q1.FData[3], Q1.FData[2]],
- [Q1.FData[2], Q1.FData[3], Q1.FData[0], -Q1.FData[1]],
- [Q1.FData[3], -Q1.FData[2], Q1.FData[1], Q1.FData[0]]];
- Result := Mat * Q2;
- end;
- constructor TxQuaternion.Create(Q: TAbstractVector);
- begin
- if Length(Q) <> 4 then
- raise EMathError.Create(sWRONG_SIZE);
- Move(Q[0], FData[0], SizeOf(FData));
- end;
- procedure TxQuaternion.SetElement(Index: Byte; Value: Extended);
- begin
- if (Index > 3) then
- raise EMathError.Create(sWRONG_ELEMENT);
- FData[Index] := Value;
- end;
- function TxQuaternion.TruncateSTI: TxQuaternion;
- const
- Int32Max: Double = Integer.MaxValue;
- Int32Min: Double = Integer.MinValue;
- function xTrunc(Value: Extended): Double;
- begin
- if (Value >= Int32Min) and (Value <= Int32Max) then
- Result := Trunc(Value)
- else
- if (Value < Int32Min) then
- Result := Int32Min
- else
- Result := Int32Max;
- end;
- begin
- Result[0] := xTrunc(FData[0]);
- Result[1] := xTrunc(FData[1]);
- Result[2] := xTrunc(FData[2]);
- Result[3] := xTrunc(FData[3]);
- end;
- end.
|