program bst;(* T.Michalak *);
var tree                                    :tnode;
var son,father                              :node;
var fet                                     :arrayof string;
var horn                                    :arrayof arrayof char;
var rozm,actree,treer,menu,menu2,key,key2,i,x:integer;
var hornod,forest                           :arnode;
var bigi,arsmal                             :arint;
var short,first,bigtree,wyjscie,usa,change  :boolean;
var horbol                                  :arrayof boolean;
var trenam                                  :arrayof char;
 
 unit bold : procedure;
  begin
    write( chr(27), "[1m")
 end bold;
 
 unit reverse : procedure;      (* PROCEDURY PRAWIE GRAFICZNE *)
  begin
    write( chr(27), "[7m")
 end reverse;
 
 unit normal : procedure;
  begin
    write( chr(27), "[0m")
 end normal;
 
 unit newpage : procedure;
  begin
    write( chr(27), "[2J")
 end newpage;
 
 unit  setcursor : procedure(x,y : integer);
    var c,d,e,f  : char,
        i,j : integer;
  begin
    i := x div 10;
    j := x mod 10;
    c := chr(48+i);
    d := chr(48+j);
    i := y div 10;
    j := y mod 10;
    e := chr(48+i);
    f := chr(48+j);
    write( chr(27), "[", c, d, ";", e, f, "H")
 end setcursor;                    (* KONIEC TYCH PROCEDUR ^  *)
 
 
 
 
unit node:class;                (* KLUCZ DRZEWA *)
  var e         :integer;
  var left,right:node;
end node;
 
unit arnode:class;               (* TABLICA DRZEW *)
  var a:arrayof node;
  var p:arrayof boolean
end arnode;
 
unit tnode:class;
  var n:node;
  var p:boolean;
end;
 
unit arint:class;
  var a:arrayof integer
end arint;
 
unit search :class(where:node;what:integer);
            (* ALGORYTM DRZEWA BST *)
 var isit,leftone:boolean;
 begin
  son:=where;
  father:=where;
   do  if son = none orif son.e=what then exit fi;
      father:=son;
      if son.e>what then son:=son.left;
      leftone:=true
      else son:=son.right;
      leftone:=false fi
  od;
  if son =/=none then isit:=true fi;
 end search;
 
 unit member:search function:boolean;
  begin                       (* CZY ELEMENT NA DRZEWIE *)
    result:=isit;
  end member;
 
 unit insert:search procedure;
 var help:node;            (* WSTAWIANIE ELEMENTU *)
  begin
    if member(where,what) then
      if not short then
        writeln("This number is in this tree");
        for i:=1 to 400 do od
      fi;
    else
      if not tree.p then
        where.e:=what;
        tree.p:=true;
      else
           help:=new node;
           help.e:=what;
           if what>father.e then
                     father.right:=help
           else
                     father.left:=help
           fi
      fi
    fi
 end insert;
 
 unit delete:search procedure;   (* KASOWANIE ELEMENTU *)
  var help,fathelp:node;
  begin
   if member(where,what) then
     if son.right=none then
       if son.left=none then
         if father=/=none then
           if leftone then
                 father.left:=none;
                 kill(son);
           else  father.right:=none;
                 kill(son)
           fi
         else
              write("This tree is empty now");
         fi
       else  if leftone then father.left:=son.left;
                             kill(son)
             else father.right:=son.left;
                  kill(son)
             fi
       fi
     else if son.left=none then
                    if leftone then father.left:=son.right;
                             kill(son)
                    else father.right:=son.right;
                             kill(son)
                    fi
          else if son.right.left=none then
                     son.e:=son.right.e;
                     help:=new node;
                     help:=son.right;
                     son.right:=son.right.right;
                     kill(help)
               else help:=new node;
                    fathelp:=new node;
                    help:=son.right.left;
                    while help.left=/= none do
                       fathelp:=help;
                       help:=help.left;
                    od;
                    if help.right=none then son.e:=help.e;
                                            fathelp.left:=none;
                                            kill(help)
                    else fathelp.left:=help.right;
                         son.e:=help.e;
                         kill(help)
                    fi
               fi
          fi
     fi
   else writeln("This number is absent");
        for i:=1 to 1000 do od
   fi
 end delete;
 
 
 
