Написать программу вращающейся пирамиды вокруг любой оси - Turbo Pascal

uses crt, graph; {подключение графических модулей}
const rad: real=0.01745329; {коэффициент преобразования градусов в радианы}
type {пользовательский тип "трехмерная"}
d3d=record
x,y,z: real;
end;
var
j: integer; {переменная цикла}
figura:integer;
CodeKey:char;
a1,a2,a3:real;
ErrCode, grMode, grDriver: Integer; {переменные графического драйвера}
const tet: array[1..4] of d3d =
((x:50;y:80;z:50),
(x:50;y:0;z:80),
(x:100;y:0;z:0),
(x:0;y:0;z:0));
{проверка грани на видимость} {a, b, c -координаты грани}
function TestGran(a, b, c: d3d): boolean;
var v1, w2, v2, w1, n: real; {внутренние переменные для построения нормали к грани}
begin
{построение нормали}
v1:=a.x-c.x;
v2:=a.y-c.y;
w1:=b.x-c.x;
w2:=b.y-c.y;
n:=v1*w2-v2*w1; {проверка видимости}
if n>0 then
TestGran:=true {грань видна}
else
TestGran:=false; {грань не видна}
end;
{процедура рисования граней} {p1, p2, p3 - координаты грани}
{col - цвет грани}
procedure DrawGran(p1, p2, p3,p4:d3d; col: byte);
var
zar: array [1..4] of pointtype; {внутренний тип для заливки грани заданным цветом}
begin
if TestGran(p1, p2, p3)=false then exit;
setfillstyle(1, col); {определение типа заполнения }{устанавливает образец штриховки и цвет}
{обработка внутренних переменные для заполнения }
zar[1].x:=round(p1.x+320);
zar[1].y:=round(p1.y+240);
zar[2].x:=round(p2.x+320);
zar[2].y:=round(p2.y+240);
zar[3].x:=round(p3.x+320);
zar[3].y:=round(p3.y+240);
zar[4].x:=round(p4.x+320);
zar[4].y:=round(p4.y+240);
if (zar[1].x=zar[4].x) and (zar[1].y=zar[4].y)
then fillpoly(3, zar) {рисует и штрихует многоугольник}
else fillpoly(4, zar); {заполнить грань заданным цветом}
setfillstyle(1, 0); {определение типа заполнения }
end;
{процедура рисования вектора }
procedure DrawVector;
var i:integer;
begin
if figura =1 then
begin
DrawGran(tet[1],tet[2], tet[3],tet[1], 0);
DrawGran(tet[1],tet[3], tet[4],tet[1], 0);
DrawGran(tet[1],tet[4], tet[2],tet[1], 0);
DrawGran(tet[4],tet[3], tet[2],tet[4], 0);
end;
end;
{процедура поворота точки в трехмерном пространстве}
{xv, yv, zv - углы поворота точки в градусах}
{x, y, z - точка, которую нужно повернуть}
procedure rotate(xv,yv,zv:real; var x,y,z:real);
var Yt,Xt,Zt:real; {временные переменные}
begin
{повернуть по оси y}
Yt:=Y*cos((xv*rad))-Z*sin((xv*rad));
Zt:=Y*sin((xv*rad))+Z*cos((xv*rad));
Y:=Yt; Z:=Zt;
{повернуть по оси x}
Xt:=X*cos((yv*rad))-Z*sin((yv*rad));
Zt:=X*sin((yv*rad))+Z*cos((yv*rad));
X:=Xt; Z:=Zt;
{повернуть по оси z}
Xt:=X*cos((zv*rad))-Y*sin((zv*rad));
Yt:=X*sin((zv*rad))+Y*cos((zv*rad));
X:=Xt; Y:=Yt;
end;
procedure RotateAll;
begin
for j:= 1 to 4 do rotate(a1,a2,a3,tet[j].x,tet[j].y,tet[j].z);
end;
begin
grDriver:= Detect; {инициализация графического режима}
InitGraph(grDriver, grMode,'c:\bp\bgi');
ErrCode:= GraphResult;
figura:=1;
a1:=3;
a2:=4;
a3:=1;
if ErrCode = grOk then
begin {если инициализация успешна, то}
setcolor(15); {установка цвета}
repeat
delay(1);
clearviewport;
DrawVector;
delay(4);
rotateAll;
if keypressed then
begin
a1:=0; {остановка вращения}
CodeKey:=readkey;
end;
{case codekey of
'w':a1:=10.0;
'a':a2:=10.0;
's':a3:=10.0;
'd':a2:=-10.0;
end;}
until CodeKey=#27; {выход по нажатию клавиши Esc}
end;
end.