Jopa balanced by Bel feat Andrew

program exam4;

type
  tp=^tprec;
  tprec=record
    inf:integer;
    next:tp
   end;
  tree=^treerec;
  treerec=record
    inf:integer;
    left:tree;
    right:tree;
   end;

var genroot:tree;
    genfirst:tp;
    temp:tp;
    listlen:integer;
    q:boolean;
    f:text;


procedure create_sortlist(var first:tp; inp:string);
var p,q:tp; c:integer; f:text;
  begin
    assign(f,inp);
    reset(f);
    new(p);
    p^.next:=nil;
    read(f,p^.inf);
    first:=p;
    while not eof(f) do
      begin
        read(f,c);
        p:=first;
        if (p^.next<>nil) and (c>first^.inf)
         then
           begin
             while not((c>p^.inf)and(c<=p^.next^.inf)) and (p^.next<>nil) do
              p:=p^.next;
              q:=p^.next;
              new(p^.next);
              p:=p^.next;
              p^.inf:=c;
              p^.next:=q
           end
         else if c<p^.inf
               then
                 begin
                   new(first);
                   first^.inf:=c;
                   first^.next:=p
                 end
               else
                 begin
                   q:=p^.next;
                   new(p^.next);
                   p:=p^.next;
                   p^.inf:=c;
                   p^.next:=q
                 end
      end;
    close(f)
  end;

procedure output_list(first:tp; out: string);
var p:tp; f:text;
  begin
    assign(f,out);
    rewrite(f);
    p:=first;
    while p<>nil do
      begin
        write(f,p^.inf,' ');
        p:=p^.next
      end;
    close(f)
  end;

procedure CreateTree(var parent:tree;k,l:integer;q:boolean;lf:boolean);
var o,i:integer;
    m:integer;
    temp:tp;
begin
     m:=0;
     if (k = l) and not q then exit;
     if (l-k<2) then
     begin
         if q then
         begin
           if k = 1 then o:=1 else
           if l = listlen then o:=l else exit
         end else
         begin
         if l = listlen then o:=l else
         if k = 1 then o:=1 else exit;
         end;
     end else
     begin
         if lf then
            o := (k+l) div 2
         else
             o:=(k+l+1) div 2;
     end;
     temp:=genfirst;
     for i:=2 to o do
         temp:=temp^.next;
     if q then
     begin
          parent^.inf :=  temp^.inf;
          parent^.left:=nil;
          parent^.right:=nil;
          CreateTree(parent,k,o,false,true);
          CreateTree(parent,o,l,false,false);
          q:=false;
     end else
     begin
         if (parent^.inf>temp^.inf) then
         begin
             new(parent^.left);
             parent^.left^.left:=nil;
             parent^.left^.right:=nil;
             parent^.left^.inf := temp^.inf;
             if (o = 1)or(o=listlen) then exit;
             CreateTree(parent^.left,k,o,false,true);
             CreateTree(parent^.left,o,l,false,false);
         end else
         begin

             new(parent^.right);
             parent^.right^.left:=nil;
             parent^.right^.right:=nil;
             parent^.right^.inf := temp^.inf;
             if (o = 1)or(o=listlen) then exit;
             CreateTree(parent^.right,k,o,false,true);
             CreateTree(parent^.right,o,l,false,false);
         end;
     end;
end;

procedure OutputTree(parent:tree);
begin
    if parent^.left<>nil then OutputTree(parent^.left);
    write(f,parent^.inf,' ');
    if parent^.right<>nil then OutputTree(parent^.right);
end;


begin
  create_sortlist(genfirst,'input4.inp');
  output_list(genfirst,'output4.out');

  temp:=genfirst;
  listlen:=0;
  while temp <> nil do
  begin
        temp:=temp^.next;
        inc(listlen);
  end;

  new(genroot);
  q:=true;
  CreateTree(genroot,1,listlen,q,true);

  assign(f,'output4.out');
  append(f);
  writeln(f);
  OutputTree(genroot);
  close(f)
end.