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.