Files

303 lines
7.3 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
unit Geometry;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils;
type
{ Вершины }
Vertex = record
x, y, z: Real; { Координаты вершины }
end;
{ Ребра }
Edge = record
src, dest: Integer; { Индексы соединяемых вершин }
end;
Object3D = record
vertices: array of Vertex; { вершины }
edges: array of Edge; { ребра }
xc, yc, zc: Real; { координаты центра объекта }
end;
Matrix = array[1..4, 1..4] of Real; { матрица 4x4 }
Column = array[1..4] of Real; { столбец }
function LoadObject3D(filename: String): Object3D;
function CopyObject3D(Shape: Object3D): Object3D;
{ умножение матрицы на матрицу }
function MMMult(lhs, rhs: Matrix): Matrix;
{ умножение матрицы на столбец }
function MCMult(lhs: Matrix; rhs: Column): Column;
{ матрица поворота модели }
function RotateMatrix(xa, ya, za: Real): Matrix;
function MoveMatrix(tx, ty, tz: Real): Matrix;
function ResizeMatrix(sx, sy, sz: Real): Matrix;
procedure RotateShape(var Shape: Object3D; xa, ya, za: Real);
procedure MoveShape(var Shape: Object3D; tx, ty, tz: Real);
procedure ResizeShape(var Shape: Object3D; sx, sy, sz: Real);
implementation
function LoadObject3D(filename: String): Object3D;
var
F: TextFile; { исходный файл }
NV, NE: Integer; { количество вершин, количество ребер }
Shape: Object3D; { модель }
i: Integer; { счетчик цикла }
begin
AssignFile(F, filename); { открываем исходный файл }
FileMode := 0; { в режиме "только чтение" }
Reset(F);
ReadLn(F, NV); { считываем количество вершин }
SetLength(Shape.vertices, NV); { и корректируем размер массива }
for i := 0 to NV - 1 do { считываем каждую вершину }
ReadLn(F, Shape.vertices[i].x, Shape.vertices[i].y, Shape.vertices[i].z);
ReadLn(F, NE); { то же для ребер }
SetLength(Shape.edges, NE);
for i := 0 to NE - 1 do
ReadLn(F, Shape.edges[i].src, Shape.edges[i].dest);
CloseFile(F);
LoadObject3D := Shape;
end;
function CopyObject3D(Shape: Object3D): Object3D;
begin
CopyObject3D.vertices := Copy(Shape.vertices, 0);
CopyObject3D.edges := Copy(Shape.edges, 0);
CopyObject3D.xc := Shape.xc;
CopyObject3D.yc := Shape.yc;
CopyObject3D.zc := Shape.zc
end;
function MMMult(lhs, rhs: Matrix): Matrix;
var
i, j, k: Integer;
r: Matrix;
s: Real;
begin
for i := 1 to 4 do
for j := 1 to 4 do
begin
s := 0;
for k := 1 to 4 do
s := s + lhs[i, k] * rhs[k, j];
r[i, j] := s;
end;
MMMult := r;
end;
function MCMult(lhs: Matrix; rhs: Column): Column;
var
k, i: Integer;
s: Real;
r: Column;
begin
for i := 1 to 4 do { аналогично MMMult }
begin
s := 0;
for k := 1 to 4 do
s := s + lhs[i, k] * rhs[k];
r[i] := s;
end;
MCMult := r;
end;
function RotateMatrix(xa, ya, za: Real): Matrix;
var
xr, yr, zr: Matrix;
begin
{ матрица поворота вокруг оси Ox }
xr[1, 1] := 1;
xr[1, 2] := 0;
xr[1, 3] := 0;
xr[1, 4] := 0;
xr[2, 1] := 0;
xr[2, 2] := Cos(xa);
xr[2, 3] := -Sin(xa);
xr[2, 4] := 0;
xr[3, 1] := 0;
xr[3, 2] := Sin(xa);
xr[3, 3] := Cos(xa);
xr[3, 4] := 0;
xr[4, 1] := 0;
xr[4, 2] := 0;
xr[4, 3] := 0;
xr[4, 4] := 1;
{ матрица поворота вокруг оси Oy }
yr[1, 1] := Cos(ya);
yr[1, 2] := 0;
yr[1, 3] := Sin(ya);
yr[1, 4] := 0;
yr[2, 1] := 0;
yr[2, 2] := 1;
yr[2, 3] := 0;
yr[2, 4] := 0;
yr[3, 1] := -Sin(ya);
yr[3, 2] := 0;
yr[3, 3] := Cos(ya);
yr[3, 4] := 0;
yr[4, 1] := 0;
yr[4, 2] := 0;
yr[4, 3] := 0;
yr[4, 4] := 1;
{ матрица поворота вокруг оси Oz }
zr[1, 1] := Cos(za);
zr[1, 2] := -Sin(za);
zr[1, 3] := 0;
zr[1, 4] := 0;
zr[2, 1] := Sin(za);
zr[2, 2] := Cos(za);
zr[2, 3] := 0;
zr[2, 4] := 0;
zr[3, 1] := 0;
zr[3, 2] := 0;
zr[3, 3] := 1;
zr[3, 4] := 0;
zr[4, 1] := 0;
zr[4, 2] := 0;
zr[4, 3] := 0;
zr[4, 4] := 1;
RotateMatrix := MMMult(MMMult(xr, yr), zr)
end;
function MoveMatrix(tx, ty, tz: Real): Matrix;
begin
MoveMatrix[1, 1] := 1;
MoveMatrix[1, 2] := 0;
MoveMatrix[1, 3] := 0;
MoveMatrix[1, 4] := tx;
MoveMatrix[2, 1] := 0;
MoveMatrix[2, 2] := 1;
MoveMatrix[2, 3] := 0;
MoveMatrix[2, 4] := ty;
MoveMatrix[3, 1] := 0;
MoveMatrix[3, 2] := 0;
MoveMatrix[3, 3] := 1;
MoveMatrix[3, 4] := tz;
MoveMatrix[4, 1] := 0;
MoveMatrix[4, 2] := 0;
MoveMatrix[4, 3] := 0;
MoveMatrix[4, 4] := 1
end;
function ResizeMatrix(sx, sy, sz: Real): Matrix;
begin
ResizeMatrix[1, 1] := sx;
ResizeMatrix[1, 2] := 0;
ResizeMatrix[1, 3] := 0;
ResizeMatrix[1, 4] := 0;
ResizeMatrix[2, 1] := 0;
ResizeMatrix[2, 2] := sy;
ResizeMatrix[2, 3] := 0;
ResizeMatrix[2, 4] := 0;
ResizeMatrix[3, 1] := 0;
ResizeMatrix[3, 2] := 0;
ResizeMatrix[3, 3] := sz;
ResizeMatrix[3, 4] := 0;
ResizeMatrix[4, 1] := 0;
ResizeMatrix[4, 2] := 0;
ResizeMatrix[4, 3] := 0;
ResizeMatrix[4, 4] := 1
end;
procedure RotateShape(var Shape: Object3D; xa, ya, za: Real);
var
rm: Matrix;
i: Integer;
c: Column;
begin
rm := RotateMatrix(xa, ya, za); { сгенерировать матрицу вращения }
c[4] := 1; { последний элемент столбца всегда равен единице }
for i := 0 to High(Shape.vertices) do { цикл по всем вершинам }
begin { High(a) возвращает верхний индекс массива a }
c[1] := Shape.vertices[i].x; { инициализация столбца }
c[2] := Shape.vertices[i].y;
c[3] := Shape.vertices[i].z;
c := MCMult(rm, c); { вызов преобразования }
Shape.vertices[i].x := c[1]; { внесение изменений в модель }
Shape.vertices[i].y := c[2]; { в соответствии с полученным }
Shape.vertices[i].z := c[3] { результатом преобразования }
end
end;
procedure MoveShape(var Shape: Object3D; tx, ty, tz: Real);
var
mm: Matrix;
i: Integer;
c: Column;
begin
mm := MoveMatrix(tx, ty, tz);
c[4] := 1;
for i := 0 to High(Shape.vertices) do
begin
c[1] := Shape.vertices[i].x;
c[2] := Shape.vertices[i].y;
c[3] := Shape.vertices[i].z;
c := MCMult(mm, c);
Shape.vertices[i].x := c[1];
Shape.vertices[i].y := c[2];
Shape.vertices[i].z := c[3]
end
end;
procedure ResizeShape(var Shape: Object3D; sx, sy, sz: Real);
var
mm: Matrix;
i: Integer;
c: Column;
begin
mm := ResizeMatrix(sx, sy, sz);
c[4] := 1;
for i := 0 to High(Shape.vertices) do
begin
c[1] := Shape.vertices[i].x;
c[2] := Shape.vertices[i].y;
c[3] := Shape.vertices[i].z;
c := MCMult(mm, c);
Shape.vertices[i].x := c[1];
Shape.vertices[i].y := c[2];
Shape.vertices[i].z := c[3]
end
end;
end.