program Pyramid;
uses
	Graph;
const
	rPyr = 50;  {Радиус основания пирамиды}
   hPyr = 200; {Высота пирамиды}
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;  {Радиус}
   p1, p2  : tPoint;   {Точки}
   pInt    : tPoint;   {Точка пересечения}
   match	  : Boolean;  {Отрезок лежит в плоскости}
   parallel: Boolean;  {Отрезок параллелен плоскости}

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;
      if (t <= 1) and (t >= 0) then begin
		   pInt.x:= l.bol.x + p.x*t;
		   pInt.y:= l.bol.y + p.x*t;
         pInt.z:= l.bol.z + p.z*t;
      end
		end
   else if M <> 0 then begin
   	if N = 0 then
      	match:= true
      else
      	parallel:= 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;
   MoveTo(GetMaxX div 2 + round(p.x), GetMaxY div 2+ round(p.y));
	while angle <= 2*pi do begin
      p.x:= Round(r*cos(angle));
      p.y:= Round(r*sin(angle));
      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;
    end;
end;

begin
   {Инициализация графики}
	   Gd:= Detect;
	   InitGraph(Gd, Gm, 'C:\BP\BGI'); { Путь к BGI драйверам }
	   if GraphResult <> grOk then
			Halt;
   {Рисование}
   	DrawAxes(2);
      DrawPyr(rPyr, hPyr, 15);
	ReadLn;
	CloseGraph;
end.