unit howbig:function(klop:node):integer;
  var licz:integer;
 unit intx:procedure(klop:node);
  begin
   if klop<>none then
    call intx(klop.left);
    licz:=licz+1;
    call intx(klop.right);
   fi;
 end intx;
begin
  licz:=0;
  call intx(klop);
  result:=licz;
end howbig;
 
 
unit  wektor:function (where:node;inout k:integer):arint;
var d,i:integer;
 unit infiks:procedure(where:node;tab:arint);
  begin
   if where<>none then
    call infiks(where.left,tab);
    tab.a(k):=where.e;
    k:=k+1;
    call infiks(where.right,tab);
   fi
  end infiks
begin
 d:=howbig(where);
 k:=1;
 result:=new arint;
 array result.a dim(1:d);
 i:=1;
 call infiks(where,result);
 k:=k-1;
end wektor;
 
unit union:procedure(forest:arnode);
var nrt,no,min,roz,lic,small,maks:integer;
 
 
  unit makser:function(k:integer;where:node):integer;
   begin
   while where.right=/=none do
    where:=where.right
   od;
   if k>where.e then result:=k else result:=where.e fi;
  end makser;
 
  unit minimal:function(tbl:arint;output kl:integer):integer;
  var lep:integer;
   begin
    result:=tbl.a(1);
    kl:=1;
    for lep:=2 to lic do
     if result>tbl.a(lep) then result:=tbl.a(lep);kl:=lep fi;
    od;
  end minimal;
 
  unit trawers:coroutine(where:node);
    unit cwalk:procedure(nod:node);
      begin
        if nod=/=none then
          call cwalk(nod.left);
          small:=nod.e;
          detach;
          call cwalk(nod.right);
        fi
    end cwalk;
    var small:integer;
    begin
      return;
      call cwalk(where);
      small:=maks
  end trawers;
 
 var artraw:arrayof trawers;
 
 begin
  lic:=0;
  for i:=1 to upper(horbol) do if horbol(i) then lic:=lic+1 fi od;
  array forest.a  dim(1:lic);
  roz:=1;
  for i:=1 to upper(horbol) do
   if horbol(i) then forest.a(roz):=hornod.a(i);fi;
   roz:=roz+1;
  od;
  roz:=0;
  for i:=1 to lic do
   roz:=roz+howbig(forest.a(i))
  od;
  rozm:=roz;
  bigi:=new arint;
  array bigi.a dim(1:roz);
  array artraw dim(1:lic);
  arsmal:=new arint;
  array arsmal.a dim (1:lic);
  maks:=0;
  for i:=1 to lic do
       artraw(i):=new trawers(forest.a(i));
       maks:=makser(maks,forest.a(i))
  od;
  for i:=1 to lic do attach(artraw(i));arsmal.a(i):=artraw(i).small od;
  min:=arsmal.a(1);
  maks:=maks+1;
  no:=1;
  while min<maks do
   min:=minimal(arsmal,nrt);
   if min<maks then
     bigi.a(no):=min;
     no:=no+1;
     attach(artraw(nrt));
     arsmal.a(nrt):=artraw(nrt).small;
   fi
  od;
end union;
 
unit balance:procedure (inout where:node);
var tab:arint;
var roz:integer;
 unit rozwies:procedure(tabel:arint;a,b:integer);
 begin
  if b-a>0 andif not member(where,tabel.a((a+b) div 2)) then
   call insert(where,tabel.a((a+b) div 2));
   call rozwies(tabel,a,(a+b) div 2);
   call rozwies(tabel,(a+b) div 2,b);
  fi;
 end rozwies;
begin
 if not short then
  tab:=wektor(where,roz);
 else
  tab:=bigi;
  roz:=rozm;
 fi;
 where:=new node;
 tree.p:=false;
 call rozwies(tab,1,roz);
 call insert(where,tab.a(roz));
end balance;
 
unit pisz:procedure(where:node);
var tab:arint;
var i,roz:integer;
begin
tab:=wektor(where,roz);
call setcursor(16,5);
for i:=1 to roz do
 write(tab.a(i):4);
od;
for i:=1 to 500 do od;
end pisz;
 
