Напечатать все элементы дерева Т по уровням: сначала из корня дерева, затем (слева направо) – из вершин, дочерних по отн

program btree;
 
var
  i, E: integer;
 
type
  ref = ^node;
  node = record   
    key, count: integer; 
    left, right: ref;  
  end;
 
procedure Include(x: integer; var p: ref);
begin
  if p = nil then   
  begin{Добавляем вершину}   
    new(p);   
    with p^ do   
    begin
      key := x;    
      count := 1;    
      left := nil;    
      right := nil;   
    end;  
  end
  else  
  begin
    if x = p^.key then  
      {Если число есть в дереве, то увеличиваем счѐтчик}   
      p^.count := p^.count + 1   else   
    if x > p^.key then  {Добавляем в правое поддерево}   
      Include(x, p^.right)      else {Добавляем в левое поддерево}   
      Include(x, p^.left);  
  end; 
end;
 
function compare(i, E: integer; var p: ref): integer;
begin
  if (p = nil) then 
  begin
    i := -1;
    writeln('Длина пути до вершины:', i);
    halt;
  end;
  if (p^.key = E) then 
  begin
    compare := 1; 
    exit;
  end;
  if (p^.key > E) then i := compare(i, E, p^.left)
  else i := compare(i, E, p^.right); //tut
  if (i = -1) then compare := -1
  else compare := i + 1;
end;
 
var
  root: ref;   
  k: integer;
 
begin
  root := nil; 
  i := 0; 
  writeln('Поиск вершины с заданным элементом:');  
  writeln('Введите числа (0 - конец ввода)');  
  read(k);
  while (k <> 0) Do 
  begin
    read(k);     
    Include(k, root);            
  end;
  writeln('Введите число:');  
  readln(E);
  i := compare(i, E, root);   
  writeln(i);
end.

type
  ref = ^node;
  node = record   
    key, count: integer; 
    left, right: ref;  
  end;
 
procedure Include(x: integer; var p: ref);
begin
  if p = nil then   
    begin // Добавляем вершину
      new(p);   
      with p^ do   
        begin
          key := x;    
          count := 1;    
          left := nil;    
          right := nil;   
        end;  
    end
  else
    case Sign(x - p^.key) of
      -1 : Include(x, p^.left);  // x < key -- добавляем в левое поддерево
       0 : p^.count += 1;        // x = key -- увеличиваем счётчик
      +1 : Include(x, p^.right); // x > key -- добавляем в правое поддерево
    end;
end;
 
function compare(E: integer; p: ref; var Length : Integer) : Boolean;
begin
  if p = nil then // Нет такой вершины
    (Result, Length) := (False, -1)
  else
    begin
      Length += 1;
      case Sign(E - p^.key) of
        -1 : Result := compare(E, p^.left, Length);
         0 : Result := True;
        +1 : Result := compare(E, p^.right, Length);
      end;
    end;
end;
 
function PrintLevel(p : ref; Level : Integer) : Boolean;
begin
  if p = nil then
    begin
      Result := False;
      Exit;
    end;
  
  if Level = 0 then
    begin
      Result := True;
      Print(p^.key);
      Exit;
    end;
 
  var(L,R) := (PrintLevel(p^.left, Level-1),PrintLevel(p^.right, Level-1));
  Result := L or R;
end;
 
begin
  var root : ref := nil;
  writeln('Поиск вершины с заданным элементом:');
  writeln('Введите числа (0 - конец ввода)');
  var n : Integer;
  repeat
    n := ReadInteger;
    if n <> 0 then Include(n, root);
  until n = 0;
  
  WriteLn('Поиск заданного числа в дереве:');
  var Length := 0;
  if compare(ReadLnInteger('Введите число:'), root, Length) then
    WriteLn('Длина до вершины с таким элементом = ', Length)
  else
    WriteLn('Такого элемента нет!');
    
  WriteLn('Дерево по уровням:'); var Level := 0;
  while PrintLevel(root, Level) do
    begin
      Level += 1; WriteLn;
    end;
end.

function PrintLevel(p : ref; Level : Integer) : integer;
begin
  if p = nil then Result := 0
  else if Level = 0 then
  begin
    Result := 1;
    Print(p^.key);
  end 
  else result := PrintLevel(p^.left, Level-1) + PrintLevel(p^.right, Level-1); // и никакая "ленивость" компилятора не страшна
end;

while PrintLevel(root, Level) > 0 do