Delphi 10.2 TQuaternion3D Example

Delphi’s System.Math.Vectors unit contains the TQuaternion3D class.

There is no information about the class in the Help so I post some code here so I remember how to use the class.

Following are some code snippets showing how to use quaternions to transform the mesh vertices in a model according to a skeletal hierarchy.

The procedures are used to build the models from old classic Tomb Raider games and export them to a 3D modelling program.

In Tomb Raider the animation data is stored as an (x,y,z) offset for the root bone and YXZ Euler angles for the rotations of all the bones.

In Tomb Raider a right handed coordinate system is used but the –Y axis is up so usually a further transformation is needed to get the models the right way up in other programs.

Here I do a 180 degree rotation about the X axis.

It is important to do this transformation last since then you don’t have to worry about adjusting the angles or offsets.

The code snippets also use System.Generics.Collections TStack and TList.

I also include a small example for the System.Math.Vectors TMatrix3D class which similarly has no Help topic.

	procedure export_mesh(var slv:TStringList;vc:integer;var slf:TStringList; var m:tmesh_list; nmesh:integer; x,y,z:glfloat;quat:TQuaternion3D;var usedmats:array of integer;scale:glfloat=1);
	var
	k,mat:integer;
	x1,y1,z1 :glfloat;
	texture:word;
	mx1,my1,mx2,my2,mx3,my3,mx4,my4:single;
	p1,p2,p3,p4 : integer;
	q1,q2,q:TQuaternion3D;
	pp:Tpoint3d;
	fs:TFormatSettings;
	begin
	if (nmesh>(m.num_meshes-1)) or (nmesh<0) then exit;
	fs:=TFormatSettings.Create('en-US');
	for k:=0 to m.meshes[nmesh].num_vertices-1 do
	begin
	x1:= m.meshes[nmesh].vertices[k].x;
	y1:= m.meshes[nmesh].vertices[k].y;
	z1:= m.meshes[nmesh].vertices[k].z;
	// q1:=TQuaternion3D.Create(Point3D(x1,y1,z1),0); // vertex expressed as quaternion !!!doesn't work Embarcadero!!!
	q1:=TQuaternion3D.Identity;
	q1.ImagPart.X:=x1;
	q1.ImagPart.Y:=y1;
	q1.ImagPart.Z:=z1;
	q1.RealPart:=0;
	q2:=quat;
	q2.ImagPart:=-q2.ImagPart;
	q:=quat*q1*q2; // sandwich product
	pp:=q.ImagPart;
	x1:=pp.X;y1:=pp.Y;z1:=pp.Z;
	slv.Append(Format(#9#9'%.6f %.6f %.6f',[(x1/scale)+x, ((y1/scale)+y)*-1, ((z1/scale)+z)*-1],fs));
	end;
	for k:=0 to m.meshes[nmesh].num_textured_rectangles-1 do
	begin
	p1:=m.meshes[nmesh].textured_rectangles[k].p1+vc;
	p2:=m.meshes[nmesh].textured_rectangles[k].p2+vc;
	p3:=m.meshes[nmesh].textured_rectangles[k].p3+vc;
	p4:=m.meshes[nmesh].textured_rectangles[k].p4+vc;
	texture:=m.meshes[nmesh].textured_rectangles[k].texture and $7fff;
	get_uv_exent(l,texture,mx1,my1,mx2,my2,mx3,my3,mx4,my4);
	texture:=(l.Textures[texture].tile and $7fff);
	mat:=getRealMatIndex(texture,usedMats);
	slf.Append(Format(#9#9'4 V(%u %u %u %u) M(%u) UV(%.6f %.6f %.6f %.6f %.6f %.6f %.6f %.6f)',[p1,p2,p3,p4,mat,mx1,my1,mx2,my2,mx3,my3,mx4,my4],fs));
	end;//end all rectangles this mesh
	for k:=0 to m.meshes[nmesh].num_textured_triangles-1 do
	begin
	p1:=m.meshes[nmesh].textured_triangles[k].p1+vc;
	p2:=m.meshes[nmesh].textured_triangles[k].p2+vc;
	p3:=m.meshes[nmesh].textured_triangles[k].p3+vc;
	texture:=m.meshes[nmesh].textured_triangles[k].texture and $7fff;
	get_uv_exent(l,texture,mx1,my1,mx2,my2,mx3,my3,mx4,my4);
	texture:=(l.Textures[texture].tile and $7fff);
	mat:=getRealMatIndex(texture,usedmats);
	slf.Append(Format(#9#9'3 V(%u %u %u) M(%u) UV(%.6f %.6f %.6f %.6f %.6f %.6f)',[p1,p2,p3,mat,mx1,my1,mx2,my2,mx3,my3],fs));
	end;//end all triangles this mesh
	if l.tipo<vtr4 then
	begin
	for k:=0 to m.meshes[nmesh].num_colored_rectangles-1 do
	begin
	p1:=m.meshes[nmesh].colored_rectangles[k].p1+vc;
	p2:=m.meshes[nmesh].colored_rectangles[k].p2+vc;
	p3:=m.meshes[nmesh].colored_rectangles[k].p3+vc;
	p4:=m.meshes[nmesh].colored_rectangles[k].p4+vc;
	slf.Append(Format(#9#9'4 V(%u %u %u %u)',[p1,p2,p3,p4]));
	end;//end all rectangles this mesh
	//draw triangles
	for k:=0 to m.meshes[nmesh].num_colored_triangles-1 do
	begin
	p1:=m.meshes[nmesh].colored_triangles[k].p1+vc;
	p2:=m.meshes[nmesh].colored_triangles[k].p2+vc;
	p3:=m.meshes[nmesh].colored_triangles[k].p3+vc;
	slf.Append(Format(#9#9'3 V(%u %u %u)',[p1,p2,p3]));
	end;//end all triangles this mesh
	end; //end si version < tr4
	end; //end procedure
	procedure export_movable2(var sl:TStringList;var m:tmesh_list; var l:ttrlevel; movable,animation,frame:integer; x,y,z:real; angle:word; usedmats:array of integer;scale:glfloat=1);
	function conjQ(q:TQuaternion3D):TQuaternion3D;
	begin
	Result:=q;
	Result.ImagPart:=-Result.ImagPart;
	Result.Normalize;
	end;
	type
	xdword = record
	high,low:word;
	end;
	Tbone = record
	name:integer;
	pos,absPos:Tpoint3D;
	quat,absQuat:TQuaternion3D;
	end;
	var
	k:integer;
	num_meshes,mesh_p,mesh_tree:integer;
	kk:integer;
	flag:integer;
	ix,iy,iz:real;
	x_aligned,y_aligned,z_aligned:real;
	zangle,angle_x,angle_y,angle_z:real;
	itmp,itmp2:cardinal;
	frameofset:cardinal;
	frame_k:cardinal;
	p:integer;
	escala:real;
	factor:word;
	pbones:TStack<Tbone>;
	bones:TList<TBone>;
	b,parentb:Tbone;
	rotOffset:Tpoint3D;
	offsetQ,q:TQuaternion3D;
	slv,slf:TStringList;
	vertcount:integer;
	begin
	p:=0;
	if L.valido<>'Tpascal' then exit;
	if (movable+1)>l.num_Movables then exit;
	escala:=scale;
	Num_meshes:=l.movables[movable].nummeshes;
	mesh_p:=l.movables[movable].startmesh;
	kk:=m.mesh_pointers[mesh_p];
	mesh_tree:=l.movables[movable].meshtree-4; //very weird, i dont found any info why is need to substract 4???. hmm, seem first mesh dosent have mestree info, movables with just one mesh seem dosent have meshtree at all.
	//we need to found here desired frame, if frame<0 or frame>amount frames availible then show not rotations.
	frameofset:=get_frame_offset(l,movable,animation,frame); //get desired frame.
	//------------------------
	x_aligned:=l.frames[frameofset+6];
	y_aligned:=(l.frames[frameofset+7]);
	z_aligned:=(l.frames[frameofset+8]);
	x_aligned:=x_aligned/escala;
	y_aligned:=y_aligned/escala;
	z_aligned:=z_aligned/escala;
	ix:=0;iy:=0;iz:=0;
	frame_k:=frameofset+9; //starting angles for each mesh. tr3-trc
	if l.tipo<vtr2 then frame_k:=frameofset+10; //starting angles for each mesh. tr1-tub, i am asuming that numangles is alway same as NumMeshes from movables structure.
	pbones:=TStack<Tbone>.Create;
	bones:=TList<TBone>.Create;
	slv:=TStringList.Create;
	slf:=TStringList.Create;
	for k:=1 to num_meshes do
	begin
	b.name:=k-1;
	if k=1 then
	begin // root bone
	ix:=x_aligned;iy:=y_aligned;iz:=z_aligned;
	b.pos:=Point3D(ix,iy,iz);
	q:=TQuaternion3d.Create(Point3D(0,1,0),DegToRad(angle));
	q.Normalize;
	offsetQ:=TQuaternion3d.Identity;
	offsetQ.ImagPart:=b.pos;
	offsetQ.RealPart:=0;
	b.pos:=(q*offsetQ*conjQ(q)).ImagPart; // root bone is rotated in world
	b.pos.X:=b.pos.X+x;
	b.pos.Y:=b.pos.Y+y;
	b.pos.Z:=b.pos.Z+z;
	b.absPos:=b.pos;
	end
	else
	begin
	flag:=l.Meshtree[mesh_tree];
	ix :=(l.Meshtree[mesh_tree+1])/escala;
	iy :=(l.Meshtree[mesh_tree+2])/escala;
	iz :=(l.Meshtree[mesh_tree+3])/escala;
	b.pos:=Point3D(ix,iy,iz);
	end;
	angle_x:=0;angle_y:=0;angle_z:=0;
	//get the angle from desired frame for this mesh.
	// ------------------------------------------------
	factor:=1024;//tr1-tr3
	if l.tipo>vtr3 then factor:=4096;//tr4 and trc.
	//tr2-TRc
	xdword(itmp).low:=l.frames[frame_k];
	xdword(itmp).high:=l.frames[frame_k+1];
	//if tr1 then words order are inverted
	if l.tipo<vtr2 then
	begin
	xdword(itmp).high:=l.frames[frame_k];xdword(itmp).low:=l.frames[frame_k+1];
	end;
	case ((itmp shr 30) and $3) of //2 high bits tell if there come next one or 3 angles.
	0:
	begin //x,y,z angles.
	//x angle
	itmp2 := (itmp shr 20) and $3ff;
	zangle := itmp2*(360.0/1024);
	angle_X:=zangle;
	//y angle
	itmp2 := (itmp shr 10) and $3ff;
	zangle := itmp2*( 360.0/1024);
	angle_y:=zangle;
	//z angle
	itmp2 := itmp and $3ff;
	zangle := itmp2*( 360.0/1024);
	angle_z:=zangle;
	frame_k:=frame_k+2; //we used two bytes
	end;
	1:
	begin //x only
	itmp2 := (itmp shr 16) and $3fff; //14bits instead 10 bits
	zangle := itmp2*(360.0/factor);
	angle_X:=zangle;
	frame_k:=frame_k+1;
	end;
	2:
	begin //Y only
	itmp2 := (itmp shr 16) and $3fff;
	zangle := itmp2*(360.0/factor);
	angle_Y:=zangle;
	frame_k:=frame_k+1;
	end;
	3:
	begin //z only
	itmp2 := (itmp shr 16) and $3fff;
	zangle := itmp2*(360.0/factor);
	angle_Z:=zangle;
	frame_k:=frame_k+1;
	end;
	end; //endcase
	// if True then //if user requested not rotations.
	// begin
	// angle_x:=0;angle_y:=0;angle_z:=0;
	// end;
	b.quat:=TQuaternion3D.Create(Point3D(0,0,1),DegToRad(angle_z)).Normalize;
	b.quat:=TQuaternion3D.Create(Point3D(1,0,0),DegToRad(angle_x)).Normalize*b.quat;
	b.quat:=TQuaternion3D.Create(Point3D(0,1,0),DegToRad(angle_y)).Normalize*b.quat;
	b.quat:=b.quat.Normalize;
	if k=1 then
	begin
	b.quat:=q*b.quat;//todo need to check this
	b.absQuat:=b.quat.Normalize;
	end;
	if k>1 then // !flag only set if nummeshes > 1
	begin
	if (flag=2) or (flag=0)then
	begin
	parentb:=bones[(k-1)-1]; // use previous bone -> k-1 since loop starts at 1
	offsetQ:=TQuaternion3D.Identity;
	offsetQ.ImagPart:=b.pos;
	offsetQ.RealPart:=0;
	rotOffset:=(parentb.absQuat*offsetQ*conjQ(parentb.absQuat)).ImagPart;
	b.absPos:=parentb.absPos+rotOffset;
	b.absQuat:=parentb.absQuat*b.quat;
	b.absQuat.Normalize;
	if flag=2 then pbones.Push(parentb);
	end;
	if flag=1 then
	begin
	try
	parentb:=pbones.Pop;
	except
	Showmessage('Nothing to pop!');
	end;
	offsetQ:=TQuaternion3D.Identity;
	offsetQ.ImagPart:=b.pos;
	offsetQ.RealPart:=0;
	rotOffset:=(parentb.absQuat*offsetQ*conjQ(parentb.absQuat)).imagPart;
	b.absPos:=parentb.absPos+rotOffset;
	b.absQuat:=parentb.absQuat*b.quat;
	b.absQuat.Normalize;
	end;
	if flag=3 then
	begin
	parentb:=pbones.Peek;
	offsetQ:=TQuaternion3D.Identity;
	offsetQ.ImagPart:=b.pos;
	offsetQ.RealPart:=0;
	rotOffset:=(parentb.absQuat*offsetQ*conjQ(parentb.absQuat)).imagPart;
	b.absPos:=parentb.absPos+rotOffset;
	b.absQuat:=parentb.absQuat*b.quat;
	b.absQuat.Normalize;
	end;
	end;
	bones.Add(b);
	//if we are going to render mesh #0 then render the real true aparence mesh instead (except when mesh #0 is valid for current movable).
	if (kk=0) then
	if not ((movable=m.mov0) and (k=m.mesh0)) then kk:=m.mesh_pointers[m.skin_starting_mesh+k-1];
	vertcount:=slv.Count;
	export_mesh(slv,vertcount,slf,meshes,kk,b.absPos.X,b.absPos.Y,b.absPos.Z,b.absQuat,usedmats,escala);
	mesh_p:=mesh_p+1;
	kk:=m.mesh_pointers[mesh_p];
	mesh_tree:=mesh_tree+4;
	end;
	slv.Insert(0,Format(#9'vertex %u {',[slv.Count]));
	slv.Append(#9'}');
	sl.AddStrings(slv);
	slf.Insert(0,Format(#9'face %u {',[slf.Count]));
	slf.Append(#9'}');
	sl.AddStrings(slf);
	slv.Free;
	slf.Free;
	bones.Free;
	pbones.Free;
	end;

view raw quaternion.pas hosted with ❤ by GitHub

	program Project1;
	{$APPTYPE CONSOLE}
	{$R *.res}
	uses
	System.SysUtils,math,math.vectors;
	procedure writeMatrix(m:TMatrix3D);
	begin
	writeln(Format('%10.4f %10.4f %10.4f %10.4f',[m.m11,m.m12,m.m13,m.m14]));
	writeln(Format('%10.4f %10.4f %10.4f %10.4f',[m.m21,m.m22,m.m23,m.m24]));
	writeln(Format('%10.4f %10.4f %10.4f %10.4f',[m.m31,m.m32,m.m33,m.m34]));
	writeln(Format('%10.4f %10.4f %10.4f %10.4f',[m.m41,m.m42,m.m43,m.m44]));
	end;
	procedure writePoint(p:TPoint3d);
	begin
	writeln(Format('(%.4f %.4f %.4f)',[p.X,p.Y,p.Z]));
	end;
	var
	mat,mat2:TMatrix3D;
	p,p2:Tpoint3D;
	begin
	try
	{ TODO -oUser -cConsole Main : Insert code here }
	mat:=TMatrix3D.CreateTranslation(Point3D(10,11,12));
	mat2:=TMatrix3D.CreateRotationY(DegToRad(90));
	mat:=mat2*mat; // = rotation first, translation second
	writeMatrix(mat);
	p:=Point3D(1,0,0);
	p2:=p*mat; // point must be on left of multiply
	writeln;
	writepoint(p);
	writeln(' maps to');
	writePoint(p2);
	Readln;
	except
	on E: Exception do
	Writeln(E.ClassName, ': ', E.Message);
	end;
	end.

view raw matrix.pas hosted with ❤ by GitHub