program Pyramid;
uses
	Graph;
const
	rPyr = 75;  {Радиус основания пирамиды}
   hPyr = 240; {Высота пирамиды}
   A 	  = 0;
   B 	  = 1;
   C 	  = 1;
   D 	  = 0;
   n 	  = 7;
type
	tPoint = record  {Точка}
   	x, y, z: real
   end;
   tLine = record   {Прямая}
   	bol, eol: tPoint
   end;
   tPlane = record  {Плоскость}
   	A, B, C, D: real
   end;
   tVector = record {Вектор}
   	x, y, z: real
   end;
var
	Gd, Gm : Integer;  {Графика}
   Radius : Integer;  {Радиус}
   pInt   : tPoint;   {Точка пересечения}
   angle  : real;
   lin	 : tLine;
   plane	 : tPlane;
   pOld	 : tPoint;
   match  : Boolean;
   paral  : Boolean;
   bok	 : Boolean;
   pyr	 : array[1..7] of tPoint;
   i      : integer;
procedure Interception(l: tLine; s: tPlane);
var
	p: tVector;
   M, N, t: real;
begin
   p.x:= l.bol.x - l.eol.x;
   p.y:= l.bol.y - l.eol.y;
   p.z:= l.bol.z - l.eol.z;
   M:= s.A*p.x + s.B*p.y + s.C*p.z;
   N:= s.A*l.bol.x + s.B*l.bol.y + s.C*l.bol.z + s.D;
   if M <> 0 then begin
   	t:= (N)/M;
		pInt.x:= l.bol.x + p.x*t;
		pInt.y:= l.bol.y + p.y*t;
      pInt.z:= -(l.bol.z + p.z*t);
      {
		intercept:= (((pInt.x <= lin.bol.x) and (lin.eol.x <= pInt.x)) or
                  ((pInt.x <= lin.eol.x) and (lin.bol.x <= pInt.x))) and
                  (((pInt.y <= lin.bol.y) and (lin.eol.y <= pInt.y)) or
                  ((pInt.y <= lin.eol.y) and (lin.bol.y <= pInt.y))) and
                  (((pInt.z <= lin.bol.z) and (lin.eol.z <= pInt.z)) or
                  ((pInt.z <= lin.eol.z) and (lin.bol.z <= pInt.z)))
      }
      end
   else if M <> 0 then begin
   	if N = 0 then
      	match:= true
      else
      	paral:= true;
	end;
end;

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

procedure DrawAxes(c: integer); {Рисование осей}
const
	indent = 10;
begin
   SetColor(c);
   Line(GetMaxX div 2, GetMaxY div 2, GetMaxX, GetMaxY div 2); {X}
   OutTextXY(GetMaxX - indent, GetMaxY div 2 + indent, 'X');
   Line(GetMaxX div 2, GetMaxY div 2, 0, GetMaxY); 				{Y}
   OutTextXY(0, GetMaxY - 2*indent, 'Y');
   Line(GetMaxX div 2, GetMaxY div 2, GetMaxX div 2, 0); 		{Z}
   OutTextXY(GetMaxX div 2 +indent, indent, 'Z');
end;

procedure DrawPyr(r, h, c: integer); {Рисование пирамиды}
var
	angle: real;   {Угол}
   p	  : tPoint; {Точка}
begin
	angle:= -pi/3;
   p.x:= Round(r*Cos(0));
   p.y:= Round(r*Sin(0));
   p.z:= 0;
   i:= 1;
   MoveTo(GetMaxX div 2 + Round(p.x), GetMaxY div 2+ 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);
      SetColor(c);
   	LineTo(GetMaxX div 2 + Round(p.x), GetMaxY div 2 + Round(p.y));
      Line(GetMaxX div 2 + Round(p.x), GetMaxY div 2 + Round(p.y), GetMaxX div 2, GetMaxY div 2 - h );
      angle:= angle + pi/3;
      i:= i + 1;
    end;
end;

begin
   {Инициализация графики}
	   Gd:= Detect;
	   InitGraph(Gd, Gm, 'C:\BP\BGI'); { Путь к BGI драйверам }
	   if GraphResult <> grOk then
			Halt;
   {Рисование}
   	DrawAxes(green);
      DrawPyr(rPyr, hPyr, white);
      {Построение линии сечения}
         MoveTo(GetMaxX div 2, GetMaxY div 2 - hPyr);
         plane.A:= A;
         plane.B:= B;
         plane.C:= C;
         plane.D:= D;
         lin.bol.z:= 0;
         lin.eol.z:= 0;
         angle:= -pi/3;
         bok:= true;
         while angle <= 2*pi do begin
            if bok then begin
               lin.eol.x:= 0;
		   	   lin.eol.y:= 0;
         	   lin.eol.z:= hPyr;
               lin.bol.x:= Round(rPyr*Cos(angle));
               lin.bol.y:= Round(rPyr*Sin(angle));
               end
            else begin
            	lin.bol.x:= Round(rPyr*Cos(angle));
		   	   lin.bol.y:= Round(rPyr*Sin(angle));
               lin.eol.x:= Round(rPyr*Cos(angle + pi/3));
               lin.eol.y:= Round(rPyr*Sin(angle + pi/3));
            end;
            	Interception(lin, plane);
               if not paral then begin
            		Proection(pInt);
   	      		LineTo(GetMaxX div 2 + Round(pInt.x), GetMaxY div 2 + Round(pInt.y));
               end;
            angle:= angle + pi/3;
            bok:= succ(bok);
    	   end;
	ReadLn;
	CloseGraph;
end.