bstscan.log

   1 program BSTscanner;\r
   2  \r
   3 begin\r
   4  \r
   5    pref iiuwgraph block\r
   6  \r
   7  \r
   8    unit inchar :function: integer;\r
   9       var i : integer;\r
  10       begin\r
  11          do\r
  12          i := inkey;\r
  13          if i <> 0 then exit fi;\r
  14          od;\r
  15          result := i;\r
  16    end inchar;\r
  17  \r
  18    unit node:class;\r
  19       var left:node;\r
  20       var right:node;\r
  21       var e:arrayof char;\r
  22    end node;\r
  23  \r
  24    unit head:class;\r
  25       var tre:node;\r
  26       var size:integer;\r
  27       var name:arrayof char;\r
  28       var next:head;\r
  29    end;\r
  30  \r
  31    unit MENU:class;\r
  32  \r
  33       var y:integer;\r
  34       var name:arrayof char;\r
  35       var sub:menu;\r
  36       var next:menu;\r
  37       var prev:menu;\r
  38  \r
  39    end menu;\r
  40  \r
  41    unit directory:procedure;\r
  42       var hel1,hel2,hel3,hel4:menu;\r
  43       var tru:boolean;\r
  44       begin\r
  45          tru:=true;\r
  46          hel1:=new menu;\r
  47          pointer:=hel1;\r
  48          hel1.name:=sa("DISC   ");\r
  49          hel1.y:=135;\r
  50  \r
  51          hel2:=new menu;\r
  52          hel2.name:=sa("TREE   ");\r
  53          hel2.y:=155;\r
  54          hel1.next:=hel2;\r
  55          hel2.prev:=hel1;\r
  56  \r
  57          hel3:=new menu;\r
  58          hel3.name:=sa("EXIT   ");\r
  59          hel3.y:=175;\r
  60          hel2.next:=hel3;\r
  61          hel3.prev:=hel2;\r
  62          hel3.next:=hel1;\r
  63          hel1.prev:=hel3;\r
  64  \r
  65          hel3:=new menu;\r
  66          hel3.name:=sa("UPDIR  ");\r
  67          hel3.y:=135;\r
  68          hel3.sub:=hel1;\r
  69          hel1.sub:=hel3;\r
  70  \r
  71          hel1:=new menu;\r
  72          hel1.name:=sa("SAVEnot");\r
  73          hel1.y:=155;\r
  74          hel3.next:=hel1;\r
  75          hel1.prev:=hel3;\r
  76  \r
  77          hel4:=new menu;\r
  78          hel4.name:=sa("LOADnot");\r
  79          hel4.y:=175;\r
  80          hel3.prev:=hel4;\r
  81          hel4.next:=hel3;\r
  82          hel1.next:=hel4;\r
  83          hel4.prev:=hel1;\r
  84          hel1:=hel3.sub;\r
  85  \r
  86          hel3:=new menu;\r
  87          hel3.name:=sa("UPDIR  ");\r
  88          hel3.y:=95;\r
  89          hel2.sub:=hel3;\r
  90          hel3.sub:=hel1;\r
  91  \r
  92          hel2:=new menu;\r
  93          hel2.name:=sa("CREATE ");\r
  94          hel2.y:=115;\r
  95          hel2.prev:=hel3;\r
  96          hel3.next:=hel2;\r
  97  \r
  98          hel4:=new menu;\r
  99          hel4.name:=sa("INSERT ");\r
 100          hel4.y:=135;\r
 101          hel4.prev:=hel2;\r
 102          hel2.next:=hel4;\r
 103  \r
 104          hel2:=new menu;\r
 105          hel2.name:=sa("DELETE ");\r
 106          hel2.y:=155;\r
 107          hel2.prev:=hel4;\r
 108          hel4.next:=hel2;\r
 109  \r
 110          hel4:=new menu;\r
 111          hel4.name:=sa("MEMBER ");\r
 112          hel4.y:=175;\r
 113          hel4.prev:=hel2;\r
 114          hel2.next:=hel4;\r
 115  \r
 116          hel2:=new menu;\r
 117          hel2.name:=sa("CHANGE ");\r
 118          hel2.y:=195;\r
 119          hel2.prev:=hel4;\r
 120          hel4.next:=hel2;\r
 121  \r
 122          hel4:=new menu;\r
 123          hel4.name:=sa("WRITE  ");\r
 124          hel4.y:=215;\r
 125          hel4.prev:=hel2;\r
 126          hel2.next:=hel4;\r
 127          hel4.next:=hel3;\r
 128          hel3.prev:=hel4;\r
 129  \r
 130          hel2:=new menu;\r
 131          hel2.name:=sa("UPDIR  ");\r
 132          hel2.y:=115;\r
 133          hel4.sub:=hel2;\r
 134          hel2.sub:=hel3;\r
 135  \r
 136          hel4:=new menu;\r
 137          hel4.name:=sa("DRAW   ");\r
 138          hel4.y:=135;\r
 139          hel4.prev:=hel2;\r
 140          hel2.next:=hel4;\r
 141  \r
 142          hel3:=new menu;\r
 143          hel3.name:=sa("PREFIX ");\r
 144          hel3.y:=155;\r
 145          hel3.prev:=hel4;\r
 146          hel4.next:=hel3;\r
 147  \r
 148          hel4:=new menu;\r
 149          hel4.name:=sa("INFIX  ");\r
 150          hel4.y:=175;\r
 151          hel4.prev:=hel3;\r
 152          hel3.next:=hel4;\r
 153  \r
 154          hel3:=new menu;\r
 155          hel3.name:=sa("POSTFIX");\r
 156          hel3.y:=195;\r
 157          hel3.prev:=hel4;\r
 158          hel4.next:=hel3;\r
 159          hel3.next:=hel2;\r
 160          hel2.prev:=hel3;\r
 161  \r
 162          pointer:=hel1;\r
 163  \r
 164    end directory;\r
 165  \r
 166  \r
 167    unit RANGE:procedure(x:integer,y:integer,i:integer);\r
 168       begin\r
 169          call color(i);\r
 170          call move(x,y);\r
 171          call draw(x+120,y);\r
 172          call draw(x+120,y+20);\r
 173          call draw(x,y+20);\r
 174          call draw(x,y);\r
 175          call color(2);\r
 176    end range;\r
 177  \r
 178    unit BOX:procedure(xc,yc:integer;lenght,szer:integer);\r
 179       begin\r
 180          call move(xc,yc);\r
 181          call color(14);\r
 182          call draw(xc+lenght,yc);\r
 183          call draw(xc+lenght,yc+szer);\r
 184          call draw(xc,yc+szer);\r
 185          call draw(xc,yc);\r
 186    end box;\r
 187  \r
 188    unit CLR:procedure;\r
 189       begin\r
 190          call cls;\r
 191          call color(14);\r
 192          call move(0,0);\r
 193          call draw(618,0);\r
 194          call draw(618,319);\r
 195          call draw(0,319);\r
 196          call draw(0,0);\r
 197    end clr;\r
 198  \r
 199    unit drawmenu:procedure(pointer:menu);\r
 200       var phelp:menu;\r
 201       var yhelp:integer;\r
 202       var n,i,j:integer;\r
 203       var sub,run:arrayof char;\r
 204  \r
 205  \r
 206       begin\r
 207          call clr;\r
 208          call color(2);\r
 209          call box(400,20,200,30);\r
 210          call box(398,18,204,34);\r
 211          if actual=/=none then\r
 212             call move(420,30);\r
 213             call outhline(actual.name);\r
 214          fi;\r
 215  \r
 216          sub:=sa(" sub");\r
 217          run:=sa(" run");\r
 218          phelp:=pointer;\r
 219          yhelp:=phelp.y;\r
 220          n:=1;\r
 221          phelp:=phelp.next;\r
 222          while yhelp=/= phelp.y do\r
 223             phelp:=phelp.next;\r
 224             n:=n+1;\r
 225          od;\r
 226          call color(14);\r
 227          x:=270;\r
 228          y:=(320-n*20-20)/2;\r
 229          call move(x,y);\r
 230          call draw(x+140,y);\r
 231          call draw(x+140,y+n*20+20);\r
 232          call draw(x,y+n*20+20);\r
 233          call draw(x,y);\r
 234  \r
 235  \r
 236          x:=268;\r
 237          y:=y-2;\r
 238          call move(x,y);\r
 239          call draw(x+144,y);\r
 240          call draw(x+144,y+n*20+24);\r
 241          call draw(x,y+n*20+24);\r
 242          call draw(x,y);\r
 243  \r
 244          for i:=1 to 8 do\r
 245             call move(x+144+i,y+5);\r
 246             call draw(x+144+i,y+n*20+24+i);\r
 247             call draw(x+5,y+n*20+24+i);\r
 248          od;\r
 249  \r
 250  \r
 251          x:=x+20;\r
 252          for j:=1 to n do\r
 253             y:=phelp.y;\r
 254             call move(x,y);\r
 255             call OUTHLINE(phelp.name);\r
 256  \r
 257             if phelp.sub =/=none then;\r
 258                call OUTHLINE(sub);\r
 259             else\r
 260                call OUTHLINE(run);\r
 261             fi;\r
 262             phelp:=phelp.next;\r
 263          od;\r
 264  \r
 265          x:=x-10;\r
 266          y:=phelp.y-5;\r
 267          call RANGE(x,y,1);\r
 268  \r
 269       end drawmenu;\r
 270  \r
 271    unit OUTHLINE:procedure(a:arrayof char);\r
 272  \r
 273       var i:integer;\r
 274       var j:integer;\r
 275  \r
 276       begin\r
 277          call color(11); (* czerwony *)\r
 278          i:=upper(a);\r
 279          for j:=1 to i do\r
 280             call hascii(0);\r
 281             call hascii(ord(a(j)));\r
 282           od;\r
 283    end outhline;\r
 284  \r
 285  \r
 286    unit INHLINE:function(xc:integer;yc:integer):arrayof char;\r
 287  \r
 288       var i:integer;\r
 289       var count:integer;\r
 290       var ik:integer;\r
 291       var ar:arrayof char;\r
 292  \r
 293       begin\r
 294          call move(xc,yc);\r
 295          count:=0;\r
 296          array ar dim(1:13);\r
 297  \r
 298          while ik=/=13 and count<13 do\r
 299             ik:=inchar;\r
 300             if ik=8 and count>0 then\r
 301                   ar(count):=' ';\r
 302                   count:=count-1;\r
 303                   call move(xc+(count)*8,yc);\r
 304                   call hascii(0);\r
 305             else\r
 306                if ik=/=13 then\r
 307                   count:=count+1;\r
 308                   ar(count):=chr(ik);\r
 309                   call hascii(0);\r
 310                   call hascii(ik);\r
 311                fi;\r
 312             fi;\r
 313          od;\r
 314          if count=/=0 then\r
 315             array result dim(1:count);\r
 316             for i:=1 to count do\r
 317                result(i):=ar(i);\r
 318             od;\r
 319          fi;\r
 320    end inhline;\r
 321  \r
 322  \r
 323    unit SEARCH:class(where:node;what:arrayof char);\r
 324  \r
 325       var hel1:node,hel2:node;\r
 326       var isit:boolean;\r
 327  \r
 328       begin\r
 329          hel1:=where;\r
 330          hel2:=none;\r
 331          do\r
 332             if hel1=none then exit\r
 333             else\r
 334             if equal(hel1.e,what) then exit\r
 335             else\r
 336                hel2:=hel1;\r
 337                if not less(hel1.e,what) then\r
 338                   hel1:=hel1.left;\r
 339                else\r
 340                   hel1:=hel1.right;\r
 341                fi;\r
 342             fi;\r
 343             fi;\r
 344          od;\r
 345          if hel1=/=none then isit:=true;\r
 346          else isit:= false;\r
 347          fi\r
 348    end search;\r
 349  \r
 350    unit membe:SEARCH procedure;\r
 351       begin\r
 352  \r
 353            if isit\r
 354            then\r
 355               call outhline(sa(" EXISTS "));\r
 356            else\r
 357               call outhline(sa(" DOESN'T EXIST"));\r
 358            fi;\r
 359    end membe;\r
 360  \r
 361    unit INSER:SEARCH procedure;\r
 362       var help:node;\r
 363       begin\r
 364          if where=none then\r
 365             help:=new node;\r
 366             call OUTHLINE(sa("     O.K."));\r
 367             help.e:=what;\r
 368             actual.tre:=help;\r
 369          else\r
 370             if isit then\r
 371                call OUTHLINE(sa(" ALREADY EXIXTS"));\r
 372             else\r
 373                help:=new node;\r
 374                call OUTHLINE(sa("     O.K."));\r
 375                help.e:=what;\r
 376                if not less(hel2.e,what) then\r
 377                   hel2.left:=help;\r
 378                else\r
 379                   hel2.right:=help;\r
 380                fi;\r
 381             fi;\r
 382          fi;\r
 383    end inser;\r
 384  \r
 385    unit delet:SEARCH procedure;\r
 386       var i:integer;\r
 387       var pom:node;\r
 388       begin\r
 389          if where=none then\r
 390  \r
 391             call OUTHLINE(sa(" TREE IS EMPTY "));\r
 392          else\r
 393             if not isit then\r
 394                call OUTHLINE(sa("DOESN'T EXIST"));\r
 395             else\r
 396        call outhline(sa("  O.K. "));\r
 397                if hel2=none then\r
 398  \r
 399        if hel1.right<>none then\r
 400        where:=hel1.right;\r
 401        pom:=where;\r
 402        do\r
 403         if  pom.left=none then exit;\r
 404         else pom:=pom.left;\r
 405      fi;\r
 406       od;\r
 407       pom.left:=hel1.left;\r
 408       kill(hel1);\r
 409       actual.tre:=where;\r
 410  \r
 411     else\r
 412      if hel1.left<>none then\r
 413        where:=hel1.left;\r
 414        pom:=where;\r
 415        do;\r
 416         if  pom.right=none then exit;\r
 417          else pom:=pom.right;\r
 418      fi;\r
 419       od;\r
 420       pom.right:=hel1.right;\r
 421       kill(hel1);\r
 422       actual.tre:=where;\r
 423      else\r
 424                where:=none;\r
 425                kill (hel1);\r
 426       fi;   fi;          (****** 1 to 2 *****)\r
 427                else\r
 428                   if not less(hel1.e,hel2.e) then\r
 429                      if hel1.left=none then\r
 430                         hel2.right:=hel1.right;\r
 431                         kill (hel1);\r
 432                      else\r
 433                         if hel1.right=none then\r
 434                            hel2.right:=hel1.left;\r
 435                            kill (hel1);\r
 436                         else\r
 437                            hel2.right:=hel1.right;\r
 438                            pom:=hel2.right;\r
 439                            while pom.left=/=none do\r
 440                               pom:=pom.left;\r
 441                            od;\r
 442                            pom.left:=hel1.left;\r
 443                            kill (hel1);\r
 444                         fi;\r
 445                      fi;\r
 446                   else\r
 447                      if hel1.left=none then\r
 448                         hel2.left:=hel1.right;\r
 449                         kill (hel1);\r
 450                      else\r
 451                         if hel1.right=none then\r
 452                            hel2.left:=hel1.left;\r
 453                            kill (hel1);\r
 454                         else\r
 455                            hel2.left:=hel1.left;\r
 456                            pom:=hel1.left;\r
 457                            while pom.right=/=none do\r
 458                               pom:=pom.right;\r
 459                            od;\r
 460                            pom.right:=hel1.right;\r
 461                            kill (hel1);\r
 462                         fi;\r
 463                      fi;\r
 464                   fi;\r
 465                fi;\r
 466             fi;\r
 467          fi;\r
 468    end delet;\r
 469  \r
 470    unit GIVEME:function:arrayof arrayof char;\r
 471       var i,j:integer;\r
 472       var a:arrayof arrayof char;\r
 473       var ac:arrayof char;\r
 474       var x,y:integer;\r
 475       var count:integer;\r
 476  \r
 477       begin\r
 478          call clr;\r
 479          call box(100,20,200,30);\r
 480          call box(98,18,204,34);\r
 481          CALL move(110,30);\r
 482          call outhline(sa(" GIVE ME ELEMENTS"));\r
 483          call box(100,60,200,200);\r
 484          x:=180;\r
 485          y:=70;\r
 486          j:=0;\r
 487          array a dim(1:16);\r
 488  \r
 489          do\r
 490             call move(x-10,y);\r
 491             call outhline(sa(">"));\r
 492             ac:=inhline(x,y);\r
 493             if ac=none or j> 15 then exit\r
 494             else\r
 495                j:=j+1;\r
 496                a(j):=ac;\r
 497             fi;\r
 498             y:=y+10;\r
 499          od;\r
 500          if j=/=0 then\r
 501             array result dim(1:j);\r
 502             for i:=1 to j do\r
 503                result(i):=a(i);\r
 504             od;\r
 505          fi;\r
 506  \r
 507  \r
 508    end giveme;\r
 509  \r
 510    unit SA:function(s:string):arrayof char;\r
 511       begin\r
 512          result:=unpack(s);\r
 513    end sa;\r
 514  \r
 515    unit CHOOSE:procedure;\r
 516       var i:integer;\r
 517       begin\r
 518          do\r
 519             i:=inkey;\r
 520  \r
 521             if i=-80 then\r
 522                call range(x,pointer.y-5,0);\r
 523                pointer:=pointer.next;\r
 524                call range(x,pointer.y-5,14);\r
 525             else\r
 526                if i=-72 then\r
 527                   call range(x,pointer.y-5,0);\r
 528                   pointer:=pointer.prev;\r
 529                   call range(x,pointer.y-5,14);\r
 530                else\r
 531                   if i=13 then\r
 532                      call runner;\r
 533                   fi;\r
 534                fi;\r
 535             fi;\r
 536  \r
 537          od;\r
 538    end choose;\r
 539  \r
 540    unit ESCAPE:procedure;\r
 541       begin\r
 542          call groff;\r
 543          call endrun;\r
 544    end escape;\r
 545  \r
 546    unit RUNNER:procedure;\r
 547       begin\r
 548          if pointer.sub=/=none then\r
 549             pointer:=pointer.sub;\r
 550             call drawmenu(pointer);\r
 551          else\r
 552             if equal(pointer.name,sa("EXIT   ")) then\r
 553                call ESCAPE;\r
 554             else\r
 555             if equal(pointer.name,sa("CREATE ")) then\r
 556                call CREATE;\r
 557             else\r
 558             if equal(pointer.name,sa("INSERT ")) then\r
 559                call INSERT;\r
 560             else\r
 561             if equal(pointer.name,sa("DELETE ")) then\r
 562                call DELETE;\r
 563             else\r
 564             if equal(pointer.name,sa("MEMBER ")) then\r
 565                call MEMBER;\r
 566             else\r
 567             if equal(pointer.name,sa("CHANGE ")) then\r
 568                call CHANGE;\r
 569             else\r
 570             if equal(pointer.name,sa("UNION  ")) then\r
 571             else\r
 572             if equal(pointer.name,sa("BALANCE")) then\r
 573             else\r
 574             if equal(pointer.name,sa("DRAW   ")) then\r
 575                call PAINT;\r
 576             else\r
 577             if equal(pointer.name,sa("PREFIX ")) then\r
 578                call PREFIX;\r
 579             else\r
 580             if equal(pointer.name,sa("INFIX  ")) then\r
 581                call INFIX;\r
 582             else\r
 583             if equal(pointer.name,sa("POSTFIX")) then\r
 584                call POSTFIX;\r
 585             else\r
 586             if equal(pointer.name,sa("SAVE   ")) then\r
 587             else\r
 588             if equal(pointer.name,sa("LOAD   ")) then\r
 589          fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;\r
 590    end;\r
 591  \r
 592  \r
 593       unit CREATE:procedure;\r
 594  \r
 595       var h:head;\r
 596       var ac:arrayof char;\r
 597       var i:integer;\r
 598  \r
 599       begin\r
 600          call range(x,pointer.y-5,0);\r
 601          for i:=0 to 7 do\r
 602             call box(401+i,21+i,178-2*i,28-2*i);\r
 603          od;\r
 604          call move (410,30);\r
 605          call outhline(sa("                "));\r
 606          call move(420,31);\r
 607          call outhline(sa(">"));\r
 608          ac:=inhline(430,30);\r
 609          call color(0);\r
 610          for i:=0 to 7 do\r
 611             call box(401+i,21+i,178-2*i,28-2*i);\r
 612          od;\r
 613          call color(2);\r
 614          call range(x,pointer.y-5,1);\r
 615          if ac=/=none then\r
 616             h:=new head;\r
 617             h.name:=ac;\r
 618             actual:=tree;\r
 619             if actual=/=none then\r
 620                while actual.next=/=none do\r
 621                   actual:=actual.next;\r
 622                od;\r
 623                actual.next:=h;\r
 624             else\r
 625                tree:=h;\r
 626             fi;\r
 627             actual:=h;\r
 628          fi;\r
 629    end create;\r
 630  \r
 631    unit INSERT:procedure;\r
 632  \r
 633       var i,j,y:integer;\r
 634       var ai:arrayof arrayof char;\r
 635  \r
 636       begin\r
 637          call clr;\r
 638          if actual=none then\r
 639             call BOX(250,150,250,30);\r
 640             call BOX(248,148,254,34);\r
 641             call move(270,160);\r
 642             call OUTHLINE(unpack("YOU CAN'T USE INSERT NOW !"));\r
 643          else\r
 644             ai:=giveme;\r
 645             if ai<>none then\r
 646               call box(400,20,200,30);\r
 647               call box(398,18,204,34);\r
 648               call move(470,30);\r
 649               call OUTHLINE(sa("INSERT"));\r
 650               call box(400,60,200,200);\r
 651               i:=upper(ai);\r
 652               actual.size:=actual.size+i;\r
 653               y:=70;\r
 654               for j:=1 to i do\r
 655                   call move(430,y);\r
 656                   call inser(actual.tre,ai(j));\r
 657                   y:=y+10;\r
 658               od;\r
 659            fi;\r
 660        fi;\r
 661        i:=inchar;\r
 662        call CLR;\r
 663        call DRAWMENU(pointer);\r
 664    end insert;\r
 665  \r
 666    unit MEMBER:procedure;\r
 667  \r
 668       var i,j,y:integer;\r
 669       var ai:arrayof arrayof char;\r
 670  \r
 671       begin\r
 672         call clr;\r
 673          if actual=none then\r
 674             call BOX(250,150,250,30);\r
 675             call BOX(248,148,254,34);\r
 676             call move(270,160);\r
 677             call OUTHLINE(unpack("YOU CAN'T USE MEMBER NOW !"));\r
 678          else\r
 679             ai:=giveme;\r
 680             if ai<>none then\r
 681                 call box(400,20,200,30);\r
 682                 call box(398,18,204,34);\r
 683                 call move(470,30);\r
 684                 call OUTHLINE(sa("MEMBER"));\r
 685                 call box(400,60,200,200);\r
 686                 i:=upper(ai);\r
 687                 y:=70;\r
 688                 for j:=1 to i do\r
 689                    call move(430,y);\r
 690                    call membe(actual.tre,ai(j));\r
 691                    y:=y+10;\r
 692                 od;\r
 693               fi;\r
 694            fi;\r
 695            i:=inchar;\r
 696            call CLR;\r
 697            call DRAWMENU(pointer);\r
 698  \r
 699    end;\r
 700  \r
 701 unit delete:procedure;\r
 702  \r
 703       var i,j,y:integer;\r
 704       var ai:arrayof arrayof char;\r
 705  \r
 706       begin\r
 707          call clr;\r
 708          if actual=none then\r
 709             call BOX(250,150,250,30);\r
 710             call BOX(248,148,254,34);\r
 711             call move(270,160);\r
 712             call OUTHLINE(unpack("YOU CAN'T USE DELETE NOW !"));\r
 713          else\r
 714             ai:=giveme;\r
 715             if ai<> none then\r
 716                call box(400,20,200,30);\r
 717                call box(398,18,204,34);\r
 718                call move(470,30);\r
 719                call OUTHLINE(sa("DELETE"));\r
 720                call box(400,60,200,200);\r
 721                i:=upper(ai);\r
 722                actual.size:=actual.size-i;\r
 723                y:=70;\r
 724                for j:=1 to i do\r
 725                   call move(430,y);\r
 726                   call delet(actual.tre,ai(j));\r
 727                   y:=y+10;\r
 728                od;\r
 729              fi;\r
 730           fi;\r
 731  \r
 732           i:=inchar;\r
 733           call DRAWMENU(pointer);\r
 734      end delete;\r
 735  \r
 736    unit CHANGE:procedure;\r
 737       var i:integer;\r
 738       begin\r
 739          if actual=none then\r
 740             call clr;\r
 741             call BOX(250,150,250,30);\r
 742             call BOX(248,148,254,34);\r
 743             call move(270,160);\r
 744             call OUTHLINE(unpack("YOU CAN'T USE CHANGE NOW !"));\r
 745             i:=inchar;\r
 746             call drawmenu(pointer);\r
 747          else\r
 748          call range(x,pointer.y-5,0);\r
 749          for i:=0 to 7 do\r
 750             call box(401+i,21+i,178-2*i,28-2*i);\r
 751          od;\r
 752          call move (410,30);\r
 753          call outhline(sa("              "));\r
 754          actual:=tree;\r
 755  \r
 756          do\r
 757             call move(420,30);\r
 758             call outhline(sa("            "));\r
 759             call move(420,30);\r
 760             call outhline(actual.name);\r
 761             i:=inchar;\r
 762             if i=13 then exit\r
 763             else\r
 764                if actual.next=/=none then\r
 765                   actual:=actual.next;\r
 766                else\r
 767                   actual:=tree;\r
 768                fi;\r
 769             fi;\r
 770          od;\r
 771  \r
 772          call color(0);\r
 773          for i:=0 to 7 do\r
 774             call box(401+i,21+i,178-2*i,28-2*i);\r
 775          od;\r
 776          call color(2);\r
 777          call range(x,pointer.y-5,1);\r
 778       fi;\r
 779    end change;\r
 780  \r
 781  \r
 782  \r
 783    unit PAINT:procedure;\r
 784  \r
 785       var i:integer;\r
 786       var toobig:boolean;\r
 787  \r
 788       unit dr:procedure(elem:node,xo:integer,delta:integer,level:integer);\r
 789          begin\r
 790                call move(xo-upper(elem.e)*4,level*40+10);\r
 791                call outhline(elem.e);\r
 792                if elem.left=/=none then\r
 793                   call move(xo,level*40+20);\r
 794                   call draw(xo-delta,(level+1)*40);\r
 795                   call dr(elem.left,xo-delta,delta/2,level+1);\r
 796                fi;\r
 797                if elem.right=/=none then\r
 798                   call move(xo,level*40+20);\r
 799                   call draw(xo+delta,(level+1)*40);\r
 800                   call dr(elem.right,xo+delta,delta/2,level+1);\r
 801                fi;\r
 802       end dr;\r
 803  \r
 804       begin\r
 805          call clr;\r
 806          if actual=none then\r
 807             call BOX(250,150,250,30);\r
 808             call BOX(248,148,254,34);\r
 809             call move(270,160);\r
 810             call OUTHLINE(unpack("YOU CAN'T USE DRAW NOW !"));\r
 811          else   \r
 812          elem:=actual.tre;\r
 813          if elem=none then\r
 814             call clr;\r
 815             call outhline(sa(" TREE IS EMPTY "));\r
 816          else\r
 817             toobig:=false;\r
 818             call dr(elem,320,160,0);\r
 819             if toobig then ;\r
 820                call outhline(sa(" TREE IS TOO BIG "));\r
 821             fi;\r
 822          fi;\r
 823        FI;\r
 824        i:=inchar;\r
 825        call drawmenu(pointer);\r
 826    end paint;\r
 827  \r
 828    unit PREFIX:procedure;\r
 829       var h:node;\r
 830       var i:integer;\r
 831       var x,y:integer;\r
 832       unit go4:procedure(elem:node);\r
 833          begin\r
 834             if elem=/=none then\r
 835                call move(x,y);\r
 836                call outhline(elem.e);\r
 837                y:=y+10;\r
 838                if y>290 then\r
 839                   y:=60;\r
 840                   x:=x+240;\r
 841                fi;\r
 842  \r
 843                call go4(elem.left);\r
 844                call go4(elem.right);\r
 845             fi;\r
 846       end go4;\r
 847       begin\r
 848          call CLR;\r
 849          if actual=none then\r
 850             call BOX(250,150,250,30);\r
 851             call BOX(248,148,254,34);\r
 852             call move(270,160);\r
 853             call OUTHLINE(unpack("YOU CAN'T USE PREFIX NOW !"));\r
 854          else\r
 855             call box (260,10,200,30);\r
 856             call box (258,8,204,34);\r
 857             call move (300,20);\r
 858             call outhline(sa("PREFIX"));\r
 859             call box(20,50,200,250);\r
 860             call box(260,50,200,250);\r
 861  \r
 862             x:=50;\r
 863             y:=60;\r
 864             if actual.tre=none then\r
 865                call outhline(sa(" TREE IS EMPTY "));\r
 866             else\r
 867                call go4(actual.tre);\r
 868             fi;\r
 869          fi;\r
 870         i:=inchar;\r
 871         call DRAWMENU(pointer);\r
 872    end prefix;\r
 873  \r
 874    unit INFIX:procedure;\r
 875  \r
 876       var h:node;\r
 877       var i:integer;\r
 878       var x,y:integer;\r
 879       unit go4:procedure(elem:node);\r
 880          begin\r
 881             if elem=/=none then\r
 882  \r
 883                call go4(elem.left);\r
 884                call move(x,y);\r
 885                call outhline(elem.e);\r
 886                y:=y+10;\r
 887                if y>290 then\r
 888                   y:=60;\r
 889                   x:=x+240;\r
 890                fi;\r
 891                call go4(elem.right);\r
 892             fi;\r
 893       end go4;\r
 894       begin\r
 895          call CLR;\r
 896          if actual=none then\r
 897             call BOX(250,150,250,30);\r
 898             call BOX(248,148,254,34);\r
 899             call move(270,160);\r
 900             call OUTHLINE(unpack("YOU CAN'T USE INFIX NOW !"));\r
 901          else\r
 902             call box (260,10,200,30);\r
 903             call box (258,8,204,34);\r
 904             call move (300,20);\r
 905             call outhline(sa("INFIX"));\r
 906             call box(20,50,200,250);\r
 907             call box(260,50,200,250);\r
 908  \r
 909             x:=50;\r
 910             y:=60;\r
 911             if actual.tre=none then ;\r
 912                call outhline(sa(" TREE IS EMPTY "));\r
 913             else\r
 914                call go4(actual.tre);\r
 915             fi;\r
 916          fi;\r
 917          i:=inchar;\r
 918          call DRAWMENU(pointer);\r
 919    end infix;\r
 920  \r
 921    unit POSTFIX:procedure;\r
 922       var h:node;\r
 923       var i:integer;\r
 924       var x,y:integer;\r
 925       unit go4:procedure(elem:node);\r
 926          begin\r
 927             if elem=/=none then\r
 928  \r
 929                call go4(elem.left);\r
 930                call go4(elem.right);\r
 931  \r
 932                call move(x,y);\r
 933                call outhline(elem.e);\r
 934                y:=y+10;\r
 935                if y>290 then\r
 936                   y:=60;\r
 937                   x:=x+240;\r
 938                fi;\r
 939             fi;\r
 940       end go4;\r
 941       begin\r
 942          call CLR;\r
 943          call color(12);\r
 944          if actual=none then\r
 945             call BOX(250,150,250,30);\r
 946             call BOX(248,148,254,34);\r
 947             call move(270,160);\r
 948             call OUTHLINE(unpack("YOU CAN'T USE POSTFIX NOW !"));\r
 949          else\r
 950             call box (260,10,200,30);\r
 951             call box (258,8,204,34);\r
 952             call move (300,20);\r
 953             call outhline(sa("POSTFIX"));\r
 954             call box(20,50,200,250);\r
 955             call box(260,50,200,250);\r
 956  \r
 957             x:=50;\r
 958             y:=60;\r
 959             if actual.tre=none then\r
 960                 call outhline(sa(" TREE IS EMPTY "));\r
 961             else\r
 962                call go4(actual.tre);\r
 963             fi;\r
 964          fi;\r
 965          i:=inchar;\r
 966          call DRAWMENU(pointer);\r
 967    end postfix;\r
 968  \r
 969    unit equal:function(a1:arrayof char, a2:arrayof char):boolean;\r
 970  \r
 971       var len1,len2:integer;\r
 972       var i:integer;\r
 973  \r
 974       begin\r
 975          len1:=upper(a1);\r
 976          len2:=upper(a2);\r
 977          if len1=/=len2 then\r
 978             result:=false\r
 979          else\r
 980             result:=true;\r
 981             for i:=1 to len1 do\r
 982                if ord(a1(i))=/=ord(a2(i)) then\r
 983                   result:=false;\r
 984                fi;\r
 985             od;\r
 986          fi;\r
 987  \r
 988    end equal;\r
 989  \r
 990    unit less:function(a1:arrayof char,a2:arrayof char):boolean;\r
 991       var len1,len2:integer;\r
 992       var i:integer;\r
 993  \r
 994       begin\r
 995          len1:=upper(a1);\r
 996          len2:=upper(a2);\r
 997          if len1>len2 then\r
 998             result:=false;\r
 999          else\r
