Показать процесс сортировки

uses crt;
type mas=array [1..30] of integer;
var  a: mas;
  p:integer;
     j: byte;
 
procedure Vvod (var z: mas);
var i:byte;
begin
writeln('сколько чисел будет в массиве?(до 30)');
readln(p);
for i:=1 to p do
begin
writeln('ведите ',i,' елемент');
readln(z[i]);
end;
end;
 
procedure swap(var x,y:integer);         
//процедура для обмена двух элементов
var buf:integer;
begin
  buf:=x;
  x:=y;
  y:=buf;
end;
 
procedure toPyr(var z:mas; r: byte); //p - размерность массива  
//процедура приведения массива к пирамидальному виду (to pyramide)
var i:byte;
begin
  for i:=r div 2 downto 1 do
      begin
      if 2*i<=r then if z[i]<z[2*i] then swap(z[i],z[2*i]);
      if 2*i+1<=r then if z[i]<z[2*i+1] then swap(z[i],z[2*i+1]);
      end;
end;
 
procedure left(var z:mas);  //процедура для сдвига массива влево
var i:byte;
    buf:integer;
begin
  buf:=z[1];
  for i:=1 to p-1 do
      z[i]:=z[i+1];
  z[P]:=buf;
end;
 
begin   //основная программа
Vvod (a);
for j:=1 to p do write(a[j]:3);
writeln;
for j:=p downto 1 do
    begin
    topyr(a,j);
    left(a);
    end;
for j:=1 to p do write(a[j]:3);
writeln;
end.

procedure outmas;
  var
    j:integer;
  begin
    for j:=1 to p do write(a[j]:3);
    writeln;
  end;
begin   //основная программа
Vvod (a);
writeln;
outmas;
for j:=p downto 1 do
    begin
    topyr(a,j);
    left(a);
    outmas;
    end;
outmas;
writeln;
end.