Program Oktaedr1;
Uses crt,graph;
Type
  Oktaedr=record { Данные всех точек октаэдра }
    mass1:array [1..10] of record
      x3d,y3d,z3d:real;    { Координаты в трехмерном пространстве }
      x2,y2:integer;       { Новые координаты на экране }
      xold,yold:integer;   { Для стирания старого изображения }
    end;
{ Данные всех граней октаэдра }
    gran:array [1..10] of record
      a,b,c:integer;    { Номера точек }
      cl:integer;       { Цвет }
    end;
    npixel:integer;      { Реально используемое количество точек}
    plosk:integer;       { Реально используемое количество плоскостей }
  end;
  matr=array [1..4,1..4] of real;    { Тип "матрица" для преобразований (4x4) }


const S=200; { сторона октаэдра }

{-----------------------процедура вывода октаэдра на экран }
procedure otobragenie(var f:oktaedr);
var
  n:integer;
  t:array [1..3] of pointtype;
  o,a1,a2,a3,a4:real;
const
  EYEY=350;     { Расстояние до глаза }
  EYEL=200;     { Расстояние до экрана }
begin
  with f do
    for n:=1 to npixel do with mass1[n] do begin
{ Копируем старые значения }
    xold:=x2;yold:=y2;
{ Вычисляем значения координат с учетом положения }
{ Считаем что ось Y - вертикально, X - горизонтально }
{ Вычисляем координаты на экране }
    x2:=trunc(x3d*EYEL/(z3d-EYEY));
    y2:=trunc(y3d*EYEL/(z3d-EYEY));
  end;
{ Удаляем старые данные }
  setcolor(0);
  setfillstyle(1,0);
  with f do for n:=1 to plosk do begin
{размещаем октаэдр посередине экрана }
    t[1].x:=320+mass1[gran[n].a].xold;t[1].y:=240-mass1[gran[n].a].yold;
    t[2].x:=320+mass1[gran[n].b].xold;t[2].y:=240-mass1[gran[n].b].yold;
    t[3].x:=320+mass1[gran[n].c].xold;t[3].y:=240-mass1[gran[n].c].yold;
    fillpoly(3,t);
  end;
{ Рисуем изображение }
  setcolor(0);
  with f do for n:=1 to plosk do begin
    setfillstyle(1,gran[n].cl);
    t[1].x:=320+mass1[gran[n].a].x2;t[1].y:=240-mass1[gran[n].a].y2;
    t[2].x:=320+mass1[gran[n].b].x2;t[2].y:=240-mass1[gran[n].b].y2;
    t[3].x:=320+mass1[gran[n].c].x2;t[3].y:=240-mass1[gran[n].c].y2;
{ Проверяем направление обхода выводимой плоскости и выводим при правильном }
    a1:=t[2].x-t[1].x;
    a2:=t[3].y-t[2].y;
    a3:=t[3].x-t[2].x;
    a4:=t[2].y-t[1].y;
    o:=a1*a2-a3*a4;
    if (o<0) then
      fillpoly(3,t);
  end;
end;

{ Преобразование фигуры в каждом цикле }
procedure preobraz(var f:oktaedr;m:matr);
var
  nx,ny,nz:real;
  n:integer;
begin
{ Просто умножаем каждую точу на матрицу, описывающую изменения }
  for n:=1 to f.npixel do with f.mass1[n] do begin
    nx:=m[1,1]*x3d+m[1,2]*y3d+m[1,3]*z3d+m[1,4];
    ny:=m[2,1]*x3d+m[2,2]*y3d+m[2,3]*z3d+m[2,4];
    nz:=m[3,1]*x3d+m[3,2]*y3d+m[3,3]*z3d+m[3,4];
    x3d:=nx;y3d:=ny;z3d:=nz;
  end;
end;

{ Процедуры работы с матрицами }

{ Создание матрицы смещения }
procedure smeshenie(var mm:matr);
var n,m:integer;
begin
  for n:=1 to 4 do for m:=1 to 4 do
    if (n<>m) then mm[n,m]:=0 else mm[n,m]:=1;
end;

{ Создание матрицы вращения вокруг любой оси координат }
procedure rotate(var m:matr;a:real;n:integer);
var
  ax1,ax2:integer;
begin
  smeshenie(m);
  ax1:=n+1;if ax1=4 then ax1:=1;
  ax2:=ax1+1;if ax2=4 then ax2:=1;
  m[ax1,ax1]:=cos(a);
  m[ax1,ax2]:=-sin(a);
  m[ax2,ax1]:=sin(a);
  m[ax2,ax2]:=cos(a);
end;

{ Переменные программы }
var
  drv,mode:integer;  
  c:char;              { Символ, считанный с клавиатуры }
  fg:oktaedr;          { Данные октаэдра }
  rt:matr;             { Матрица вращения }

begin
{-----Инициализация графики----------}
  drv:=DETECT;
  mode:=VGAHI;
  initgraph(drv,mode,'');
  if (GraphResult=grOk) then
{Если инициализация прошла успешно, рисуем октаэдр}
begin
  with fg do begin
    npixel:=6;
    plosk:=8;
{ Задаем точки }
    mass1[1].x3d:=S;mass1[1].y3d:=0;mass1[1].z3d:=0;
    mass1[2].x3d:=0;mass1[2].y3d:=S;mass1[2].z3d:=0;
    mass1[3].x3d:=-S;mass1[3].y3d:=0;mass1[3].z3d:=0;
    mass1[4].x3d:=0;mass1[4].y3d:=-S;mass1[4].z3d:=0;
    mass1[5].x3d:=0;mass1[5].y3d:=0;mass1[5].z3d:=S;
    mass1[6].x3d:=0;mass1[6].y3d:=0;mass1[6].z3d:=-S;
{ Задаем грани и их цвет}
    with gran[1] do begin a:=1;b:=2;c:=5;cl:=1;end;
    with gran[2] do begin a:=2;b:=3;c:=5;cl:=7;end;
    with gran[3] do begin a:=3;b:=4;c:=5;cl:=2;end;
    with gran[4] do begin a:=4;b:=1;c:=5;cl:=3;end;
    with gran[5] do begin a:=2;b:=1;c:=6;cl:=4;end;
    with gran[6] do begin a:=3;b:=2;c:=6;cl:=5;end;
    with gran[7] do begin a:=4;b:=3;c:=6;cl:=9;end;
    with gran[8] do begin a:=1;b:=4;c:=6;cl:=8;end;
  end;
{ Поворачиваем фигуру, чтобы стояла не вертикально }
  rotate(rt,0.25,1);
  preobraz(fg,rt);
{ Создаем матрицу для вращения вокруг оси Y }
    rotate(rt,0.13,2);
{ Предварительно вычисляем плоские координаты }
    repeat
{ Выводим картинку }
      otobragenie(fg);
      delay(10000);      { Задержка используется для корректного отображения фигуры на экране }
      preobraz(fg,rt);     {Вращаем октаэдр}
      if (keypressed) then begin
        c:=readkey;
      end else c:=' ';
    until c=#27; {Пока не нажата клавиша ?Esc?}
    closegraph;
  end else begin {Выводим сообщение об ошибке инициализации графики}
    writeln;
    writeln('Error initialize !!!');
  end;
end.