1000             result:=true;\r
1001             if len1=len2 then\r
1002                i:=1;\r
1003                if not equal(a1,a2) then\r
1004                    while ord(a1(i))=ord(a2(i)) do\r
1005                          i:=i+1;\r
1006                    od;\r
1007                   if ord(a1(i))>ord(a2(i)) then result:=false; fi;\r
1008  \r
1009                fi;\r
1010             fi;\r
1011          fi;\r
1012    end less;\r
1013  \r
1014    var v:arrayof char;\r
1015    var elem:node;\r
1016    var pointer:menu;\r
1017    var x,y:integer;\r
1018    var ii:integer;\r
1019    var actual:head;\r
1020    var tree:head;\r
1021  \r
1022    begin\r
1023  \r
1024       call gron(0);\r
1025       call color(14);\r
1026       call BOX(210,110,260,80);\r
1027       call BOX(208,108,264,84);\r
1028  \r
1029       v:=sa("Binary Search Tree Scanner");\r
1030       call move(240,125);\r
1031       call outhline(v);\r
1032       v:=sa("written by Peter Miekus");\r
1033       call move(250,145);\r
1034       call outhline(v);\r
1035       v:=sa("January 6,1989 Ver. 1.0");\r
1036       call move(250,165);\r
1037       call outhline(v);\r
1038       v:=sa("Hit any key to start");\r
1039       call move(50,300);\r
1040       call outhline(v);\r
1041       ii:=inchar;\r
1042  \r
1043       call cls;\r
1044       call color(2);\r
1045       call directory;\r
1046       call drawmenu(pointer);\r
1047       call choose;\r
1048       call groff;\r
1049  \r
1050 end;\r
1051  \r
1052  \r
1053 end\r