Добрый час! Помогите, пожалуйста, найти ошибку в программе.
Вроде работает но немного не так. Не могу понять в чем проблема.
Постановказадачи. Написать программу для изображения Октаэдра, вращающегося вокруг оси ОY. Ось вращения не должна совпадать с собственной вертикальной осью
фигуры. Применить диметрию.
Описаниеметода решения задачи. Для создания фигуры указываем координаты вершины и порядок их соединения через ребра. С фигурой
осуществляются преобразования через матрицу 4*4
program octahedron;
uses crt,graph;
type point_position = array [1..3] of real;
type side_position = array [1..3] of point_position;
type oct_coord = array [1..8] of side_position;
const Color: array[1..8] of Integer = (1,2,3,4,5,6,9,10);
{фигура Октаэдр}
const oct: oct_coord= (((100,100,60),(50,100,-40),(100,50,-40)),
((100,100,60),(50,100,-40),(100,150,-40)),
((100,100,-140),(100,50,-40),(50,100,-40)),
((100,100,-140),(100,150,-40),(50,100,-40)),
((100,100,-140),(150,100,-40),(100,50,-40)),
((100,100,-140),(100,150,-40),(150,100,-40)),
((100,100,60),(100,50,-40),(150,100,-40)),
((100,100,60),(150,100,-40),(100,150,-40)));
const p=-0.002;
var
pcos,psin:real;
oct_new,oct_old:oct_coord;
dv,mv,x0, y0: integer;
procedure init;
var i,j,k:integer;
begin
x0 := getMaxX div 2;
y0 := getMaxY div 2;
for i:=1 to High(oct) do
for j:=1 to High(oct) do
for k:=1 to High(oct[i,j]) do
begin
oct_new[i,j,k] := oct[i,j,k];
oct_old[i,j,k] := oct[i,j,k];
end;
end;
{алгоритм робертса}
function robert(side:side_position):boolean;
var
a,b,c:real;
i,j:integer;
begin
c:=0;
robert:=true;
for i:=1 to high(side) do
begin
if i=high(side) then j:=1
else j:=i+1;
c:=c+(side[i,1]-side[j,1])*(side[i,2]+side[j,2]);
end;
if c<=0 then robert:=false;
end;
{процедура получения перспективы в одной точке схода}
procedure modif(x,y,z:real;var x1,y1,z1:real);
begin
x1:=x/(p*y+1);
y1:=y/(p*y+1);
z1:=z/(p*y+1);
end;
{прорисовка/стирание октаэдра в зависимости от флага new}
procedure draw_oct(new: boolean;figure:oct_coord);
var
i,j,k:integer;
area: array [1..3] of PointType;
new_side:side_position;
begin
setcolor(0);
for i:=1 to high(oct_new) do
begin
for k:=1 to high(new_side) do
begin
modif(figure[i,k,1], figure[i,k,2], figure[i,k,3],
new_side[k,1],new_side[k,2],new_side[k,3]);
end;
if robert(new_side) then
if new then setFillStyle(solidfill, Color)
else setFillStyle(solidfill, 0);
for j:=1 to High(new_side) do
begin
area
area
.Y := round(new_side[j,2]);
end;
fillpoly(sizeOf(area) div sizeOf(pointtype),area);
end;
end;
{поворот октаэдра}
procedure rotate;
var
i, j: integer;
x_new, z_new: real;
begin
for i:=1 to High(oct_new) do
for j:=1 to High(oct_new[1]) do
begin
oct_old[i,j,1] := oct_new[i,j,1];
oct_old[i,j,3] := oct_new[i,j,3];
x_new:=oct_new[i,j,1]*pcos-oct_new[i,j,3]*psin;
z_new:=oct_new[i,j,1]*psin+oct_new[i,j,3]*pcos;
oct_new[i,j,1]:=x_new;
oct_new[i,j,3]:=z_new;
end;
end;
{основная часть программы}
begin
pcos:=cos(0.05);
psin:=sin(0.05);
dv := detect;
initGraph(dv,mv,'');
init;
repeat
rotate;
draw_oct(false,oct_old);
draw_oct(true,oct_new);
delay(100);
until keypressed;
closegraph;
end.