RAWMIND

uses crt,graph;
const
  S=80; { размер стороны}
  ntck=8; { количество точек}
  nlin=6; { количество граней}
  EYEY=300;	 { расстояние до глаза}
  EYEL=200;	 { расстояние до экрана  }

type
  figura=record
{ Точки }
	tck:array [1..ntck] of record
	  x3,y3,z3:real;	{ Координаты 3D }
	  x2,y2:integer;	{ Координаты 2D }
	end;
{ Грани }
	lin:array [1..nlin] of record
	  a,b,c,d:integer;  { номера точек из tck }
	  cl:integer;	   { цвет }
	end;
  end;
  matr=array [1..4,1..4] of real;	   { тип «матрица»для преобразований }

{ выводим фигуру на экран }
procedure output(var f:figura);
var n:integer;
  t:array [1..5] of pointtype;
  cenX, cenY: integer;
begin
  cenX:= GetMaxX div 2;
  cenY:= GetMaxY div 2;
  SetLineStyle( 2, 0, 1);
  
  for n:=1 to ntck do with f.tck[n] do begin
{ приводим 3D к 2D }
	x2:=trunc(x3*EYEL/(z3-EYEY));
	y2:=trunc(y3*EYEL/(z3-EYEY));
  end;
{ просто закрашиваем старый экран }
  SetFillStyle(SolidFill, black);
  bar( 0,0, GetMaxX, GetMaxY);

  with f do for n:=1 to nlin do begin
	setfillstyle(1,lin[n].cl);
	t[1].x:=cenX+tck[lin[n].a].x2; t[1].y:=cenY-tck[lin[n].a].y2;
	t[2].x:=cenX+tck[lin[n].b].x2; t[2].y:=cenY-tck[lin[n].b].y2;
	t[3].x:=cenX+tck[lin[n].c].x2; t[3].y:=cenY-tck[lin[n].c].y2;
	t[4].x:=cenX+tck[lin[n].d].x2; t[4].y:=cenY-tck[lin[n].d].y2;
	t[5]:=t[1];

	SetColor(lin[n].cl);
	DrawPoly( 5, t);
  end;
end;

{преобразование фигуры в каждом цикле}
procedure prc(var f:figura;m:matr);
var
  nx,ny,nz:real;
  n:integer;
begin
{ просто умножаем каждую точку на матрицу, описываем изменения }
  for n:=1 to ntck do with f.tck[n] do begin
	nx:=m[1,1]*x3+m[1,2]*y3+m[1,3]*z3+m[1,4];
	ny:=m[2,1]*x3+m[2,2]*y3+m[2,3]*z3+m[2,4];
	nz:=m[3,1]*x3+m[3,2]*y3+m[3,3]*z3+m[3,4];
	x3:=nx;y3:=ny;z3:=nz;
  end;
end;

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

{ создание матрицы смещения}
procedure one(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 rot3(var m:matr;a:real;n:integer);
var
  ax1,ax2:integer;
begin
  one(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;	{для Initgraph }
  c:char;			  { считынный с клавиатуры }
  fg:figura;		   { данные фигуры }
  rt:matr;			 { матрица преобразования (вращения) }

begin
  drv:=DETECT;
  mode:=VGAHI;
  initgraph(drv,mode,'..\bgi');
  if (GraphResult=grOk) then begin
{ создаем фигуру }
  with fg do begin
{ создаем точки }
	tck[1].x3:=-S; tck[1].y3:=-S; tck[1].z3:=-S;
	tck[2].x3:=-S; tck[2].y3:=S; tck[2].z3:=-S;
	tck[3].x3:=S; tck[3].y3:=S; tck[3].z3:=-S;
	tck[4].x3:=S; tck[4].y3:=-S; tck[4].z3:=-S;
	tck[5].x3:=-S; tck[5].y3:=-S; tck[5].z3:=S;
	tck[6].x3:=-S; tck[6].y3:=S; tck[6].z3:=S;
	tck[7].x3:=S; tck[7].y3:=S; tck[7].z3:=S;
	tck[8].x3:=S; tck[8].y3:=-S; tck[8].z3:=S;
{ создаем плоскости и цвет }
	with lin[1] do begin a:=1;b:=2;c:=3;d:=4; cl:=red;end;
	with lin[2] do begin a:=1;b:=2;c:=6;d:=5; cl:=yellow;end;
	with lin[3] do begin a:=5;b:=6;c:=7;d:=8; cl:=green;end;
	with lin[4] do begin a:=8;b:=7;c:=3;d:=4; cl:=blue;end;
	with lin[5] do begin a:=1;b:=5;c:=8;d:=4; cl:=white;end;
	with lin[6] do begin a:=2;b:=6;c:=7;d:=3; cl:=magenta;end;

  end;
{ Поворачиваем фигуру, чтобы стояла не вертикально }
  rot3(rt,0.4,1);
  prc(fg,rt);
{ создаем матрицу для вращения вокруг оси Y }
	rot3(rt,0.01,2);
{ предварительно вычисляем плоские координаты}
	repeat
{ ‚выводим картинку }
	  output(fg);
	  delay(2000);	  {ждем некоторое время }
	  prc(fg,rt);	 { Преобразовываем (вращаем) }
	  if (keypressed) then begin
		c:=readkey;
	  end else c:=' ';
	until c=#27;
	closegraph;
  end else begin
	writeln;
	writeln(' Cannot initialize GRAPH');
  end;
end.