examples/data_str/queue2.log

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