program Pyramid;
uses
	Graph;
const
   rPyr = 100;  { Радиус основания пирамиды }
   hPyr = 240;  { Высота пирамиды }
   A 	  = 0;
   B 	  = 1;
   C 	  = 0;
   D 	  = 50;
   n 	  = 7;
   eps  = 0.25; { Погрешность }

type
   TAxis = (axisX, axisY, axisZ, axisT);
   tPoint = record  { Точка }
   case boolean of
     false: (x, y, z: real);
     true : (arr: array[axisX .. axisZ] of real);
   end;
   tLine = record   { Прямая }
     bol, eol: tPoint
   end;
   tPlane = record  { Плоскость }
   case boolean of
     false: (A, B, C, D: real);
     true : (arr: array[TAxis] of real);
   end;
   tTriangle = record  { Плоскость }
     a, b, c: tPoint;
   end;

var
   Gd, Gm: Integer;  { Графика }
   pInt  : tPoint;   { Точка пересечения }
   angle : real;
   plane : tPlane;
   horizontal: Boolean;
   pyr: array[1..n] of tPoint;
   tri: tTriangle;

   CenterX, CenterY: Integer;

function Interception(l: tLine; s: tPlane): boolean;
var
  p: TPoint;
  M, N, t: real;
  ax: TAxis;
begin
   Interception := False;

   M := 0; N := 0;
   for ax := axisX to axisZ do begin
     p.arr[ax] := l.bol.arr[ax] - l.eol.arr[ax];
     M := M + s.arr[ax] * p.arr[ax];
     N := N + s.arr[ax] * l.eol.arr[ax];
   end;
   N := N + s.D+eps;


   if M <> 0 then begin

     if horizontal then t:= N/M
     else t:= -(N)/M;

     if (0 <= t) and (t <= 1) then begin
       Interception := True;
       for ax := axisX to axisZ do
         pInt.arr[ax] := l.eol.arr[ax] +
                         p.arr[ax] * (1 - 2*byte(ax = axisZ)) * t;
     end
   end;
end;

procedure Proection(var p: tPoint); {Проекция (кабинетная)}
const
  k = 2 * 1.4142135623730950488016887242097;
begin
  p.x:= CenterX + p.x + p.y/k;
  p.y:= CenterY + p.z + p.y/k;
end;

procedure DrawAxes(c: integer); {Рисование осей}
const
  indent = 10;
begin
  SetColor(c);
  Line(CenterX, CenterY, GetMaxX, CenterY); {X}
  OutTextXY(GetMaxX - indent, CenterY + indent, 'X');

  Line(CenterX, CenterY, 0, GetMaxY); 	    {Y}
  OutTextXY(0, GetMaxY - 2*indent, 'Y');

  Line(CenterX, CenterY, CenterX, 0);       {Z}
  OutTextXY(CenterX +indent, indent, 'Z');
end;

procedure DrawPyr(r, h, c: integer); {Рисование пирамиды}
var
  angle: real;   {Угол}
  p: tPoint; {Точка}
  i: integer;
begin
  angle:= -pi/3;
  p.x:= Round(r*Cos(0));
  p.y:= Round(r*Sin(0));
  p.z:= 0;
  i:= 1;

  SetColor(c);
  MoveTo(CenterX + Round(p.x), CenterY + Round(p.y));

  while (i <= n) and (angle <= 2*pi) do begin
    p.x:= Round(r*Cos(angle));
    p.y:= Round(r*Sin(angle));
    pyr[i]:= p;
    Proection(p);

    LineTo(Round(p.x), Round(p.y));
    Line(Round(p.x), Round(p.y), CenterX, CenterY - h);
    angle:= angle + pi/3;
    Inc(i);
  end;
  pyr[n].x:= 0; pyr[n].y:= 0; pyr[n].z:= hPyr;
end;

procedure PlaneTri(p: tPlane; t: tTriangle);

var
  count: integer;
  aInt: array[1 .. 3] of tPoint;

  procedure send_data(one, two: TPoint);
  var l: tLine;
  begin
    l.bol := one; l.eol := two;
    if Interception(l, p) then begin
      Inc(count);
      aInt[count] := pInt;
    end;
  end;

begin
   count := 0;
   send_data(t.a, t.b);
   send_data(t.b, t.c);
   send_data(t.a, t.c);

   if count = 2 then begin
     Proection(aInt[1]);
     Proection(aInt[2]);
     SetLineStyle(0, 0, 3);
     SetColor(green);
     Line(Round(aInt[1].x), Round(aInt[1].y),
          Round(aInt[2].x), Round(aInt[2].y));
   end;
end;

procedure GenTri(var t: tTriangle);
var i: integer;
begin
  for i := 1 to n - 1 do begin

    if i = n - 1 then t.c := pyr[1]
    else t.c := pyr[i + 1];
    t.b := pyr[i];
    PlaneTri(plane, t);

  end;
end;

begin
   {Инициализация графики}
      Gd:= Detect;
      InitGraph(Gd, Gm, '');
      if GraphResult <> grOk then Halt;

      CenterX := GetMaxX div 2; CenterY := GetMaxY div 2;

   {Рисование осей}
   	DrawAxes(green);
   {Генерация вершин и рисование пирамиды}
   	DrawPyr(rPyr, hPyr, white);
   {Расчет точек и построение сечения}
      plane.A:= A; plane.B:= B; plane.C:= C; plane.D:= D;
      horizontal:= (plane.A = 0) and (plane.B = 0);
   {Триангуляция основания}
      tri.a.x:= 0; tri.a.y:= 0; tri.a.z:= 0;
      GenTri(tri);
   {Триангуляция боковой поверхности}
      tri.a:= pyr[n];
      GenTri(tri);
   ReadLn;
   CloseGraph;
end.