unit rysuj:procedure(where:node,x:integer,y:integer);
 var i,z,k:integer;
 begin
     call setcursor(x,y-1);
     write("³",where.e:3);
     call setcursor(x,y+3);
     write("³");
     call setcursor(x-1,y-1);
     write("Ú");
     if x=2 then write("ÄÄÄ¿ ") else write("ÄÁÄ¿ ") fi;
     call setcursor(x+1,y-1);
     if where.left=/=none orif where.right=/=none then
              write("ÀÄÂÄÙ")
     else     write("ÀÄÄÄÙ")
     fi;
     z:=(x+2) div 4;
     k:=1;
     for i:=1 to z do k:=2*k od;
     k:=40 div k;
     if x>20 then bigtree:=true fi;
 
     if where.left=/=none andif x<21 then
        for i:=y-k+2 to y do
         call setcursor(x+2,i);
         write("Ä");
        od;
        call setcursor(x+2,y+1);
        if where.right=/=none then write("Á")
        else write("Ù")
        fi;
        call setcursor (x+2,y-k+1);
        write("Ú");
        call rysuj(where.left,x+4,y-k)
     fi;
     if where.right=/=none andif x<17 then
        for i:=y+2 to y+k do
         call setcursor(x+2,i);
         write("Ä");
        od;
        write("¿");
        if where.left=none then
           call setcursor(x+2,y+1);
           write("À")
        fi;
        call rysuj(where.right,x+4,y+k)
     fi;
 
end rysuj;
 
 
unit newtree:procedure;
 var name  :arrayof char;
 var art   :arrayof arrayof char;
 
 unit readstring:function:arrayof char;
  var i,c  :integer;
  var klap :boolean;
  var pod  :arrayof char;
  begin
   call setcursor(17,10);
   array pod dim (1:8);
   klap:=true;
   result:=pod;
   for i:=1 to 8 do
     while c=0 and klap do
         c:=inkeys
     od;
     if c=13 then klap:=false fi;
     if klap then result(i):=chr(c);
       c:=0;write(result(i)) else result(i):=' ' fi;
   od;
  end readstring;
 
 begin
   call setcursor(15,4);
   writeln("Give name of a new tree");
   call setcursor(16,6);
   name:=readstring;
   if treer>1 then
     hornod.a(actree):=tree.n;
     hornod.p(actree):=tree.p;
     forest.a:=copy (hornod.a);
     forest.p:=copy (hornod.p);
     array hornod.a dim(1:treer);
     array hornod.p dim(1:treer);
     for i:=1 to treer-1 do
       hornod.a(i):=copy (forest.a(i));
       hornod.p(i):=forest.p(i);
     od
   else
         array hornod.a dim(1:1);
         array hornod.p dim(1:1);
   fi;
   hornod.a(treer):=new node;
   art:=copy (horn);
   actree:=treer;
   array horn dim(1:treer+1);
   for i:=1 to treer-1 do
     horn(i):=copy (art(i))
   od;
   horn(treer):=name;
   treer:=treer+1;
   horn(treer):=art(treer-1);
   tree.n:=hornod.a(treer-1);
   tree.p:=false;
   trenam:=name;
   first:=true;
end newtree;
 
 
unit actual:procedure;
 begin
    call setcursor(1,62);
    writeln("ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ");
    call setcursor(2,62);
    write  ("³  ACTUAL TREE  ³Û ");
    call setcursor(3,62);
    write ("³   ");
    call bold;
    if treer=/=1 then
           for i:=1 to 8 do
            write (trenam(i))
          od
    else write("        ") fi;
    call normal;
    write("    ³Û ");
    call setcursor(4,62);
    writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ ");
    call setcursor(5,62);
    writeln(" ßßßßßßßßßßßßßßßßß ");
end actual;
 
unit border:procedure;
  begin
    call normal;
    call newpage;
    call setcursor(1,1);
    writeln("ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ");
    write("³ ");
    call reverse;
    write(fet(1):8);
    call normal;
    writeln("  ³Û ");
    for i:=2 to 10 do
     writeln("³ ",fet(i):8,"  ³Û ")
    od;
    writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÙÛ ");
    writeln(" ßßßßßßßßßßßßß ");
    call actual;
