examples/data_str/2_3kujaw.log

   1 program drzewo;\r
   2 (*-----------------------------------------------------------------------*)\r
   3 (*              2-3 tree   J.Kujawski   1989-90                          *)\r
   4 (*-----------------------------------------------------------------------*)\r
   5  \r
   6 CONST min = 0 ,\r
   7       max = 99 ,\r
   8       lewy = ".lsyn" ,\r
   9       prawy = ".psyn" ,\r
  10       srodkowy = ".ssyn" ;\r
  11  \r
  12 (*-----------------------------------------------------------------------*)\r
  13  \r
  14 VAR\r
  15    node   :drzewo ,\r
  16    i,j    : integer ;\r
  17  \r
  18 (*-----------------------------------------------------------------------*)\r
  19  \r
  20 SIGNAL emptytree ;\r
  21  \r
  22 (*-----------------------------------------------------------------------*)\r
  23  \r
  24 UNIT drzewo:class;\r
  25  \r
  26   Var klucz:integer,\r
  27       lsyn,psyn:drzewo,\r
  28       logl,logp:boolean;\r
  29  \r
  30   Unit lisc : function :boolean ;\r
  31       begin\r
  32         result := lsyn = none\r
  33   end lisc\r
  34 end drzewo;\r
  35  \r
  36  \r
  37  \r
  38 (*-----------------------------------------------------------------------*)\r
  39  \r
  40 UNIT licznosc :function (d:drzewo , p:integer , log:boolean):integer ;\r
  41  \r
  42 (* Liczy ile miejsca potrzeba do wydruku linii *)\r
  43  \r
  44 Var licznik : integer ;\r
  45  \r
  46 Signal alarm ;\r
  47  \r
  48  \r
  49 Unit licz :procedure (d:drzewo) ;\r
  50  begin\r
  51     i := i+1 ;\r
  52     if d = none then raise alarm fi;\r
  53     if i = p then\r
  54        if log then licznik := licznik + 1\r
  55        else\r
  56           if d.logp then\r
  57                 licznik := licznik + 6\r
  58           else\r
  59                 licznik := licznik + 3  ;\r
  60           fi\r
  61        fi\r
  62     else\r
  63        call licz (d.lsyn) ;\r
  64        if d.logp then\r
  65           call licz(d.psyn.lsyn) ;\r
  66           call licz(d.psyn.psyn) ;\r
  67        else\r
  68           call licz(d.psyn)\r
  69        fi\r
  70     fi ;\r
  71     i := i-1\r
  72 end licz ;\r
  73  \r
  74 Handlers\r
  75  when alarm : licznik := 0 ;\r
  76          wind\r
  77 end handlers ;\r
  78  \r
  79 Begin\r
  80   licznik :=0 ;\r
  81   i := 0 ;\r
  82   call licz (d) ;\r
  83   result := licznik\r
  84 end licznosc ;\r
  85  \r
  86 (*-----------------------------------------------------------------------*)\r
  87  \r
  88 UNIT infix :procedure(d : drzewo) ;\r
  89  \r
  90 Begin\r
  91   if d.lisc then\r
  92       write(d.klucz:3)\r
  93   else\r
  94      call infix (d.lsyn );\r
  95      call infix (d.psyn )\r
  96   fi\r
  97 end infix ;\r
  98  \r
  99 (*-----------------------------------------------------------------------*)\r
 100  \r
 101 UNIT empty : function (d : drzewo) : boolean ;\r
 102    Begin\r
 103       result := d = none\r
 104 End empty ;\r
 105  \r
 106  \r
 107 (*-----------------------------------------------------------------------*)\r
 108  \r
 109 UNIT minimum : function (d : drzewo) : integer ;\r
 110  \r
 111 Begin\r
 112    if d = none then\r
 113       raise emptytree\r
 114    else\r
 115       if d.lisc then\r
 116          result := d.klucz\r
 117       else\r
 118          result := minimum (d.lsyn)\r
 119       fi\r
 120    fi\r
 121 end minimum ;\r
 122  \r
 123  \r
 124 (*-----------------------------------------------------------------------*)\r
 125  \r
 126 UNIT member : function ( k:integer , d:drzewo ) : boolean ;\r
 127  \r
 128   Begin\r
 129     if d <> none   then\r
 130       if d.klucz <> k then\r
 131         if  d.klucz < k  then\r
 132             result := member(k,d.psyn);\r
 133         else\r
 134             result := member(k,d.lsyn);\r
 135         fi\r
 136       else\r
 137          result := true\r
 138       fi\r
 139     else\r
 140          result := false\r
 141     fi\r
 142   end  member ;\r
 143  \r
 144 (*-----------------------------------------------------------------------*)\r
 145  \r
 146 UNIT insert : procedure ( k : integer ; inout d : drzewo ) ;\r
 147  \r
 148 Var pom1,pom2 : drzewo ,\r
 149     max1,max2 : integer ;\r
 150  \r
 151 Signal jest ;\r
 152  \r
 153 Unit ins : procedure ( a:drzewo ) ;\r
 154 Begin\r
 155   if a.klucz = k then raise jest\r
 156   fi ;\r
 157   if a.lisc then\r
 158      pom1 := new drzewo ;\r
 159      if a.klucz < k then\r
 160          pom1.klucz := k ;\r
 161          max1 := a.klucz\r
 162      else\r
 163          pom1.klucz := a.klucz ;\r
 164          max1 := k ;\r
 165          a.klucz := k\r
 166      fi\r
 167   else\r
 168      if k <= a.klucz then\r
 169         call ins (a.lsyn ) ;\r
 170         if pom1 <> none then\r
 171            if a.logl then\r
 172               pom2 := a.psyn ;\r
 173               a.psyn := pom1 ;\r
 174               max2 := a.klucz ;\r
 175               a.klucz := max1 ;\r
 176               max1 := max2 ;\r
 177               pom1 := pom2\r
 178            else\r
 179               if a.logp then\r
 180                  pom2 := a.psyn ;\r
 181                  a.psyn := pom1 ;\r
 182                  max2 := a.klucz ;\r
 183                  a.klucz := max1 ;\r
 184                  max1 := max2 ;\r
 185                  pom1 := pom2 ;\r
 186                  a.logp,pom1.logl := false\r
 187               else\r
 188                  pom2 := new drzewo ;\r
 189                  pom2.lsyn := pom1 ;\r
 190                  pom2.psyn := a.psyn ;\r
 191                  pom2.klucz := a.klucz ;\r
 192                  a.klucz := max1 ;\r
 193                  pom2.logl,a.logp := true ;\r
 194                  a.psyn := pom2 ;\r
 195                  pom1 := none\r
 196               fi\r
 197            fi\r
 198         fi\r
 199      else\r
 200         call ins (a.psyn) ;\r
 201         if pom1 <> none then\r
 202            if a.logp then\r
 203               pom2 := a.psyn ;\r
 204               a.psyn := a.psyn.lsyn ;\r
 205               pom2.lsyn := pom2.psyn ;\r
 206               pom2.psyn := pom1 ;\r
 207               max2 := max1 ;\r
 208               max1 := pom2.klucz ;\r
 209               pom2.klucz := max2 ;\r
 210               pom1 := pom2 ;\r
 211               pom1.logl,a.logp := false\r
 212            else\r
 213               if not a.logl then\r
 214                  pom2 := new drzewo ;\r
 215                  pom2.psyn := pom1 ;\r
 216                  pom2.lsyn := a.psyn ;\r
 217                  a.psyn := pom2 ;\r
 218                  pom2.klucz := max1 ;\r
 219                  a.logp,pom2.logl := true ;\r
 220                  pom1 := none\r
 221               fi\r
 222            fi\r
 223         fi\r
 224      fi\r
 225   fi\r
 226 end ins ;\r
 227  \r
 228 Handlers\r
 229    when jest : call setcursor(20,1) ;\r
 230                call eraseline ;\r
 231                writeln("element ",k:2," already in this tree") ;\r
 232                call setcursor (25,30) ;\r
 233                call reverse ;\r
 234                write ("press any key") ;\r
 235                call cursorleft (1) ;\r
 236                call normal ;\r
 237                call czekaj ;\r
 238                call setcursor (25,30) ;\r
 239                call eraseline ;\r
 240                call setcursor (20,1) ;\r
 241                call eraseline ;\r
 242                terminate\r
 243 end handlers ;\r
 244  \r
 245 Begin\r
 246   if d=none then\r
 247      d := new drzewo ;\r
 248      d.klucz := k\r
 249   else\r
 250      call ins (d) ;\r
 251      if pom1 <> none then\r
 252         pom2 := new drzewo ;\r
 253         pom2.klucz := max1 ;\r
 254         pom2.lsyn := d ;\r
 255         pom2.psyn := pom1 ;\r
 256         d := pom2\r
 257       fi\r
 258   fi\r
 259 end insert ;\r
 260  \r
 261 (*-----------------------------------------------------------------------*)\r
 262  \r
 263 UNIT delete:procedure(k:integer;inout d:drzewo);\r
 264  \r
 265   Var pom,pom1 : drzewo ,\r
 266   nowymax      : integer ,\r
 267   kon          : boolean ;\r
 268  \r
 269   Signal  koniec ,niema ;\r
 270  \r
 271   Unit del : procedure (inout d : drzewo ) ;\r
 272  \r
 273    Begin\r
 274       if d.lisc then\r
 275          if d.klucz = k then\r
 276             kill (d)\r
 277          else\r
 278             raise niema\r
 279          fi\r
 280       else\r
 281          if d.klucz >= k then\r
 282             call del (d.lsyn) ;\r
 283             if kon then\r
 284                raise koniec\r
 285             fi ;\r
 286             if d.lsyn = none then\r
 287                if pom = none then\r
 288                   if d.logp then\r
 289                      pom1 := d ;\r
 290                      d := d.psyn ;\r
 291                      d.logl := false ;\r
 292                      kill (pom1) ;\r
 293                      kon := true\r
 294                   else\r
 295                      pom := d.psyn ;\r
 296                      kill (d)\r
 297                   fi\r
 298                else\r
 299                   if k = d.klucz then\r
 300                      d.klucz := nowymax\r
 301                   fi ;\r
 302                   if d.logp then\r
 303                      if d.psyn.lsyn.logp then\r
 304                         pom1 := d.psyn.lsyn ;\r
 305                         d.psyn.lsyn := d.psyn.lsyn.psyn ;\r
 306                         d.lsyn :=pom ;\r
 307                         pom1.psyn := d.psyn ;\r
 308                         d.psyn := pom1.lsyn ;\r
 309                         pom1.lsyn := d ;\r
 310                         d := pom1 ;\r
 311                         d.logp,d.psyn.logl := false ;\r
 312                         d.lsyn.logp , d.psyn.lsyn.logl := false ;\r
 313                         kon := true\r
 314                      else\r
 315                         pom1 := d.psyn ;\r
 316                         d.lsyn := pom ;\r
 317                         d.psyn := d.psyn.lsyn ;\r
 318                         pom1.lsyn := d ;\r
 319                         d := pom1 ;\r
 320                         d.logl := false ;\r
 321                         d.lsyn.psyn.logl := true ;\r
 322                         pom := none ;\r
 323                         kon := true\r
 324                      fi\r
 325                   else\r
 326                      if d.psyn.logp then\r
 327                         pom1 := d.psyn ;\r
 328                         d.lsyn := pom ;\r
 329                         d.psyn := d.psyn.lsyn ;\r
 330                         pom1.lsyn := d ;\r
 331                         d := pom1 ;\r
 332                         d.logp , d.psyn.logl := false ;\r
 333                         if d.lsyn.logl  then\r
 334                            d.lsyn.logl := false ;\r
 335                            d.logl := true\r
 336                         fi ;\r
 337                         pom := none ;\r
 338                         kon := true\r
 339                      else\r
 340                         d.lsyn := pom ;\r
 341                         d.psyn.logl , d.logp := true ;\r
 342                         pom := d ;\r
 343                         d := none ;\r
 344                      fi\r
 345                   fi\r
 346                fi\r
 347             else\r
 348  \r
 349                if k = d.klucz then d.klucz := nowymax fi;\r
 350                pom := none ;\r
 351                kon := true\r
 352             fi\r
 353          else\r
 354             call del (d.psyn) ;\r
 355             if kon then\r
 356                raise koniec\r
 357             fi ;\r
 358             if d.psyn = none then\r
 359                if pom = none then\r
 360                   nowymax := d.lsyn.klucz ;\r
 361                   pom := d.lsyn ;\r
 362                   kill (d)\r
 363                else\r
 364                   if d.logp then\r
 365                      d.psyn := pom ;\r
 366                      d.logp := false ;\r
 367                      d.psyn.logl := false ;\r
 368                      pom := none\r
 369                   else\r
 370                      if d.lsyn.logp then\r
 371                         pom1 := d.lsyn ;\r
 372                         d.psyn := pom ;\r
 373                         d.lsyn := pom1.psyn.psyn ;\r
 374                         pom1.psyn.psyn := d ;\r
 375                         d := pom1.psyn ;\r
 376                         pom1.psyn := d.lsyn ;\r
 377                         d.lsyn := pom1 ;\r
 378                         d.logl , d.lsyn.logp := false ;\r
 379                         pom := none\r
 380                      else\r
 381                         pom1 := d.lsyn ;\r
 382                         d.psyn := pom ;\r
 383                         d.lsyn := d.lsyn.psyn ;\r
 384                         pom1.psyn :=d ;\r
 385                         pom :=pom1 ;\r
 386                         pom1.logp , pom1.psyn.logl := true ;\r
 387                         d := none ;\r
 388                      fi\r
 389                   fi\r
 390                fi\r
 391             fi\r
 392          fi\r
 393       fi\r
 394    end del ;\r
 395  \r
 396 Handlers\r
 397    when niema  : call setcursor(20,1) ;\r
 398                  writeln("There is no ",k:2," in the tree") ;\r
 399                  call setcursor (25,30) ;\r
 400                  call reverse ;\r
 401                  write ("press any key") ;\r
 402                  call cursorleft (1) ;\r
 403                  call normal ;\r
 404                  call czekaj ;\r
 405                  call setcursor (25,30) ;\r
 406                  call eraseline ;\r
 407                  call setcursor(20,1) ;\r
 408                  call eraseline ;\r
 409                  terminate ;\r
 410    when koniec : terminate\r
 411 end handlers ;\r
 412  \r
 413    Begin\r
 414      if d = none then\r
 415         raise niema\r
 416      else\r
 417         call del (d) ;\r
 418         if pom <> none then\r
 419            d := pom\r
 420         fi\r
 421     fi\r
 422 end delete ;\r
 423  \r
 424 (*-----------------------------------------------------------------------*)\r
 425  \r
 426 Unit delmin : procedure (inout d : drzewo) ;\r
 427  \r
 428    Var a : integer ;\r
 429  \r
 430    Begin\r
 431       if empty (d) then\r
 432          raise emptytree\r
 433       else\r
 434          a := minimum (d) ;\r
 435          call delete (a,d)\r
 436       fi\r
 437 End delmin\r
 438  \r
 439 (*-----------------------------------------------------------------------*)\r
 440 (*                   PROCEDURY prawie GRAFICZNE                          *)\r
 441 (* ----------------------------------------------------------------------*)\r
 442  \r
 443  \r
 444   unit Reverse : procedure;\r
 445   begin\r
 446     write( chr(27), "[7m")\r
 447   end Reverse;\r
 448  \r
 449   unit Normal : procedure;\r
 450   begin\r
 451     write( chr(27), "[0m")\r
 452   end Normal;\r
 453  \r
 454  \r
 455   unit EraseLine : procedure;\r
 456   begin\r
 457     write( chr(27), "[K")\r
 458   end EraseLine;\r
 459  \r
 460   unit inchar : IIUWgraph function : integer;\r
 461     (*podaj nr znaku przeslanego z klawiatury *)\r
 462     var i : integer;\r
 463   begin\r
 464     do\r
 465       i := inkey;\r
 466       if i <> 0 then exit fi;\r
 467     od;\r
 468     result := i;\r
 469   end inchar;\r
 470  \r
 471   unit NewPage : procedure;\r
 472   begin\r
 473     write( chr(27), "[2J")\r
 474   end NewPage;\r
 475  \r
 476   unit  SetCursor : procedure(row, column : integer);\r
 477     var c,d,e,f  : char,\r
 478         i,j : integer;\r
 479   begin\r
 480     i := row div 10;\r
 481     j := row mod 10;\r
 482     c := chr(48+i);\r
 483     d := chr(48+j);\r
 484     i := column div 10;\r
 485     j := column mod 10;\r
 486     e := chr(48+i);\r
 487     f := chr(48+j);\r
 488     write( chr(27), "[", c, d, ";", e, f, "H")\r
 489   end SetCursor;\r
 490  \r
 491   unit CursorLeft : procedure (columns : integer);\r
 492      var e,f  : char,\r
 493         i,j : integer;\r
 494   begin\r
 495     i := columns div 10;\r
 496     j := columns mod 10;\r
 497     e := chr(48+i);\r
 498     f := chr(48+j);\r
 499     write( chr(27), "[", e, f, "D")\r
 500   end CursorLeft;\r
 501  \r
 502   unit CursorRight : procedure (columns : integer);\r
 503     var e,f  : char,\r
 504         i,j : integer;\r
 505   begin\r
 506     i := columns div 10;\r
 507     j := columns mod 10;\r
 508     e := chr(48+i);\r
 509     f := chr(48+j);\r
 510     write( chr(27), "[", e, f, "C")\r
 511   end CursorRight;\r
 512  \r
 513   unit CursorUp : procedure (rows : integer);\r
 514     var c,d  : char,\r
 515         i,j : integer;\r
 516   begin\r
 517     i := rows div 10;\r
 518     j := rows mod 10;\r
 519     c := chr(48+i);\r
 520     d := chr(48+j);\r
 521     write( chr(27), "[", c, d, "A")\r
 522   end CursorUp;\r
 523  \r
 524   unit CursorDown : procedure (rows : integer);\r
 525     var c,d  : char,\r
 526         i,j : integer;\r
 527   begin\r
 528     i := rows div 10;\r
 529     j := rows mod 10;\r
 530     c := chr(48+i);\r
 531     d := chr(48+j);\r
 532     write( chr(27), "[", c, d, "B")\r
 533   end CursorDown;\r
 534  \r
 535 (*-----------------------------------------------------------------------*)\r
 536  \r
 537 UNIT czekaj :procedure ;\r
 538   Var i :integer ;\r
 539   Begin\r
 540     i := inchar\r
 541 End czekaj ;\r
 542  \r
 543 (*-----------------------------------------------------------------------*)\r
 544  \r
 545 unit  PrAnyKey : procedure;\r
 546 begin\r
 547       call setcursor (25,30) ;\r
 548       call reverse ;\r
 549       write ("press any key") ;\r
 550       call cursorleft (1) ;\r
 551       call normal ;\r
 552       call czekaj ;\r
 553       call setcursor (25,30) ;\r
 554       call eraseline ;\r
 555       call setcursor(20,1) ;\r
 556       call eraseline;\r
 557 end PrAnyKey;\r
 558  \r
 559 (*-----------------------------------------------------------------------*)\r
 560 UNIT tytul : procedure ;\r
 561 Begin\r
 562    call newpage ;\r
 563    call setcursor (10,30) ;\r
 564    write ("PRIORITY QUEUE  in  2-3 TREE ") ;\r
 565    call setcursor (15,32) ;\r
 566    write ("Author  :  Adam  Kujawski") ;\r
 567    call PrAnyKey;\r
 568  \r
 569 end tytul ;\r
 570  \r
 571  \r
 572  \r
 573 (*-----------------------------------------------------------------------*)\r
 574  \r
 575 UNIT menu : procedure ;\r
 576  \r
 577 Unit insdelmenu : procedure(formal : boolean) ;\r
 578    Var c1,c2,c3 : integer ;\r
 579  \r
 580    Begin\r
 581       call newpage ;\r
 582       call setcursor (5,25) ;\r
 583       write ("Give a number x to insert ") ;\r
 584       call setcursor (7,25) ;\r
 585       write ( "  0 < x < 100  .") ;\r
 586       call setcursor (9,25) ;\r
 587       writeln ("  0 --- to terminate the operation") ;\r
 588  \r
 589       Do\r
 590         call setcursor(15,39);\r
 591         call eraseline ;\r
 592         c1 := 0 ;\r
 593         c2 := 0 ;\r
 594         do\r
 595            c1 := inchar ;\r
 596            if c1 >= 48 andif c1 <= 57 then\r
 597               write (chr(c1)) ;\r
 598               do\r
 599                  c2 := inchar ;\r
 600                  if c2 >= 48 andif c2 <= 57 then\r
 601                     write (chr (c2)) ;\r
 602                     do\r
 603                        c3 := inchar ;\r
 604                        if c3 = 13 then\r
 605                           j := (c1-48) * 10 + (c2-48) ;\r
 606                           exit exit exit\r
 607                        else\r
 608                           if c3 = 8 then\r
 609                              c2 := 0 ;\r
 610                              call cursorleft(1) ;\r
 611                              call eraseline ;\r
 612                              exit\r
 613                           fi\r
 614                        fi\r
 615                     od\r
 616                  else\r
 617                     if c2 = 13 then\r
 618                        j := c1-48 ;\r
 619                        exit exit\r
 620                     else\r
 621                        if c2 = 8 then\r
 622                           c1 := 0   ;\r
 623                           call cursorleft (1) ;\r
 624                           call eraseline ;\r
 625                           exit\r
 626                        fi\r
 627                     fi\r
 628                  fi\r
 629               od\r
 630            fi\r
 631         od ;\r
 632  \r
 633         if j < 100 andif j > 0 then\r
 634            if formal then\r
 635               call insert (j,node) ;\r
 636            else\r
 637               call delete (j,node) ;\r
 638            fi ;\r
 639            call setcursor(20,1) ;\r
 640            call eraseline ;\r
 641            write ("                              O.K.")\r
 642        else\r
 643            if j = 0 then\r
 644               exit\r
 645            fi\r
 646         fi\r
 647      Od\r
 648   end insdelmenu ;\r
 649  \r
 650 (*----------------------------------------------------------------------*)\r
 651  \r
 652 Unit membermenu : procedure ;\r
 653  \r
 654    Var c1,c2,c3 : integer ,\r
 655        bool1    : boolean ;\r
 656  \r
 657    Begin\r
 658       call newpage ;\r
 659       call setcursor (5,25) ;\r
 660       write ("Give a number x ") ;\r
 661       call setcursor (7,25) ;\r
 662       write ( "  0 < x < 100  .") ;\r
 663       call setcursor (9,25) ;\r
 664       writeln ("  0 --- to terminate the operation") ;\r
 665  \r
 666       Do\r
 667         call setcursor(15,39);\r
 668         call eraseline ;\r
 669         c1 := 0 ;\r
 670         c2 := 0 ;\r
 671         do\r
 672            c1 := inchar ;\r
 673            if c1 >= 48 andif c1 <= 57 then\r
 674               write (chr(c1)) ;\r
 675               do\r
 676                  c2 := inchar ;\r
 677                  if c2 >= 48 andif c2 <= 57 then\r
 678                     write (chr (c2)) ;\r
 679                     do\r
 680                        c3 := inchar ;\r
 681                        if c3 = 13 then\r
 682                           j := (c1-48) * 10 + (c2-48) ;\r
 683                           exit exit exit\r
 684                        else\r
 685                           if c3 = 8 then\r
 686                              c2 := 0 ;\r
 687                              call cursorleft(1) ;\r
 688                              call eraseline ;\r
 689                              exit\r
 690                           fi\r
 691                        fi\r
 692                     od\r
 693                  else\r
 694                     if c2 = 13 then\r
 695                        j := c1-48 ;\r
 696                        exit exit\r
 697                     else\r
 698                        if c2 = 8 then\r
 699                           c1 := 0   ;\r
 700                           call cursorleft (1) ;\r
 701                           call eraseline ;\r
 702                           exit\r
 703                        fi\r
 704                     fi\r
 705                  fi\r
 706               od\r
 707            fi\r
 708         od ;\r
 709  \r
 710         if j < 100 andif j > 0 then\r
 711            bool1 := member (j,node) ;\r
 712            call setcursor (20,20) ;\r
 713            if bool1 then\r
 714               write(" Element ",j:2," exists already in the tree.")\r
 715            else\r
 716               write (" There is no ",j:2," in the tree.")\r
 717            fi ;\r
 718            call PrAnyKey;\r
 719         fi ;\r
 720  \r
 721         if j = 0 then\r
 722            exit\r
 723         fi\r
 724      Od\r
 725 end membermenu ;\r
 726 (*-----------------------------------------------------------------------*)\r
 727  \r
 728 Unit help : procedure ;\r
 729  \r
 730 Begin\r
 731    call newpage ;\r
 732    call setcursor (7,1) ;\r
 733    write ("     If you do not know : ") ;\r
 734    write ("  ^d   =  'Ctrl' + 'd' .") ;\r
 735    call PrAnyKey;\r
 736 end help ;\r
 737  \r
 738 (*-----------------------------------------------------------------------*)\r
 739 Unit emptymenu : procedure ;\r
 740 Var bo : boolean ;\r
 741 Begin\r
 742    call newpage ;\r
 743    bo := empty (node) ;\r
 744    call setcursor (12,25) ;\r
 745    if bo then\r
 746       write ( "The tree is empty.") ;\r
 747    else\r
 748       write ("This is not empty tree.") ;\r
 749    fi ;\r
 750    call PrAnyKey;\r
 751 end emptymenu ;\r
 752 (*------------------------------------------------------------------------*)\r
 753  \r
 754 Unit minimummenu:procedure ;\r
 755 Var x : integer ;\r
 756 Begin\r
 757    if empty (node) then\r
 758       raise emptytree\r
 759    else\r
 760       x := minimum(node) ;\r
 761       call newpage ;\r
 762       call setcursor(12,20) ;\r
 763       write ("A minimal element of the tree : ",x:2," .") ;\r
 764       call PrAnyKey;\r
 765    fi\r
 766 end minimummenu;\r
 767 (*---------------------------------------------------------------------*)\r
 768  \r
 769 Unit rysmenu :procedure ;\r
 770  \r
 771 Unit listawezlow : class ;\r
 772    var dr       : drzewo ,\r
 773        kier     : integer ,\r
 774        next,pop : listawezlow ;\r
 775 end listawezlow ;\r
 776  \r
 777 Var aktualny : listawezlow ,\r
 778     pom      : listawezlow ;\r
 779  \r
 780 Begin\r
 781       aktualny := new listawezlow ;\r
 782       aktualny.dr := node ;\r
 783 DO\r
 784    call newpage ;\r
 785    call setcursor (10,30);\r
 786    call reverse ;\r
 787    write (" S U B M E N U ") ;\r
 788    call normal ;\r
 789    call setcursor (13,27);\r
 790    write ("-> , <-  -  to change the actual tree") ;\r
 791    call setcursor (14,27);\r
 792    write ("enter    -  draw the actual tree") ;\r
 793    call setcursor (15,27);\r
 794    write ("Esc      -  return to  M E N U") ;\r
 795    call setcursor (25,1);\r
 796    write ("actual  =  root") ;\r
 797    pom := aktualny ;\r
 798    while pom.pop <> none\r
 799       do\r
 800          pom := pom.pop\r
 801       od;\r
 802    while pom.next <> none\r
 803       do\r
 804          case pom.kier\r
 805          when 1 : write (lewy) ;\r
 806          when 2 : write (srodkowy) ;\r
 807          when 3 : write (prawy)\r
 808          esac ;\r
 809          pom := pom.next\r
 810       od;\r
 811    DO\r
 812       i := inchar ;\r
 813       if i > 0 then\r
 814          case   i\r
 815           when  13 : exit ;\r
 816           when  27 : exit exit\r
 817          esac\r
 818       else\r
 819          case   i + 80\r
 820           when  8 : if aktualny.dr <> node then\r
 821                      aktualny := aktualny.pop ;\r
 822                      call cursorleft(5) ;\r
 823                      call eraseline ;\r
 824                      kill (aktualny.next) ;\r
 825                      aktualny.kier := 0\r
 826                   fi ;\r
 827           when 5 :if aktualny.dr <> none then\r
 828                     pom := new listawezlow ;\r
 829                     pom.pop := aktualny ;\r
 830                     pom.dr := aktualny.dr.lsyn ;\r
 831                     aktualny.next := pom ;\r
 832                     aktualny.kier := 1 ;\r
 833                     aktualny := pom ;\r
 834                     write (lewy)\r
 835                  fi ;\r
 836           when  3 :if aktualny.dr <> none then\r
 837                     pom := new listawezlow ;\r
 838                     pom.pop := aktualny ;\r
 839                     if aktualny.dr.logp then\r
 840                        pom.dr := aktualny.dr.psyn.psyn\r
 841                     else\r
 842                        pom.dr := aktualny.dr.psyn\r
 843                     fi ;\r
 844                     aktualny.next := pom ;\r
 845                     aktualny.kier := 3 ;\r
 846                     aktualny := pom ;\r
 847                     write (prawy) ;\r
 848                  fi ;\r
 849           when  0 :if aktualny.dr <> none then\r
 850                     if aktualny.dr.logp then\r
 851                        pom := new listawezlow ;\r
 852                        pom.pop := aktualny ;\r
 853                        aktualny.next := pom ;\r
 854                        pom.dr := aktualny.dr.psyn.lsyn ;\r
 855                        aktualny.kier := 2 ;\r
 856                        aktualny := pom ;\r
 857                        write (srodkowy)\r
 858                     fi ;\r
 859                  fi\r
 860           esac\r
 861        fi\r
 862  \r
 863       OD ;\r
 864       call rys (aktualny.dr)\r
 865    OD\r
 866  \r
 867 end rysmenu ;\r
 868 (*--------------------------------------------------------------------*)\r
 869  \r
 870 Begin\r
 871 DO\r
 872    call newpage ;\r
 873    call setcursor (13,31);\r
 874    call reverse ;\r
 875    write (" M E N U ") ;\r
 876    call normal ;\r
 877    call setcursor (13,30);\r
 878    write ("i  - insert") ;\r
 879    call setcursor (14,30);\r
 880    write ("d  - delete");\r
 881    call setcursor (15,30);\r
 882    write ("m  - member" );\r
 883    call setcursor (16,30);\r
 884    write ("e  - empty?") ;\r
 885    call setcursor (17,30);\r
 886    write ("w  - draw tree");\r
 887    call setcursor (18,30);\r
 888    write ("^m - minimum");\r
 889    call setcursor (19,30);\r
 890    write ("^d - delmin");\r
 891    call reverse ;\r
 892    call setcursor (25,1);\r
 893    write ("     F1 -  HELP     ,     Esc - end of the execution            ");\r
 894    call normal ;\r
 895  \r
 896    DO\r
 897       i := inchar ;\r
 898       if i = 27 then\r
 899          exit exit\r
 900       else\r
 901          if i > 80 then\r
 902             case   i\r
 903                when 105 : call insdelmenu(true) ;\r
 904                when 100 : call insdelmenu(false) ;\r
 905                when 109 : call membermenu ;\r
 906                when 101 : call emptymenu ;\r
 907                when 119 : call rysmenu ;\r
 908             esac;\r
 909             exit\r
 910          else\r
 911             case    i + 60\r
 912                when 64 : call delmin (node) ;\r
 913                when 73 : call minimummenu ;\r
 914                when 1  : call help ;\r
 915             esac;\r
 916             exit;\r
 917          fi\r
 918       fi\r
 919    OD\r
 920 OD;\r
 921 call NewPage;\r
 922  \r
 923 end menu ;\r
 924 (*-----------------------------------------------------------------------*)\r
 925 (*-----------------------------------------------------------------------*)\r
 926  \r
 927 UNIT rys:IIUWGraph procedure(d:drzewo) ;\r
 928  \r
 929 Const skok = 6 ;\r
 930  \r
 931 Var licznik,poziom,licznik2  : integer  ,\r
 932     krok,krok2,staryx,staryy : integer  ;\r
 933  \r
 934  \r
 935  Unit  ramka :procedure (wr,kol,dl:integer) ;\r
 936  Var x1,y1,l,h :integer ;\r
 937  Begin\r
 938       x1 := (wr) * 8 - 2 ;\r
 939       y1 := (kol) * 8 -2 ;\r
 940       l := 8 * dl + 4 ;\r
 941       h := 12 ;\r
 942       call move (x1,y1) ;\r
 943       call draw (x1+l,y1) ;\r
 944       call draw (x1+l,y1+h) ;\r
 945       call draw (x1,y1+h) ;\r
 946       call draw (x1,y1) ;\r
 947       call move (x1 + l div 2,y1) ;\r
 948       call draw (staryx ,staryy ) ;\r
 949       call move (x1+2,y1+2)\r
 950  end ramka ;\r
 951  \r
 952  Unit print : procedure (a : integer) ;\r
 953  Begin\r
 954      if a > 9 then\r
 955         call hascii (48 + a div 10)\r
 956      fi;\r
 957      call hascii (48 + a mod 10)\r
 958  end print ;\r
 959  \r
 960  Unit odstep : function(d :drzewo,poziom :integer) : integer ;\r
 961  var i,j : integer ;\r
 962  \r
 963  begin\r
 964       j := licznosc (d,poziom,true) ;\r
 965       i := licznosc (d,poziom,false) ;\r
 966       result :=( 85 - i ) div (j+1)\r
 967 end odstep ;\r
 968  \r
 969 Unit linia :procedure (d:drzewo);\r
 970  \r
 971  (* poziom = drukowany poziom *)\r
 972  (* i - numer poziomu *)\r
 973  \r
 974  begin\r
 975      i := i+1 ;\r
 976      if poziom - 1 = i then\r
 977         if d.logp then\r
 978            staryx := licznik2 * 8 + 20;\r
 979            staryy :=  i * skok * 8 + 10  ;\r
 980            licznik2 := licznik2 + 6 + krok2\r
 981         else\r
 982            staryx := licznik2 * 8 + 8;\r
 983            staryy :=  i * skok * 8 + 10 ;\r
 984            licznik2 := licznik2 + 3 +krok2\r
 985         fi\r
 986      fi ;\r
 987      if i = poziom then\r
 988           if d.logp then\r
 989           call ramka (licznik, poziom*skok ,5) ;\r
 990           call print (d.klucz) ;\r
 991           call hascii (44) ;\r
 992           call print (d.psyn.klucz) ;\r
 993           licznik := licznik + 6 + krok\r
 994        else\r
 995           call ramka (licznik, poziom*skok ,2) ;\r
 996           call print (d.klucz) ;\r
 997           licznik := licznik + 3 + krok\r
 998        fi\r
 999      else\r
