examples/data_str/bst.log

   1 program bst;(* T.Michalak *);\r
   2 var tree                                    :tnode;\r
   3 var son,father                              :node;\r
   4 var fet                                     :arrayof string;\r
   5 var horn                                    :arrayof arrayof char;\r
   6 var rozm,actree,treer,menu,menu2,key,key2,i,x:integer;\r
   7 var hornod,forest                           :arnode;\r
   8 var bigi,arsmal                             :arint;\r
   9 var short,first,bigtree,wyjscie,usa,change  :boolean;\r
  10 var horbol                                  :arrayof boolean;\r
  11 var trenam                                  :arrayof char;\r
  12  \r
  13  unit bold : procedure;\r
  14   begin\r
  15     write( chr(27), "[1m")\r
  16  end bold;\r
  17  \r
  18  unit reverse : procedure;      (* PROCEDURY PRAWIE GRAFICZNE *)\r
  19   begin\r
  20     write( chr(27), "[7m")\r
  21  end reverse;\r
  22  \r
  23  unit normal : procedure;\r
  24   begin\r
  25     write( chr(27), "[0m")\r
  26  end normal;\r
  27  \r
  28  unit newpage : procedure;\r
  29   begin\r
  30     write( chr(27), "[2J")\r
  31  end newpage;\r
  32  \r
  33  unit  setcursor : procedure(x,y : integer);\r
  34     var c,d,e,f  : char,\r
  35         i,j : integer;\r
  36   begin\r
  37     i := x div 10;\r
  38     j := x mod 10;\r
  39     c := chr(48+i);\r
  40     d := chr(48+j);\r
  41     i := y div 10;\r
  42     j := y mod 10;\r
  43     e := chr(48+i);\r
  44     f := chr(48+j);\r
  45     write( chr(27), "[", c, d, ";", e, f, "H")\r
  46  end setcursor;                    (* KONIEC TYCH PROCEDUR ^  *)\r
  47  \r
  48  \r
  49  \r
  50  \r
  51 unit node:class;                (* KLUCZ DRZEWA *)\r
  52   var e         :integer;\r
  53   var left,right:node;\r
  54 end node;\r
  55  \r
  56 unit arnode:class;               (* TABLICA DRZEW *)\r
  57   var a:arrayof node;\r
  58   var p:arrayof boolean\r
  59 end arnode;\r
  60  \r
  61 unit tnode:class;\r
  62   var n:node;\r
  63   var p:boolean;\r
  64 end;\r
  65  \r
  66 unit arint:class;\r
  67   var a:arrayof integer\r
  68 end arint;\r
  69  \r
  70 unit search :class(where:node;what:integer);\r
  71             (* ALGORYTM DRZEWA BST *)\r
  72  var isit,leftone:boolean;\r
  73  begin\r
  74   son:=where;\r
  75   father:=where;\r
  76    do  if son = none orif son.e=what then exit fi;\r
  77       father:=son;\r
  78       if son.e>what then son:=son.left;\r
  79       leftone:=true\r
  80       else son:=son.right;\r
  81       leftone:=false fi\r
  82   od;\r
  83   if son =/=none then isit:=true fi;\r
  84  end search;\r
  85  \r
  86  unit member:search function:boolean;\r
  87   begin                       (* CZY ELEMENT NA DRZEWIE *)\r
  88     result:=isit;\r
  89   end member;\r
  90  \r
  91  unit insert:search procedure;\r
  92  var help:node;            (* WSTAWIANIE ELEMENTU *)\r
  93   begin\r
  94     if member(where,what) then\r
  95       if not short then\r
  96         writeln("This number is in this tree");\r
  97         for i:=1 to 400 do od\r
  98       fi;\r
  99     else\r
 100       if not tree.p then\r
 101         where.e:=what;\r
 102         tree.p:=true;\r
 103       else\r
 104            help:=new node;\r
 105            help.e:=what;\r
 106            if what>father.e then\r
 107                      father.right:=help\r
 108            else\r
 109                      father.left:=help\r
 110            fi\r
 111       fi\r
 112     fi\r
 113  end insert;\r
 114  \r
 115  unit delete:search procedure;   (* KASOWANIE ELEMENTU *)\r
 116   var help,fathelp:node;\r
 117   begin\r
 118    if member(where,what) then\r
 119      if son.right=none then\r
 120        if son.left=none then\r
 121          if father=/=none then\r
 122            if leftone then\r
 123                  father.left:=none;\r
 124                  kill(son);\r
 125            else  father.right:=none;\r
 126                  kill(son)\r
 127            fi\r
 128          else\r
 129               write("This tree is empty now");\r
 130          fi\r
 131        else  if leftone then father.left:=son.left;\r
 132                              kill(son)\r
 133              else father.right:=son.left;\r
 134                   kill(son)\r
 135              fi\r
 136        fi\r
 137      else if son.left=none then\r
 138                     if leftone then father.left:=son.right;\r
 139                              kill(son)\r
 140                     else father.right:=son.right;\r
 141                              kill(son)\r
 142                     fi\r
 143           else if son.right.left=none then\r
 144                      son.e:=son.right.e;\r
 145                      help:=new node;\r
 146                      help:=son.right;\r
 147                      son.right:=son.right.right;\r
 148                      kill(help)\r
 149                else help:=new node;\r
 150                     fathelp:=new node;\r
 151                     help:=son.right.left;\r
 152                     while help.left=/= none do\r
 153                        fathelp:=help;\r
 154                        help:=help.left;\r
 155                     od;\r
 156                     if help.right=none then son.e:=help.e;\r
 157                                             fathelp.left:=none;\r
 158                                             kill(help)\r
 159                     else fathelp.left:=help.right;\r
 160                          son.e:=help.e;\r
 161                          kill(help)\r
 162                     fi\r
 163                fi\r
 164           fi\r
 165      fi\r
 166    else writeln("This number is absent");\r
 167         for i:=1 to 1000 do od\r
 168    fi\r
 169  end delete;\r
 170  \r
 171  \r
 172  \r
 173 unit howbig:function(klop:node):integer;\r
 174   var licz:integer;\r
 175  unit intx:procedure(klop:node);\r
 176   begin\r
 177    if klop<>none then\r
 178     call intx(klop.left);\r
 179     licz:=licz+1;\r
 180     call intx(klop.right);\r
 181    fi;\r
 182  end intx;\r
 183 begin\r
 184   licz:=0;\r
 185   call intx(klop);\r
 186   result:=licz;\r
 187 end howbig;\r
 188  \r
 189  \r
 190 unit  wektor:function (where:node;inout k:integer):arint;\r
 191 var d,i:integer;\r
 192  unit infiks:procedure(where:node;tab:arint);\r
 193   begin\r
 194    if where<>none then\r
 195     call infiks(where.left,tab);\r
 196     tab.a(k):=where.e;\r
 197     k:=k+1;\r
 198     call infiks(where.right,tab);\r
 199    fi\r
 200   end infiks\r
 201 begin\r
 202  d:=howbig(where);\r
 203  k:=1;\r
 204  result:=new arint;\r
 205  array result.a dim(1:d);\r
 206  i:=1;\r
 207  call infiks(where,result);\r
 208  k:=k-1;\r
 209 end wektor;\r
 210  \r
 211 unit union:procedure(forest:arnode);\r
 212 var nrt,no,min,roz,lic,small,maks:integer;\r
 213  \r
 214  \r
 215   unit makser:function(k:integer;where:node):integer;\r
 216    begin\r
 217    while where.right=/=none do\r
 218     where:=where.right\r
 219    od;\r
 220    if k>where.e then result:=k else result:=where.e fi;\r
 221   end makser;\r
 222  \r
 223   unit minimal:function(tbl:arint;output kl:integer):integer;\r
 224   var lep:integer;\r
 225    begin\r
 226     result:=tbl.a(1);\r
 227     kl:=1;\r
 228     for lep:=2 to lic do\r
 229      if result>tbl.a(lep) then result:=tbl.a(lep);kl:=lep fi;\r
 230     od;\r
 231   end minimal;\r
 232  \r
 233   unit trawers:coroutine(where:node);\r
 234     unit cwalk:procedure(nod:node);\r
 235       begin\r
 236         if nod=/=none then\r
 237           call cwalk(nod.left);\r
 238           small:=nod.e;\r
 239           detach;\r
 240           call cwalk(nod.right);\r
 241         fi\r
 242     end cwalk;\r
 243     var small:integer;\r
 244     begin\r
 245       return;\r
 246       call cwalk(where);\r
 247       small:=maks\r
 248   end trawers;\r
 249  \r
 250  var artraw:arrayof trawers;\r
 251  \r
 252  begin\r
 253   lic:=0;\r
 254   for i:=1 to upper(horbol) do if horbol(i) then lic:=lic+1 fi od;\r
 255   array forest.a  dim(1:lic);\r
 256   roz:=1;\r
 257   for i:=1 to upper(horbol) do\r
 258    if horbol(i) then forest.a(roz):=hornod.a(i);fi;\r
 259    roz:=roz+1;\r
 260   od;\r
 261   roz:=0;\r
 262   for i:=1 to lic do\r
 263    roz:=roz+howbig(forest.a(i))\r
 264   od;\r
 265   rozm:=roz;\r
 266   bigi:=new arint;\r
 267   array bigi.a dim(1:roz);\r
 268   array artraw dim(1:lic);\r
 269   arsmal:=new arint;\r
 270   array arsmal.a dim (1:lic);\r
 271   maks:=0;\r
 272   for i:=1 to lic do\r
 273        artraw(i):=new trawers(forest.a(i));\r
 274        maks:=makser(maks,forest.a(i))\r
 275   od;\r
 276   for i:=1 to lic do attach(artraw(i));arsmal.a(i):=artraw(i).small od;\r
 277   min:=arsmal.a(1);\r
 278   maks:=maks+1;\r
 279   no:=1;\r
 280   while min<maks do\r
 281    min:=minimal(arsmal,nrt);\r
 282    if min<maks then\r
 283      bigi.a(no):=min;\r
 284      no:=no+1;\r
 285      attach(artraw(nrt));\r
 286      arsmal.a(nrt):=artraw(nrt).small;\r
 287    fi\r
 288   od;\r
 289 end union;\r
 290  \r
 291 unit balance:procedure (inout where:node);\r
 292 var tab:arint;\r
 293 var roz:integer;\r
 294  unit rozwies:procedure(tabel:arint;a,b:integer);\r
 295  begin\r
 296   if b-a>0 andif not member(where,tabel.a((a+b) div 2)) then\r
 297    call insert(where,tabel.a((a+b) div 2));\r
 298    call rozwies(tabel,a,(a+b) div 2);\r
 299    call rozwies(tabel,(a+b) div 2,b);\r
 300   fi;\r
 301  end rozwies;\r
 302 begin\r
 303  if not short then\r
 304   tab:=wektor(where,roz);\r
 305  else\r
 306   tab:=bigi;\r
 307   roz:=rozm;\r
 308  fi;\r
 309  where:=new node;\r
 310  tree.p:=false;\r
 311  call rozwies(tab,1,roz);\r
 312  call insert(where,tab.a(roz));\r
 313 end balance;\r
 314  \r
 315 unit pisz:procedure(where:node);\r
 316 var tab:arint;\r
 317 var i,roz:integer;\r
 318 begin\r
 319 tab:=wektor(where,roz);\r
 320 call setcursor(16,5);\r
 321 for i:=1 to roz do\r
 322  write(tab.a(i):4);\r
 323 od;\r
 324 for i:=1 to 500 do od;\r
 325 end pisz;\r
 326  \r
 327 unit rysuj:procedure(where:node,x:integer,y:integer);\r
 328  var i,z,k:integer;\r
 329  begin\r
 330      call setcursor(x,y-1);\r
 331      write("³",where.e:3);\r
 332      call setcursor(x,y+3);\r
 333      write("³");\r
 334      call setcursor(x-1,y-1);\r
 335      write("Ú");\r
 336      if x=2 then write("ÄÄÄ¿ ") else write("ÄÁÄ¿ ") fi;\r
 337      call setcursor(x+1,y-1);\r
 338      if where.left=/=none orif where.right=/=none then\r
 339               write("ÀÄÂÄÙ")\r
 340      else     write("ÀÄÄÄÙ")\r
 341      fi;\r
 342      z:=(x+2) div 4;\r
 343      k:=1;\r
 344      for i:=1 to z do k:=2*k od;\r
 345      k:=40 div k;\r
 346      if x>20 then bigtree:=true fi;\r
 347  \r
 348      if where.left=/=none andif x<21 then\r
 349         for i:=y-k+2 to y do\r
 350          call setcursor(x+2,i);\r
 351          write("Ä");\r
 352         od;\r
 353         call setcursor(x+2,y+1);\r
 354         if where.right=/=none then write("Á")\r
 355         else write("Ù")\r
 356         fi;\r
 357         call setcursor (x+2,y-k+1);\r
 358         write("Ú");\r
 359         call rysuj(where.left,x+4,y-k)\r
 360      fi;\r
 361      if where.right=/=none andif x<17 then\r
 362         for i:=y+2 to y+k do\r
 363          call setcursor(x+2,i);\r
 364          write("Ä");\r
 365         od;\r
 366         write("¿");\r
 367         if where.left=none then\r
 368            call setcursor(x+2,y+1);\r
 369            write("À")\r
 370         fi;\r
 371         call rysuj(where.right,x+4,y+k)\r
 372      fi;\r
 373  \r
 374 end rysuj;\r
 375  \r
 376  \r
 377 unit newtree:procedure;\r
 378  var name  :arrayof char;\r
 379  var art   :arrayof arrayof char;\r
 380  \r
 381  unit readstring:function:arrayof char;\r
 382   var i,c  :integer;\r
 383   var klap :boolean;\r
 384   var pod  :arrayof char;\r
 385   begin\r
 386    call setcursor(17,10);\r
 387    array pod dim (1:8);\r
 388    klap:=true;\r
 389    result:=pod;\r
 390    for i:=1 to 8 do\r
 391      while c=0 and klap do\r
 392          c:=inkeys\r
 393      od;\r
 394      if c=13 then klap:=false fi;\r
 395      if klap then result(i):=chr(c);\r
 396        c:=0;write(result(i)) else result(i):=' ' fi;\r
 397    od;\r
 398   end readstring;\r
 399  \r
 400  begin\r
 401    call setcursor(15,4);\r
 402    writeln("Give name of a new tree");\r
 403    call setcursor(16,6);\r
 404    name:=readstring;\r
 405    if treer>1 then\r
 406      hornod.a(actree):=tree.n;\r
 407      hornod.p(actree):=tree.p;\r
 408      forest.a:=copy (hornod.a);\r
 409      forest.p:=copy (hornod.p);\r
 410      array hornod.a dim(1:treer);\r
 411      array hornod.p dim(1:treer);\r
 412      for i:=1 to treer-1 do\r
 413        hornod.a(i):=copy (forest.a(i));\r
 414        hornod.p(i):=forest.p(i);\r
 415      od\r
 416    else\r
 417          array hornod.a dim(1:1);\r
 418          array hornod.p dim(1:1);\r
 419    fi;\r
 420    hornod.a(treer):=new node;\r
 421    art:=copy (horn);\r
 422    actree:=treer;\r
 423    array horn dim(1:treer+1);\r
 424    for i:=1 to treer-1 do\r
 425      horn(i):=copy (art(i))\r
 426    od;\r
 427    horn(treer):=name;\r
 428    treer:=treer+1;\r
 429    horn(treer):=art(treer-1);\r
 430    tree.n:=hornod.a(treer-1);\r
 431    tree.p:=false;\r
 432    trenam:=name;\r
 433    first:=true;\r
 434 end newtree;\r
 435  \r
 436  \r
 437 unit actual:procedure;\r
 438  begin\r
 439     call setcursor(1,62);\r
 440     writeln("ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ");\r
 441     call setcursor(2,62);\r
 442     write  ("³  ACTUAL TREE  ³Û ");\r
 443     call setcursor(3,62);\r
 444     write ("³   ");\r
 445     call bold;\r
 446     if treer=/=1 then\r
 447            for i:=1 to 8 do\r
 448             write (trenam(i))\r
 449           od\r
 450     else write("        ") fi;\r
 451     call normal;\r
 452     write("    ³Û ");\r
 453     call setcursor(4,62);\r
 454     writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ ");\r
 455     call setcursor(5,62);\r
 456     writeln(" ßßßßßßßßßßßßßßßßß ");\r
 457 end actual;\r
 458  \r
 459 unit border:procedure;\r
 460   begin\r
 461     call normal;\r
 462     call newpage;\r
 463     call setcursor(1,1);\r
 464     writeln("ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ");\r
 465     write("³ ");\r
 466     call reverse;\r
 467     write(fet(1):8);\r
 468     call normal;\r
 469     writeln("  ³Û ");\r
 470     for i:=2 to 10 do\r
 471      writeln("³ ",fet(i):8,"  ³Û ")\r
 472     od;\r
 473     writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÙÛ ");\r
 474     writeln(" ßßßßßßßßßßßßß ");\r
 475     call actual;\r
 476 end border;\r
 477  \r
 478  \r
 479 unit border2:procedure;\r
 480   var z:integer;\r
 481 begin\r
 482     call normal;\r
 483     call setcursor(5,7);\r
 484     writeln("ÚÄÄÄÄÄÄÄÄÄÄÄ¿ ");\r
 485     call setcursor(6,7);\r
 486     write("³ ");\r
 487     call reverse;\r
 488     for i:=1 to 8 do\r
 489       write (horn(1,i))\r
 490      od;\r
 491     call normal;\r
 492     writeln("  ³Û ");\r
 493     for z:=2 to treer do\r
 494      call setcursor(5+z,7);\r
 495      write("³ ");\r
 496      for i:=1 to 8 do\r
 497       write (horn(z,i))\r
 498      od;\r
 499      write("  ³Û ")\r
 500     od;\r
 501     call setcursor(6+treer,7);\r
 502     writeln("ÀÄÄÄÄÄÄÄÄÄÄÄÙÛ ");\r
 503     call setcursor(7+treer,7);\r
 504     writeln(" ßßßßßßßßßßßßß ");\r
 505 end border2;\r
 506  \r
 507 unit number:procedure;\r
 508  begin\r
 509  call setcursor(18,2);\r
 510  writeln("Give the number  ");\r
 511  call setcursor(19,6);\r
 512  read(x);\r
 513 end;\r
 514  \r
 515 unit clear:procedure;\r
 516   begin\r
 517   call setcursor(18,2);\r
 518   writeln("                                          ");\r
 519   writeln("                                          ");\r
 520 end clear;\r
 521  \r
 522 unit inkeys:IIuwgraph function:integer;\r
 523   begin\r
 524     result:=inkey;\r
 525 end inkeys;\r
 526  \r
 527 unit fmenu: procedure;\r
 528   unit move:procedure(s1,s2,f1,f2:integer);\r
 529    begin\r
 530           call setcursor(s1,3);\r
 531           write(fet(f1):8);\r
 532           call reverse;\r
 533           call setcursor(s2,3);\r
 534           write(fet(f2):8);\r
 535           call normal\r
 536   end move;\r
 537  begin\r
 538  call normal;\r
 539  while key=/=13 do\r
 540    do key:=inkeys;\r
 541       if key=13 orif key=-72 orif key=-80 then exit fi;\r
 542    od;\r
 543    if key=-72 then\r
 544       if menu>1  then menu:=menu-1;\r
 545                 call move(menu+2,menu+1,menu+1,menu)\r
 546       else menu:=10;\r
 547            call move(2,11,1,10)\r
 548       fi\r
 549    fi;\r
 550  \r
 551    if key=-80 then\r
 552       if menu<10  then menu:=menu+1;\r
 553                  call move(menu,menu+1,menu-1,menu)\r
 554       else menu:=1;\r
 555             call move(11,2,10,1)\r
 556       fi\r
 557    fi\r
 558  od\r
 559 end fmenu;\r
 560  \r
 561  \r
 562 unit fmenu2: procedure;\r
 563   unit move2:procedure(x1,x2,y:integer);\r
 564     begin\r
 565         call setcursor(x1,y);\r
 566         for i:=1 to 8 do\r
 567               write (horn(x2,i))\r
 568         od;\r
 569         call normal;\r
 570   end move2;\r
 571  begin\r
 572  array horbol dim (1:treer-1);\r
 573  for i:=1 to treer-1 do\r
 574    horbol(i):=false\r
 575  od;\r
 576  call normal;\r
 577  if treer=1 then\r
 578   call setcursor(10,15);\r
 579  writeln("You haven't tree");\r
 580  for i:=1 to 1000 do od else\r
 581  while menu2=/=treer do\r
 582   while key2=/=13 do\r
 583    do key2:=inkeys;\r
 584       if key2=13 orif key2=-72 orif key2=-80 then exit fi;\r
 585    od;\r
 586    if key2=-72 then\r
 587       if menu2>1  then menu2:=menu2-1;\r
 588                  if horbol(menu2+1) then call bold fi;\r
 589                  call move2(menu2+6,menu2+1,9);\r
 590                  call reverse;\r
 591                  call move2(menu2+5,menu2,9)\r
 592       else menu2:=treer;\r
 593            if horbol(1) then call bold fi;\r
 594            call move2(6,1,9);\r
 595            call reverse;\r
 596            call move2(treer+5,treer,9)\r
 597       fi\r
 598    fi;\r
 599  \r
 600    if key2=-80 then\r
 601       if menu2<treer  then menu2:=menu2+1;\r
 602                  if horbol(menu2-1) then call bold fi;\r
 603                  call move2(menu2+4,menu2-1,9);\r
 604                  call reverse;\r
 605                  call move2(menu2+5,menu2,9)\r
 606       else menu2:=1;\r
 607            if horbol(treer) then call bold fi;\r
 608            call move2(treer+5,treer,9);\r
 609            call reverse;\r
 610            call move2(6,1,9)\r
 611       fi\r
 612    fi\r
 613   od;\r
 614   if menu2=treer orif not usa then\r
 615        if change and menu2=/=treer then\r
 616          hornod.a(actree):=tree.n;\r
 617          hornod.p(actree):=tree.p;\r
 618          actree:=menu2;\r
 619          tree.p:=hornod.p(menu2);\r
 620          tree.n:=hornod.a(menu2);\r
 621          trenam:=horn(menu2);\r
 622          change:=false\r
 623        fi;\r
 624        call setcursor(3,64);\r
 625        call bold;\r
 626        for i:=1 to 8 do\r
 627           write (trenam(i))\r
 628        od;\r
 629        exit\r
 630   else\r
 631        if horbol(menu2) then horbol(menu2):=false;\r
 632        call reverse\r
 633        else call normal;\r
 634             call bold;\r
 635             horbol(menu2):=true\r
 636        fi;\r
 637        call move2(menu2+5,menu2,9);\r
 638        call normal;\r
 639   fi;\r
 640   call normal;\r
 641   key2:=1\r
 642  od\r
 643 fi;\r
 644 end fmenu2;\r
 645  \r
 646     unit WAITforKEY: procedure;\r
 647     begin\r
 648           while  inkeys=0 do   od;\r
 649     end WAITforKEY\r
 650  \r
 651  \r
 652 begin\r
 653     hornod:=new arnode;\r
 654     forest:=new arnode;\r
 655     tree:=new tnode;\r
 656     first:=true;\r
 657     array fet dim(1:10);\r
 658     array horn dim(1:1);\r
 659     array horn(1) dim(1:8);\r
 660     fet(1):="INSERT  ";\r
 661     fet(2):="DELETE  ";\r
 662     fet(3):="MEMBER  ";\r
 663     fet(4):="DRAW    ";\r
 664     fet(5):="BALANCE ";\r
 665     fet(6):="UNION   ";\r
 666     fet(7):="WRITE   ";\r
 667     fet(8):="NEW TREE";\r
 668     fet(9):="CHANGE  ";\r
 669     fet(10):="QUIT    ";\r
 670  \r
 671     horn(1,1):='E';\r
 672     horn(1,2):='X';\r
 673     horn(1,3):='I';\r
 674     horn(1,4):='T';\r
 675     for x:=5 to 8 do horn(1,x):=' ' od;\r
 676     treer:=1;\r
 677     array horbol dim(1:1);\r
 678     menu:=1;\r
 679     usa:=false;\r
 680     call SetCursor(5,10);\r
 681  \r
 682     do\r
 683         call border;\r
 684         call fmenu;\r
 685  \r
 686         case menu\r
 687         when 1: if treer=/=1 then\r
 688                    call number;\r
 689                    call insert(tree.n,x);\r
 690                  else\r
 691                     call setcursor(17,1);\r
 692                     writeln("You haven't tree");\r
 693                   fi;\r
 694                   key:=1;\r
 695  \r
 696          when 2:if treer=/=1 then\r
 697                    if not tree.p then\r
 698                       call setcursor(17,1);\r
 699                       write("This tree is empty");\r
 700                    else\r
 701                       call number;\r
 702                       call delete(tree.n,x);\r
 703                    fi\r
 704                  else\r
 705                       call setcursor(17,1);\r
 706                       writeln("You haven't tree");\r
 707                   fi;\r
 708  \r
 709  \r
 710            when 3:if treer=/=1 then\r
 711                       if not tree.p then\r
 712                             call setcursor(17,1);\r
 713                             write("This tree is empty");\r
 714                        else\r
 715                              call number;\r
 716                              wyjscie:=member(tree.n,x);\r
 717                              if wyjscie\r
 718                              then\r
 719                                  write( "  This number is present ")\r
 720                              else\r
 721                                   write("  This number is absent")\r
 722                              fi;\r
 723  \r
 724                         fi\r
 725                    else\r
 726                         call setcursor(17,1);\r
 727                         writeln("You haven't tree");\r
 728                    fi;\r
 729  \r
 730  \r
 731            when 4:if treer=/=1 then\r
 732  \r
 733                       if not tree.p then\r
 734                             call setcursor(17,1);\r
 735                             write("This tree is empty")\r
 736                       else\r
 737                             call newpage;\r
 738                             call actual;\r
 739                             bigtree:=false;\r
 740                             call rysuj(tree.n,2,40);\r
 741                             call setcursor(22,40);\r
 742                             if bigtree then\r
 743                                 writeln("Tree to big")\r
 744                             fi;\r
 745                             writeln("press any key");\r
 746                             menu:=1;\r
 747                        fi\r
 748                    else\r
 749                        call setcursor(17,1);\r
 750                        writeln("You haven't tree");\r
 751                    fi;\r
 752  \r
 753                   key:=1;\r
 754  \r
 755  \r
 756             when 5:if treer=/=1 then\r
 757                        if not tree.p then\r
 758                             call setcursor(17,1);\r
 759                             write("This tree is empty");\r
 760                        else\r
 761                             call balance(tree.n);\r
 762                        fi;\r
 763                    else\r
 764                         call setcursor(17,1);\r
 765                         writeln("You haven't tree");\r
 766                    fi;\r
 767  \r
 768  \r
 769              when 6:if treer=/=1 then\r
 770                         usa:=true;\r
 771                         menu2:=1;key2:=1;\r
 772                         call border2;\r
 773                         call fmenu2;\r
 774                         short:=true;\r
 775                         call union(forest);\r
 776                         call newtree;\r
 777                         call balance(tree.n);\r
 778                         short:=false;\r
 779                         usa:=false;\r
 780                      else\r
 781                         call setcursor(17,1);\r
 782                         writeln("You haven't tree");\r
 783  \r
 784                      fi;\r
 785  \r
 786  \r
 787               when 7:if treer<>1 then\r
 788                          if not tree.p then\r
 789                                call setcursor(17,1);\r
 790                                write("This tree is empty");\r
 791                           else\r
 792                                 call pisz(tree.n);\r
 793                           fi\r
 794                       else\r
 795                            call setcursor(17,1);\r
 796                            writeln("You haven't tree");\r
 797                       fi;\r
 798  \r
 799  \r
 800                when 8: call newtree;\r
 801  \r
 802  \r
 803                when 9: if treer<>1\r
 804                        then\r
 805                             change:=true;\r
 806                             menu2:=1;key2:=1;\r
 807                             call border2;\r
 808                             call fmenu2;\r
 809                             call border;\r
 810                         else\r
 811                              call setcursor(17,1);\r
 812                              writeln("You haven't tree");\r
 813                          fi;\r
 814  \r
 815  \r
 816                 when 10: call endrun;\r
 817  \r
 818           esac ;\r
 819           call SetCursor(22,40);\r
 820           write("press any key");\r
 821           call WaitForKey;\r
 822           call SetCursor(22,40);\r
 823           write("                       ");\r
 824           call SetCursor(17,1);\r
 825           write("                                                       ");\r
 826           menu:=1;\r
 827           key:=1;\r
 828        od;\r
 829  \r
 830 end bst.\r