program der(input,output);
uses crt;
Type sn=record s:string[6];
                  w:integer
                  end;
        Ta=array [1..1000] of sn;
        pzv=^zv;
        zv=record sl:string[6];
                left,right:pzv
                end;

var k,l,z,i,x,c,h,n,t,d:integer;
        A:TA;
        verch:pzv;
        m,b:boolean;
        p,v:string;
        q,vih:char;
{----------------------------------------------------------------------------}
procedure inder(k:sn; var d:pzv);
var r,s:pzv;
        begin
        new(s);
        s^.sl:=k.s;
        r:=d;
        if (r^.left=nil) and (r^.right=nil) then
                begin
                r^.sl:=k.s;
                r^.left:=nil;
                r^.right:=nil
                end
        else
                begin
                if r^.left^.sl<k.s then r:=r^.right else r:=r^.left;
                inder(k,r)
                end;
        end;
{----------------------------------------------------------------------------}
procedure sepsl;
var i:boolean;
     begin
     read(q);
     while (ord(q)<>44) and (ord(q)<>46) and m do
           begin
           if (q<'a') or (q>'z') then i:=false
           else
               begin
               v:=v+q;
               read(q);
               t:=t+1
               end;
           if (not i) or (t>6) then m:=false
           end
     end;
{----------------------------------------------------------------------------}
procedure sortir(var A:Ta);
var i,k:integer;
    t:sn;
        begin
        for i:=1 to n do
                begin
                for k:=i to n do
                        begin
                        if (a[k].w<a[i].w) or (a[k].w=a[i].w) and (a[k].s<a[i].s) then
                                begin
                                t:=A[i];
                                a[i]:=a[k];
                                a[k]:=t
                                end
                        end
                end
        end;
{----------------------------------------------------------------------------}
procedure delder (var d:pzv);
var q:pzv;
        begin
        while (d^.left<>nil) or (d^.right<>nil) do
                begin
                q:=d;
                while (q^.left<>nil) and (q^.right<>nil) do
                        if q^.left=nil then q:=q^.right else q:=q^.left;
                dispose (q)
                end
        end;
{---------------------------------------------------------------------------}
begin clrscr;
repeat
        writeln ('This program is sorting inputtation string[6] alphabetically and');
        writeln ('             outputting it as a tree');
        m:=true;
        n:=1;
        writeln ('    Input string');
        q:=' ';
        while q<>'.' do
                begin
                v:='';
                t:=0;
                sepsl;
                if m or (t<>0) then
                         begin
                         a[n].s:=v;
                         a[n].w:=t;
                         n:=n+1
                         end
                     end;
        readln;
        writeln('   Inputting is finished');
        if m then for i:=1 to n-1 do
                begin
                sortir(A);
                end;
        readln;
        if m then
                begin
                writeln ('      outputting as a list:');
                writeln;
                for i:=1 to n do write (a[i].s,' ');
                writeln;
                writeln;
                writeln('       Outputting is finished');
                readln;
                new(verch);
                writeln('   It is a thee from inputtation string:');
                writeln;
                l:=2;
                verch^.sl:=a[n div L +1].s;
                verch^.right:=nil;
                verch^.left:=nil;
                z:=0;
                c:=2;
                while n>=c do
                        begin
                        inc(z);
                        c:=2*c
                        end;
                for x:=1 to z do write('    ');
                write('   ');
                write (a[n div L +1].s);
                a[n div L +1].s:='';
                writeln;
                L:=L*2;
                h:=0;
                while n div l>=1 do
                        begin
                        write ('  ');
                        h:=h+1;
                        inder(a[(N DIV L +1)*i],verch);
                        if h<z then for x:=1 to (z - h) do write('    ');
                        for x:=1 to l div 2 do
                                begin
                                write(a[((N*(2*x-1)) DIV L)+1].s);
                                for c:=1 to z-h do write('    ');
                                a[((N*(2*x-1)) DIV L)+1].s:=''
                                end;
                        writeln;
                        L:=L*2;
                        end;
                l:=l div 2;
                for i:=1 to n do
                        if a[i].s<>'' then
                                begin
                                inder(a[(N DIV L)*i],verch);
                                write (a[(N DIV L)*i].s,'  ');
                                end
                        else write ('  ');
                writeln;
                writeln;
                writeln('       Outputting is finished');
                delder(verch);
                dispose (verch);
                writeln
                end
        else writeln ('      Inputation is incorrect!!');
writeln ('Do you want to continue computations? ');
writeln ('0-no, others-yes');
readln (vih);
until vih='0';
writeln ('Thank you for using my programm!');
readln
end.