1000        call linia (d.lsyn) ;\r
1001        if d.logp then\r
1002           call linia(d.psyn.lsyn) ;\r
1003      call linia(d.psyn.psyn) ;\r
1004        else\r
1005           call linia(d.psyn)\r
1006        fi\r
1007      fi;\r
1008      i := i-1\r
1009 end linia ;\r
1010  \r
1011 Unit napis1 : procedure ;\r
1012 begin\r
1013    call move ( 275 ,335) ;\r
1014          call hascii (78) ;\r
1015          call hascii (97) ;\r
1016          call hascii (99) ;\r
1017          call hascii (105) ;\r
1018          call hascii (115) ;\r
1019          call hascii (110) ;\r
1020          call hascii (105) ;\r
1021          call hascii (106) ;\r
1022          call hascii (32) ;\r
1023          call hascii (99) ;\r
1024          call hascii (111) ;\r
1025          call hascii (107) ;\r
1026          call hascii (111) ;\r
1027          call hascii (108) ;\r
1028          call hascii (119) ;\r
1029          call hascii (105) ;\r
1030          call hascii (101) ;\r
1031          call hascii (107)\r
1032  \r
1033 end napis1 ;\r
1034  \r
1035 Unit napis2 : procedure ;\r
1036 begin\r
1037          call move ( 275 ,300) ;\r
1038          call hascii (66) ;\r
1039          call hascii (114) ;\r
1040          call hascii (97) ;\r
1041          call hascii (107) ;\r
1042          call hascii (32) ;\r
1043          call hascii (109) ;\r
1044          call hascii (105) ;\r
1045          call hascii (101) ;\r
1046          call hascii (106) ;\r
1047          call hascii (115) ;\r
1048          call hascii (99) ;\r
1049          call hascii (97)\r
1050  \r
1051 end napis2 ;\r
1052  \r
1053 Unit napis3 : procedure ;\r
1054  \r
1055 begin\r
1056          call move ( 285 ,300) ;\r
1057          call hascii (79) ;\r
1058          call hascii (46) ;\r
1059          call hascii (75) ;\r
1060          call hascii (46) ;\r
1061  \r
1062 end napis3 ;\r
1063  \r
1064 Begin\r
1065      call gron(0) ;\r
1066      poziom:=1 ;\r
1067      Do\r
1068         j := licznosc(d,poziom,false) ;\r
1069         if j>0 andif j<82 then\r
1070              i := 0 ;\r
1071              krok2 := odstep (d,poziom-1) ;\r
1072              krok := odstep (d,poziom) ;\r
1073              licznik := krok + 1 ;\r
1074              licznik2 :=krok2 + 1 ;\r
1075              staryx := 350 ;\r
1076              staryy := skok * 8 -2  ;\r
1077               call linia(d) ;\r
1078               poziom := poziom+1\r
1079         else\r
1080             exit\r
1081         fi\r
1082      Od ;\r
1083      call napis1 ;\r
1084      if j >= 82  then\r
1085           call napis2\r
1086      else\r
1087         call napis3\r
1088      fi ;\r
1089      call czekaj ;\r
1090      call groff\r
1091 end rys;\r
1092  \r
1093 (*-----------------------------------------------------------------------*)\r
1094  \r
1095 HANDLERS\r
1096    when emptytree : call newpage ;\r
1097                     call setcursor(12,30) ;\r
1098                     write ("EMPTY TREE  !") ;\r
1099                     call PrAnyKey;\r
1100                     (*\r
1101                     call setcursor (25,30) ;\r
1102                     call reverse ;\r
1103                     write ("nacisnij cokolwiek") ;\r
1104                     call cursorleft (1) ;\r
1105                     call normal ;\r
1106                     call czekaj ;*)\r
1107                     return\r
1108 End handlers;\r
1109 (*-----------------------------------------------------------------------*)\r
1110                          (* program glowny *)\r
1111 (*-----------------------------------------------------------------------*)\r
1112  \r
1113 BEGIN\r
1114  \r
1115        call tytul ;\r
1116        call menu\r
1117  \r
1118 END kolejka ;\r