examples/data_str/bst3.log

   1 program drzewo;\r
   2   \r
   3   \r
   4   var num: integer;\r
   5   var op: boolean;\r
   6   var korzen: node;\r
   7   \r
   8     \r
   9   unit  sc : procedure(row, column : integer);\r
  10     var c,d,e,f  : char,\r
  11         i,j : integer;\r
  12   begin\r
  13     i := row div 10;\r
  14     j := row mod 10;\r
  15     c := chr(48+i);\r
  16     d := chr(48+j);\r
  17     i := column div 10;\r
  18     j := column mod 10;\r
  19     e := chr(48+i);\r
  20     f := chr(48+j);\r
  21     write( chr(27), "[", c, d, ";", e, f, "H")\r
  22   end sc;\r
  23 \r
  24   unit inchar : IIUWgraph function : integer;\r
  25     (*podaj nr znaku przeslanego z klawiatury *)\r
  26     var i : integer;\r
  27   begin\r
  28     do\r
  29       i := inkey;\r
  30       if i <> 0 then exit fi;\r
  31     od;\r
  32     result := i;\r
  33   end inchar;\r
  34 \r
  35   unit node: class (e: integer);\r
  36     var left, right: node\r
  37   end node;\r
  38   \r
  39   unit search: class (inout gdzie: node, co: integer);\r
  40     var pom: node, pom2: node;\r
  41     var czyjest: boolean\r
  42   begin\r
  43     pom:=gdzie;\r
  44     while pom=/=none \r
  45     do\r
  46       if pom.e=co\r
  47       then exit\r
  48       fi;\r
  49       pom2:=pom;\r
  50       if pom.e>co\r
  51       then pom:=pom.left\r
  52       else pom:=pom.right\r
  53       fi\r
  54     od;\r
  55     if pom=/=none\r
  56     then czyjest:=true\r
  57     fi\r
  58   end search;\r
  59   \r
  60   unit np : procedure;\r
  61   begin\r
  62     write( chr(27), "[2J")\r
  63   end np;\r
  64         \r
  65   unit cll: procedure (k: integer);\r
  66     unit EraseLine : procedure;\r
  67       begin\r
  68         write( chr(27), "[K")\r
  69     end EraseLine;\r
  70   begin\r
  71     call sc(k,1);\r
  72     call EraseLine\r
  73   end cll;\r
  74   \r
  75   unit ramka: procedure (w1, w2, w3, k1, k2: integer);\r
  76     var i: integer;\r
  77   begin\r
  78     call sc(w1,k1);\r
  79     write ("Ú");\r
  80     for i:=k1+1 to k2-1\r
  81     do\r
  82       write ("Ä")\r
  83     od;\r
  84     write ("¿");\r
  85     for i:=w1+1 to w3-1\r
  86     do\r
  87       call sc(i,k1);\r
  88       write ("³");\r
  89       call sc(i,k2);\r
  90       write ("³")\r
  91     od;\r
  92     if w2 > 0\r
  93     then\r
  94       call sc(w2,k1);\r
  95       write ("Ã");\r
  96       for i:=k1+1 to k2-1\r
  97       do\r
  98         write ("Ä")\r
  99       od;\r
 100       write ("´")\r
 101     fi;\r
 102     call sc (w3,k1);\r
 103     write ("À");\r
 104     for i:=k1+1 to k2-1\r
 105     do write ("Ä") od;\r
 106     write ("Ù")\r
 107   end ramka;\r
 108   \r
 109   unit menu: procedure;\r
 110   begin\r
 111     call np;\r
 112     call ramka (1,5,21,10,70);\r
 113     call sc(3,33);\r
 114     write ("M   E   N   U");\r
 115     call sc(7,15);\r
 116     write ("1.   Wstawienie elementu do drzewa");\r
 117     call sc(9,15);\r
 118     write ("2.   Usuniecie elementu z drzewa");\r
 119     call sc(11,15);\r
 120     write ("3.   Sprawdzenie, czy element jest w drzewie");\r
 121     call sc(13,15);\r
 122     write ("4.   Sprawdzenie, czy drzewo jest puste");\r
 123     call sc(15,15);\r
 124     write ("5.   Drukowanie drzewa w postaci grafu");\r
 125     call sc(17,15);\r
 126     write ("6.   Drukowanie drzewa w postaci listy elementow");\r
 127     call sc(19,15);\r
 128     write ("7.   Wyjscie")\r
 129   end menu;\r
 130   \r
 131   unit wprowliczbe: procedure (output liczba: integer, jest: boolean);\r
 132     var znak: char;\r
 133     var minus,l: boolean;\r
 134     var t, k: integer;\r
 135     var m,z: char;\r
 136     \r
 137     unit cyfra: function (z: char): boolean;\r
 138     begin\r
 139       if ord(z) >= ord('0') and ord(z) <= ord('9')\r
 140       then result:=true\r
 141       fi\r
 142     end cyfra;\r
 143     \r
 144     unit alarm: procedure;\r
 145     begin\r
 146       writeln;\r
 147       write ("To nie jest liczba calkowita");\r
 148       call beep\r
 149     end alarm;\r
 150   \r
 151   begin\r
 152     t:=0;\r
 153     z:='0';\r
 154     k:=inchar;\r
 155     znak:=chr(k);\r
 156     m:='-';\r
 157     if znak=m\r
 158     then\r
 159       minus:=true;\r
 160       write ("-")\r
 161     else\r
 162       if not cyfra(znak)         \r
 163       then \r
 164         call alarm;\r
 165         return\r
 166       else\r
 167         write (znak); \r
 168         t:=t+ord(znak)-ord(z);\r
 169         l:=true\r
 170       fi\r
 171     fi;\r
 172     do\r
 173       k:=inchar;\r
 174       if k=013     (*  enter  *)\r
 175       then \r
 176         jest:=l;\r
 177         if minus\r
 178         then\r
 179           liczba:=-t\r
 180         else\r
 181           liczba:=t;\r
 182         fi;\r
 183         exit\r
 184       else\r
 185         if not cyfra (chr(k))\r
 186         then \r
 187           call alarm;\r
 188           return\r
 189         else\r
 190           write (chr(k));\r
 191           l:=true;\r
 192           t:=10*t+k-ord('0');\r
 193         fi\r
 194       fi\r
 195     od\r
 196   end wprowliczbe;\r
 197   \r
 198   unit podkresl: procedure (k1, k2, opcja: integer, czym: char);\r
 199     var i, j, co: integer;\r
 200   begin\r
 201     co:=5+2*opcja;\r
 202     for i:=co-1 step 2 to co+1 \r
 203     do\r
 204       call sc(i,k1+1);\r
 205       for j:=k1+1 to k2-1\r
 206       do\r
 207         write (czym)\r
 208       od\r
 209     od\r
 210   end podkresl;\r
 211   \r
 212   unit robzsearch: procedure (r: integer);\r
 213     var elem: integer;\r
 214     var licz: boolean;\r
 215     \r
 216     unit insert: search procedure;\r
 217       var nowy: node;\r
 218     begin\r
 219       if not czyjest\r
 220       then\r
 221         nowy:=new node(co);\r
 222         if gdzie=none\r
 223         then\r
 224           gdzie:=nowy\r
 225         else\r
 226           if pom2.e>co\r
 227           then pom2.left:=nowy\r
 228           else pom2.right:=nowy\r
 229           fi\r
 230         fi\r
 231       fi\r
 232     end insert;\r
 233     \r
 234     unit delete: search procedure;\r
 235       var p1, p2: node;\r
 236       \r
 237       unit przestaw: procedure (naco: node);\r
 238       begin\r
 239         if pom=gdzie\r
 240         then     (*  usuwamy korzen  *)\r
 241           gdzie:=naco\r
 242         else\r
 243           if pom2.left=pom\r
 244           then pom2.left:=naco\r
 245           else pom2.right:=naco\r
 246           fi\r
 247         fi\r
 248       end przestaw;\r
 249       \r
 250     begin\r
 251       if czyjest \r
 252       then\r
 253         if pom.left=none\r
 254         then \r
 255           call przestaw (pom.right)\r
 256         else\r
 257           if pom.right=none\r
 258           then\r
 259             call przestaw (pom.left)\r
 260           else     (*  usuwany wezel ma dwoch synow  *)\r
 261             if pom.right.left=none\r
 262             then\r
 263               call przestaw(pom.right);\r
 264               pom.right.left:=pom.left\r
 265             else\r
 266               p1:=pom.right;\r
 267               p2:=p1.left;\r
 268               while p2.left=/=none\r
 269               do\r
 270                 p1:=p1.left;\r
 271                 p2:=p2.left\r
 272               od;\r
 273               p1.left:=p2.right;\r
 274               p2.left:=pom.left;\r
 275               p2.right:=pom.right;\r
 276               call przestaw (p2)\r
 277             fi\r
 278           fi\r
 279         fi\r
 280       fi\r
 281     end delete;\r
 282     \r
 283     unit member: search procedure;\r
 284       var kon: integer;\r
 285     begin\r
 286       call cll(24);\r
 287       if czyjest\r
 288       then\r
 289         write ("Ten element jest w drzewie     ")\r
 290       else\r
 291         write ("Tego elementu nie ma w drzewie     ") \r
 292       fi;\r
 293       kon:=inchar\r
 294     end member;\r
 295     \r
 296   begin     (*  robzsearch  *)\r
 297     call cll(24);\r
 298     write ("Podaj element     ");\r
 299     call wprowliczbe (elem,licz);\r
 300     if not licz\r
 301     then\r
 302       return\r
 303     else\r
 304       case r\r
 305         when 1 : call insert (korzen,elem);\r
 306         when 2 : call delete (korzen,elem);\r
 307         when 3 : call member (korzen,elem)\r
 308       esac\r
 309     fi\r
 310   end robzsearch;\r
 311   \r
 312   unit empty: procedure (k: node);\r
 313     var kon: integer;\r
 314   begin\r
 315     call cll(24);\r
 316     if k=none\r
 317     then\r
 318       write ("Drzewo jest puste     ")\r
 319     else\r
 320       write ("Drzewo nie jest puste     ")\r
 321     fi;\r
 322     kon:=inchar\r
 323   end empty;\r
 324   \r
 325   unit drukuj: procedure;\r
 326     var s: char;\r
 327     var g, ko: integer;\r
 328     var h: boolean;\r
 329     var x: search;\r
 330     \r
 331     unit druk: procedure (kor: node);\r
 332       var kondruk: boolean;\r
 333       \r
 334       unit dlugi: function (k: node): boolean;\r
 335       begin\r
 336         if k=/=none\r
 337         then\r
 338           result:=k.e>99 or k.e<-9 or dlugi(k.left) or dlugi(k.right)\r
 339         fi\r
 340       end dlugi;\r
 341       \r
 342       unit krotkidruk: procedure (wiersz, pocz, kon: integer; drzewo: node);\r
 343         var y, i, z: integer;\r
 344       begin\r
 345         z:= (kon+pocz-1) div 2;\r
 346         call ramka (wiersz, 0, wiersz+2, z-1, z+2);\r
 347         if wiersz=/=1\r
 348         then\r
 349           call sc(wiersz,z);\r
 350           write ("Á")\r
 351         fi;\r
 352         call sc(wiersz+1,z);\r
 353         write (drzewo.e:2);\r
 354         if drzewo.left=/=none\r
 355         then \r
 356           if wiersz=21\r
 357           then kondruk:=true\r
 358           else      (*  drukowanie lewego poddrzewa  *)\r
 359             y:= (z+pocz-1) div 2;\r
 360             call sc (wiersz+4,y);\r
 361             write ("Ú");\r
 362             for i:=y+1 to z-1\r
 363             do\r
 364               write ("Ä")\r
 365             od;\r
 366             write ("Ù");\r
 367             call sc(wiersz+3,z);\r
 368             write ("³");\r
 369             call sc(wiersz+2,z);\r
 370             write ("Â");\r
 371             call krotkidruk (wiersz+5,pocz,z,drzewo.left)\r
 372           fi\r
 373         fi;\r
 374         if drzewo.right=/=none\r
 375         then\r
 376           if wiersz=21\r
 377           then kondruk:=true\r
 378           else     (*  drukowanie prawego poddrzewa  *)\r
 379             y:= (kon+z) div 2;\r
 380             call sc(wiersz+2,z+1);\r
 381             write ("Â");\r
 382             call sc(wiersz+3,z+1);\r
 383             write ("³");\r
 384             call sc(wiersz+4,z+1);\r
 385             write ("À");\r
 386             for i:=z+2 to y-1\r
 387             do\r
 388               write ("Ä")\r
 389             od;\r
 390             write ("¿");\r
 391             call krotkidruk (wiersz+5,z+1,kon,drzewo.right)\r
 392           fi\r
 393         fi\r
 394       end krotkidruk;\r
 395       \r
 396       unit dlugidruk: procedure (wiersz, pocz, kon: integer, drzewo: node);\r
 397         var y, i, z: integer;\r
 398       begin\r
 399         z:= (kon+pocz-1) div 2;\r
 400         call ramka (wiersz, 0, wiersz+2, z-4,  z+4);\r
 401         if wiersz=/=1\r
 402         then\r
 403           call sc(wiersz,z);\r
 404           write ("Á")\r
 405         fi;\r
 406         call sc(wiersz+1,z-3);\r
 407         write (drzewo.e:7);\r
 408         if drzewo.left=/=none\r
 409         then\r
 410           if wiersz=19\r
 411           then \r
 412             kondruk:=true\r
 413           else     (*  drukowanie lewego poddrzewa  *)\r
 414             y:= (z+pocz-1) div 2;\r
 415             call sc(wiersz+5,y);\r
 416             write ("³");\r
 417             call sc(wiersz+4,y);\r
 418             write ("Ú");\r
 419             for i:=y+1 to z-3\r
 420             do\r
 421               write ("Ä")\r
 422             od;\r
 423             write ("Ù");\r
 424             call sc(wiersz+3,z-2);\r
 425             write ("³");\r
 426             call sc(wiersz+2,z-2);\r
 427             write ("Â");\r
 428             call dlugidruk (wiersz+6, pocz, z, drzewo.left)\r
 429           fi\r
 430         fi;\r
 431         if drzewo.right=/=none\r
 432         then\r
 433           if wiersz=19\r
 434           then\r
 435             kondruk:=true\r
 436           else     (*  drukowanie prawego poddrzewa  *)\r
 437             y:= (kon+z) div 2;\r
 438             call sc (wiersz+2,z+2);\r
 439             write  ("Â");\r            call sc(wiersz+3,z+2);\r
 440             write ("³");\r
 441             call sc(wiersz+4,z+2);\r
 442             write ("À");\r
 443             for i:=z+3 to y-1\r
 444             do\r
 445               write ("Ä")\r
 446             od;\r
 447             write ("¿");\r
 448             call sc(wiersz+5,y);\r
 449             write ("³");\r
 450             call dlugidruk (wiersz+6, z+1, kon, drzewo.right)\r
 451           fi\r
 452         fi\r
 453       end dlugidruk;\r
 454       \r
 455     begin     (*  druk  *)\r
 456       call np;\r
 457       if dlugi (kor)\r
 458       then\r
 459         call dlugidruk(1,1,80,kor)\r
 460       else\r
 461         call krotkidruk(1,1,80,kor)\r
 462       fi;\r
 463       if kondruk\r
 464       then\r
 465         call sc(25,1);\r
 466         write ("Dalsza czesc drzewa nie miesci sie na ekranie     ");\r
 467       fi\r
 468     end druk;\r
 469     \r
 470   begin     (*  drukuj  *)\r
 471     call cll(24);\r
 472     if korzen=none\r
 473     then\r
 474       write ("Drzewo jest puste")\r
 475     else\r
 476       write ("Czy chcesz obejrzec drzewo od korzenia ?");\r
 477       ko:=inchar;\r
 478       s:=chr(ko);\r
 479       if s=/='n'\r
 480       then\r
 481         call druk (korzen)\r
 482       else\r
 483         call cll(24);\r
 484         write ("Podaj korzen poddrzewa, ktore chcesz obejrzec     ");\r
 485         call wprowliczbe (g,h);\r
 486         if not h \r
 487         then\r
 488           return\r
 489         else\r
 490           x:=new search (korzen,g);\r
 491           if not x.czyjest\r
 492           then\r
 493             call cll(24);\r
 494             write ("Tego elementu nie ma w drzewie     ");\r
 495             kill (x)\r
 496           else\r
 497             call druk (x.pom);\r
 498             kill (x)\r
 499           fi\r
 500         fi\r
 501       fi\r
 502     fi;\r
 503     ko:=inchar\r
 504   end drukuj;\r
 505   \r
 506   unit fix: procedure (k: node);\r
 507     var n, kon: integer;\r
 508     var f: boolean;\r
 509     \r
 510     unit prefix: procedure (d: node);\r
 511     begin\r
 512       if d=/=none\r
 513       then\r
 514         write (d.e);\r
 515         write ("  ,  ");\r
 516         call prefix (d.left);\r
 517         call prefix (d.right)\r
 518       fi\r
 519     end prefix;\r
 520     \r
 521     unit infix: procedure (d: node);\r
 522     begin\r
 523       if d=/=none\r
 524       then\r
 525         call infix (d.left);\r
 526         write (d.e);\r
 527         write ("  ,  ");\r
 528         call infix (d.right)\r
 529       fi\r
 530     end infix;\r
 531     \r
 532     unit postfix: procedure (d: node);\r
 533     begin\r
 534       if d=/=none\r
 535       then\r
 536         call postfix (d.left);\r
 537         call postfix (d.right);\r
 538         write (d.e);\r
 539         write ("  ,  ")\r
 540       fi\r
 541     end postfix;\r
 542     \r
 543   begin     (*  fix  *)\r
 544     if k=none\r
 545     then\r
 546       writeln;\r
 547       write ("Drzewo jest puste")\r
 548     else\r
 549       call np;\r
 550       call ramka (1,5,13,30,49);\r
 551       call sc(3,35);\r
 552       write ("M  E  N  U");\r
 553       call sc(7,33);\r
 554       write ("1.  prefix");\r
 555       call sc(9,33);\r
 556       write ("2.  infix");\r
 557       call sc(11,33);\r
 558       write ("3.  postfix");\r
 559       call sc(24,1);\r
 560       write ("Podaj numer opcji     ");\r
 561       call wprowliczbe (n,f);\r
 562       if f andif (n >= 1 and n <= 3)\r
 563       then\r
 564         call podkresl (30,49,n,'.');\r
 565         call cll(24);\r
 566         call sc(17,1);\r
 567         case n\r
 568           when 1 : call prefix (korzen);\r
 569           when 2 : call infix (korzen);\r
 570           when 3 : call postfix (korzen)\r
 571         esac\r
 572       fi;\r
 573     fi;\r
 574     write("     ");\r
 575     kon:=inchar\r
 576   end fix;\r
 577   \r
 578   unit czekaj: procedure;\r
 579     var t, k: integer;\r
 580   begin\r
 581     t:=time;\r
 582     k:=time;\r
 583     while k-t<2\r
 584     do\r
 585       k:=time\r
 586     od\r
 587   end czekaj;\r
 588   \r
 589   unit beep: procedure;\r
 590   begin\r
 591     write ("\a\a\a\a")\r
 592   end beep;\r
 593   \r
 594   unit zakonczenie: procedure;\r
 595     var i, j, t, k: integer;\r
 596   begin\r
 597     for i:=9 to 15 \r
 598     do\r
 599       call cll(i)\r
 600     od;\r
 601     for i:=10 step 4 to 14 \r
 602     do\r
 603       call sc(i,10);\r
 604       for j:=10 to 70\r
 605       do\r
 606         write ('*')\r
 607       od\r
 608     od;\r
 609     for i:=10 step 60 to 70 \r
 610     do\r
 611       for j:=11 to 13\r
 612       do\r
 613         call sc(j,i);\r
 614         write ('*')\r
 615       od\r
 616     od;\r
 617     call sc(12,33);\r
 618     write ("DO ZOBACZENIA          ");\r
 619     call czekaj;\r
 620     call endrun\r
 621   end zakonczenie;\r
 622   \r
 623   \r
 624 begin     (*  program glowny  *)\r
 625   call menu;\r
 626   do\r
 627     call cll(25);\r
 628     call cll(24);\r
 629     write ("Podaj numer opcji      ");\r
 630     call wprowliczbe (num,op);\r
 631     if not op\r
 632     then  \r
 633       repeat\r
 634     fi;\r
 635     if num < 1 or num > 7\r
 636     then  \r
 637       call beep;\r
 638       repeat\r
 639     fi;\r
 640     call podkresl (10,70,num,'.');\r
 641     case num\r
 642       when 1 : call robzsearch (1);     (*  insert  *)\r
 643       when 2 : call robzsearch (2);     (*  delete  *)\r
 644       when 3 : call robzsearch (3);     (*  member  *)\r
 645       when 4 : call empty (korzen);\r
 646       when 5 : call drukuj;\r
 647       when 6 : call fix (korzen)\r
 648     esac;\r
 649     if num=5 or num=6\r
 650     then\r
 651       call menu\r
 652     else\r
 653       call podkresl (10,70,num,' ')\r
 654     fi;\r
 655     if num=7\r
 656     then\r
 657       call zakonczenie\r
 658     fi\r
 659   od\r
 660 end drzewo\r
 661 \r
 662           \r
 663 \1a