end border;
 
 
unit border2:procedure;
  var z:integer;
begin
    call normal;
    call setcursor(5,7);
    writeln("ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ");
    call setcursor(6,7);
    write("³ ");
    call reverse;
    for i:=1 to 8 do
      write (horn(1,i))
     od;
    call normal;
    writeln("  ³Û ");
    for z:=2 to treer do
     call setcursor(5+z,7);
     write("³ ");
     for i:=1 to 8 do
      write (horn(z,i))
     od;
     write("  ³Û ")
    od;
    call setcursor(6+treer,7);
    writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÙÛ ");
    call setcursor(7+treer,7);
    writeln(" ßßßßßßßßßßßßß ");
end border2;
 
unit number:procedure;
 begin
 call setcursor(18,2);
 writeln("Give the number  ");
 call setcursor(19,6);
 read(x);
end;
 
unit clear:procedure;
  begin
  call setcursor(18,2);
  writeln("                                          ");
  writeln("                                          ");
end clear;
 
unit inkeys:IIuwgraph function:integer;
  begin
    result:=inkey;
end inkeys;
 
unit fmenu: procedure;
  unit move:procedure(s1,s2,f1,f2:integer);
   begin
          call setcursor(s1,3);
          write(fet(f1):8);
          call reverse;
          call setcursor(s2,3);
          write(fet(f2):8);
          call normal
  end move;
 begin
 call normal;
 while key=/=13 do
   do key:=inkeys;
      if key=13 orif key=-72 orif key=-80 then exit fi;
   od;
   if key=-72 then
      if menu>1  then menu:=menu-1;
                call move(menu+2,menu+1,menu+1,menu)
      else menu:=10;
           call move(2,11,1,10)
      fi
   fi;
 
   if key=-80 then
      if menu<10  then menu:=menu+1;
                 call move(menu,menu+1,menu-1,menu)
      else menu:=1;
            call move(11,2,10,1)
      fi
   fi
 od
end fmenu;
 
 
unit fmenu2: procedure;
  unit move2:procedure(x1,x2,y:integer);
    begin
        call setcursor(x1,y);
        for i:=1 to 8 do
              write (horn(x2,i))
        od;
        call normal;
  end move2;
 begin
 array horbol dim (1:treer-1);
 for i:=1 to treer-1 do
   horbol(i):=false
 od;
 call normal;
 if treer=1 then
  call setcursor(10,15);
 writeln("You haven't tree");
 for i:=1 to 1000 do od else
 while menu2=/=treer do
  while key2=/=13 do
   do key2:=inkeys;
      if key2=13 orif key2=-72 orif key2=-80 then exit fi;
   od;
   if key2=-72 then
      if menu2>1  then menu2:=menu2-1;
                 if horbol(menu2+1) then call bold fi;
                 call move2(menu2+6,menu2+1,9);
                 call reverse;
                 call move2(menu2+5,menu2,9)
      else menu2:=treer;
           if horbol(1) then call bold fi;
           call move2(6,1,9);
           call reverse;
           call move2(treer+5,treer,9)
      fi
   fi;
 
   if key2=-80 then
      if menu2<treer  then menu2:=menu2+1;
                 if horbol(menu2-1) then call bold fi;
                 call move2(menu2+4,menu2-1,9);
                 call reverse;
                 call move2(menu2+5,menu2,9)
      else menu2:=1;
           if horbol(treer) then call bold fi;
           call move2(treer+5,treer,9);
           call reverse;
           call move2(6,1,9)
      fi
   fi
  od;
  if menu2=treer orif not usa then
       if change and menu2=/=treer then
         hornod.a(actree):=tree.n;
         hornod.p(actree):=tree.p;
         actree:=menu2;
         tree.p:=hornod.p(menu2);
         tree.n:=hornod.a(menu2);
         trenam:=horn(menu2);
         change:=false
       fi;
       call setcursor(3,64);
       call bold;
       for i:=1 to 8 do
          write (trenam(i))
       od;
       exit
  else
       if horbol(menu2) then horbol(menu2):=false;
       call reverse
       else call normal;
            call bold;
            horbol(menu2):=true
       fi;
       call move2(menu2+5,menu2,9);
       call normal;
  fi;
  call normal;
  key2:=1
 od
