Нарисовать шестигранную пирамиду в 3d пространстве - Turbo Pascal

Формулировка задачи:

прошу вашей помощи, помогите пожалуйста нарисовать в турбо паскале шестигранную пирамиду в 3d пространстве

Решение задачи: «Нарисовать шестигранную пирамиду в 3d пространстве»

Листинг программы

{$n+}
uses graph;
 
type
  TPoint = record
    X, Y, Z: double;
  end;
  PTArr = ^TArr;
  TArr = array[1 .. pred(maxint div sizeof(TPoint))] of TPoint;
 
const
  R2D = 180 / Pi;
 
const
  rPyrBig   = 50;
  hPyr = 140;
 
 
var
  centerX, centerY: integer;
 
const
  sqrt2 = 1.414213562;
function CoordX(X, Z: double): integer;
begin
  CoordX := trunc((X + CenterX) - Z);
end;
function CoordY(Y, Z: double): integer;
begin
  CoordY := Trunc(CenterY - Y + Z);
end;
 
procedure draw3DPnt(P: TPoint);
var
  NewZ: integer;
begin
  NewZ := trunc(P.Z / sqrt2);
  putpixel( CoordX(P.X, NewZ), CoordY(P.Y, NewZ), White);
end;
 
procedure Draw3DLine(P1, P2: TPoint);
var Z1, Z2: integer;
begin
  Z1 := trunc(P1.Z / sqrt2);
  moveto( CoordX(P1.X, Z1), CoordY(P1.Y, Z1) );
  Z2 := trunc( P2.Z / Sqrt2 );
  lineto( CoordX(P2.X, Z2), CoordY(P2.Y, Z2) );
end;
 
procedure Axis(Color: integer);
begin
  cleardevice;
  setcolor(Color);
  line(1, CenterY, GetMaxX, CenterY);
  line(CenterX, 1, CenterX, GetMaxY);
  line(CenterX - CenterY, GetMaxY,
       CenterX + CenterY, 1);
  setcolor(White);
  rectangle(1, 1, GetMaxX, GetMaxY)
end;
 
procedure Pyramide(R, H, N, color: integer);
var
  curr_angle, DAngle: double;
  below: PTArr;
  i: integer;
const
  P : TPoint = (X:0; Y:0; Z:0);
begin
  getmem(below, N * sizeof(TPoint));
 
  DAngle := (360 div n) / R2D;
  curr_angle := 0.1; i := 0;
  repeat
    inc(i);
    below^[i].X := R*sin(curr_angle);
    below^[i].Z := R*cos(curr_angle);
    below^[i].Y := 0;
    curr_angle := curr_angle + DAngle;
  until i = n;
 
  p.Y := H;
  for i := 1 to n do begin
    if i > 1 then draw3dLine(below^[pred(i)], below^[i]);
    draw3dLine(below^[i], P);
  end;
  draw3dLine(below^[n], below^[1]);
 
  freemem(below, N * sizeof(TPoint));
end;
 
var
  Gd, Gm  : Integer;
 
begin
  Gd:= Detect;
  InitGraph(Gd, Gm, '');
  if GraphResult <> grOk then Halt;
 
  centerx := GetMaxX div 2; centery := GetMaxY div 2;
 
  Axis(Red);
  Pyramide(rPyrBig, hPyr, 6, 15);
 
  ReadLn;
  CloseGraph;
end.

Объяснение кода листинга программы

В начале кода объявляются переменные, включая centerX и centerY для хранения координат центра пирамиды.
Затем определяется тип TPoint с полями X, Y и Z типа double.
Создается массив TArr с использованием функции pred(maxint div sizeof(TPoint)), которая делит максимальное целое число на размер TPoint в байтах и округляет результат вниз до ближайшего целого числа. Это позволяет создать массив TPoint с максимально возможным количеством элементов.
Далее определяются константы R2D, rPyrBig, hPyr и sqrt2.
Затем определяются функции CoordX и CoordY, которые преобразуют координаты точек из мировых координат в экранные координаты.
После этого определяются процедуры draw3DPnt и Draw3DLine, которые рисуют точки и линии в 3D пространстве.
Далее определяется процедура Axis, которая рисует оси координат.
Затем определяется процедура Pyramide, которая рисует пирамиду. Она использует массив ниже для хранения точек пирамиды.
После этого объявляются переменные Gd и Gm для использования функций Detect и InitGraph от библиотеки graph.
Затем вызывается функция Detect для определения доступных графических устройств.
После этого вызывается функция InitGraph с параметрами Gd и Gm, которые используются для создания графика.
Если функция InitGraph не возвращает значение grOk, то программа завершается.
Далее вычисляются координаты центра пирамиды с помощью функций GetMaxX, GetMaxY и div 2.
Затем вызывается процедура Axis с цветом Red для рисования осей координат.
После этого вызывается процедура Pyramide с параметрами rPyrBig, hPyr, 6 и 15, которые определяют размеры и цвет пирамиды.
Наконец, вызывается функция ReadLn для чтения ввода с консоли.
После этого вызывается функция CloseGraph для закрытия графика.