Программа вращения закрашенного октаэдранаTurbo Pascal << На главную или назад  

Задача:написать программу для изображения многогранника, вращающегося вокруг оси оу. ось вращения не должна совпадать с собственной вертикальной осью фигуры.
октаэдр
проекция:перспектива (1 точки схода)
при выполнении этого задания необходимо реализовывать алгоритм удаления невидимых линий. все грани рисовать закрашеными различными цветами.

Октаэдр вращается полкруга нормально,а затем нижняя его часть пропадает,верхняя же вращается как не бывало…кто имеет опыт программирования в этой области,посмотрите,пожалуйста код:

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[i]) 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
begin
if new then
begin
setFillStyle(solidfill, Color[i]);

end
else begin
setFillStyle(solidfill, 0);
end;
for j:=1 to High(new_side) do
begin
area[j].X :=x0+ round(new_side[j,1]);
area[j].Y := round(new_side[j,2]);
end;
fillpoly(sizeOf(area) div sizeOf(pointtype),area);

end;
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(10000);
until keypressed;
closegraph;
end.