fi;
end fmenu2;
 
    unit WAITforKEY: procedure;
    begin
          while  inkeys=0 do   od;
    end WAITforKEY
 
 
begin
    hornod:=new arnode;
    forest:=new arnode;
    tree:=new tnode;
    first:=true;
    array fet dim(1:10);
    array horn dim(1:1);
    array horn(1) dim(1:8);
    fet(1):="INSERT  ";
    fet(2):="DELETE  ";
    fet(3):="MEMBER  ";
    fet(4):="DRAW    ";
    fet(5):="BALANCE ";
    fet(6):="UNION   ";
    fet(7):="WRITE   ";
    fet(8):="NEW TREE";
    fet(9):="CHANGE  ";
    fet(10):="QUIT    ";
 
    horn(1,1):='E';
    horn(1,2):='X';
    horn(1,3):='I';
    horn(1,4):='T';
    for x:=5 to 8 do horn(1,x):=' ' od;
    treer:=1;
    array horbol dim(1:1);
    menu:=1;
    usa:=false;
    call SetCursor(5,10);
 
    do
        call border;
        call fmenu;
 
        case menu
        when 1: if treer=/=1 then
                   call number;
                   call insert(tree.n,x);
                 else
                    call setcursor(17,1);
                    writeln("You haven't tree");
                  fi;
                  key:=1;
 
         when 2:if treer=/=1 then
                   if not tree.p then
                      call setcursor(17,1);
                      write("This tree is empty");
                   else
                      call number;
                      call delete(tree.n,x);
                   fi
                 else
                      call setcursor(17,1);
                      writeln("You haven't tree");
                  fi;
 
 
           when 3:if treer=/=1 then
                      if not tree.p then
                            call setcursor(17,1);
                            write("This tree is empty");
                       else
                             call number;
                             wyjscie:=member(tree.n,x);
                             if wyjscie
                             then
                                 write( "  This number is present ")
                             else
                                  write("  This number is absent")
                             fi;
 
                        fi
                   else
                        call setcursor(17,1);
                        writeln("You haven't tree");
                   fi;
 
 
           when 4:if treer=/=1 then
 
                      if not tree.p then
                            call setcursor(17,1);
                            write("This tree is empty")
                      else
                            call newpage;
                            call actual;
                            bigtree:=false;
                            call rysuj(tree.n,2,40);
                            call setcursor(22,40);
                            if bigtree then
                                writeln("Tree to big")
                            fi;
                            writeln("press any key");
                            menu:=1;
                       fi
                   else
                       call setcursor(17,1);
                       writeln("You haven't tree");
                   fi;
 
                  key:=1;
 
 
            when 5:if treer=/=1 then
                       if not tree.p then
                            call setcursor(17,1);
                            write("This tree is empty");
                       else
                            call balance(tree.n);
                       fi;
                   else
                        call setcursor(17,1);
                        writeln("You haven't tree");
                   fi;
 
 
             when 6:if treer=/=1 then
                        usa:=true;
                        menu2:=1;key2:=1;
                        call border2;
                        call fmenu2;
                        short:=true;
                        call union(forest);
                        call newtree;
                        call balance(tree.n);
                        short:=false;
                        usa:=false;
                     else
                        call setcursor(17,1);
                        writeln("You haven't tree");
 
                     fi;
 
 
              when 7:if treer<>1 then
                         if not tree.p then
                               call setcursor(17,1);
                               write("This tree is empty");
                          else
                                call pisz(tree.n);
                          fi
                      else
                           call setcursor(17,1);
                           writeln("You haven't tree");
                      fi;
 
 
               when 8: call newtree;
 
 
               when 9: if treer<>1
                       then
                            change:=true;
                            menu2:=1;key2:=1;
                            call border2;
                            call fmenu2;
                            call border;
                        else
                             call setcursor(17,1);
                             writeln("You haven't tree");
                         fi;
 
 
                when 10: call endrun;
 
          esac ;
          call SetCursor(22,40);
          write("press any key");
          call WaitForKey;
          call SetCursor(22,40);
          write("                       ");
          call SetCursor(17,1);
          write("                                                       ");
          menu:=1;
          key:=1;
       od;
 
end bst.