3 (*-----------------------------------------------------------------------*)
\r
11 (*-----------------------------------------------------------------------*)
\r
17 (*-----------------------------------------------------------------------*)
\r
21 (*-----------------------------------------------------------------------*)
\r
29 Unit lisc : function :boolean ;
\r
31 result := lsyn = none
\r
37 (*-----------------------------------------------------------------------*)
\r
39 UNIT licznosc :function (d:drzewo , p:integer , log:boolean):integer ;
\r
41 (* Liczy ile miejsca potrzeba do wydruku linii *)
\r
43 Var licznik : integer ;
\r
48 Unit licz :procedure (d:drzewo) ;
\r
51 if d = none then raise alarm fi;
\r
53 if log then licznik := licznik + 1
\r
56 licznik := licznik + 6
\r
58 licznik := licznik + 3 ;
\r
62 call licz (d.lsyn) ;
\r
64 call licz(d.psyn.lsyn) ;
\r
65 call licz(d.psyn.psyn) ;
\r
74 when alarm : licznik := 0 ;
\r
85 (*-----------------------------------------------------------------------*)
\r
87 UNIT infix :procedure(d : drzewo) ;
\r
93 call infix (d.lsyn );
\r
94 call infix (d.psyn )
\r
98 (*-----------------------------------------------------------------------*)
\r
100 UNIT empty : function (d : drzewo) : boolean ;
\r
102 result := d = none
\r
106 (*-----------------------------------------------------------------------*)
\r
108 UNIT minimum : function (d : drzewo) : integer ;
\r
117 result := minimum (d.lsyn)
\r
123 (*-----------------------------------------------------------------------*)
\r
125 UNIT member : function ( k:integer , d:drzewo ) : boolean ;
\r
129 if d.klucz <> k then
\r
130 if d.klucz < k then
\r
131 result := member(k,d.psyn);
\r
133 result := member(k,d.lsyn);
\r
143 (*-----------------------------------------------------------------------*)
\r
145 UNIT insert : procedure ( k : integer ; inout d : drzewo ) ;
\r
147 Var pom1,pom2 : drzewo ,
\r
148 max1,max2 : integer ;
\r
152 Unit ins : procedure ( a:drzewo ) ;
\r
154 if a.klucz = k then raise jest
\r
157 pom1 := new drzewo ;
\r
158 if a.klucz < k then
\r
162 pom1.klucz := a.klucz ;
\r
167 if k <= a.klucz then
\r
168 call ins (a.lsyn ) ;
\r
169 if pom1 <> none then
\r
185 a.logp,pom1.logl := false
\r
187 pom2 := new drzewo ;
\r
188 pom2.lsyn := pom1 ;
\r
189 pom2.psyn := a.psyn ;
\r
190 pom2.klucz := a.klucz ;
\r
192 pom2.logl,a.logp := true ;
\r
199 call ins (a.psyn) ;
\r
200 if pom1 <> none then
\r
203 a.psyn := a.psyn.lsyn ;
\r
204 pom2.lsyn := pom2.psyn ;
\r
205 pom2.psyn := pom1 ;
\r
207 max1 := pom2.klucz ;
\r
208 pom2.klucz := max2 ;
\r
210 pom1.logl,a.logp := false
\r
213 pom2 := new drzewo ;
\r
214 pom2.psyn := pom1 ;
\r
215 pom2.lsyn := a.psyn ;
\r
217 pom2.klucz := max1 ;
\r
218 a.logp,pom2.logl := true ;
\r
228 when jest : call setcursor(20,1) ;
\r
230 writeln("element ",k:2," znajduje sie w drzewie") ;
\r
231 call setcursor (25,30) ;
\r
233 write ("nacisnij cokolwiek") ;
\r
234 call cursorleft (1) ;
\r
237 call setcursor (25,30) ;
\r
239 call setcursor (20,1) ;
\r
250 if pom1 <> none then
\r
251 pom2 := new drzewo ;
\r
252 pom2.klucz := max1 ;
\r
254 pom2.psyn := pom1 ;
\r
260 (*-----------------------------------------------------------------------*)
\r
262 UNIT delete:procedure(k:integer;inout d:drzewo);
\r
264 Var pom,pom1 : drzewo ,
\r
265 nowymax : integer ,
\r
268 Signal koniec ,niema ;
\r
270 Unit del : procedure (inout d : drzewo ) ;
\r
274 if d.klucz = k then
\r
280 if d.klucz >= k then
\r
281 call del (d.lsyn) ;
\r
285 if d.lsyn = none then
\r
286 if pom = none then
\r
298 if k = d.klucz then
\r
299 d.klucz := nowymax
\r
302 if d.psyn.lsyn.logp then
\r
303 pom1 := d.psyn.lsyn ;
\r
304 d.psyn.lsyn := d.psyn.lsyn.psyn ;
\r
306 pom1.psyn := d.psyn ;
\r
307 d.psyn := pom1.lsyn ;
\r
310 d.logp,d.psyn.logl := false ;
\r
311 d.lsyn.logp , d.psyn.lsyn.logl := false ;
\r
316 d.psyn := d.psyn.lsyn ;
\r
320 d.lsyn.psyn.logl := true ;
\r
325 if d.psyn.logp then
\r
328 d.psyn := d.psyn.lsyn ;
\r
331 d.logp , d.psyn.logl := false ;
\r
332 if d.lsyn.logl then
\r
333 d.lsyn.logl := false ;
\r
340 d.psyn.logl , d.logp := true ;
\r
348 if k = d.klucz then d.klucz := nowymax fi;
\r
353 call del (d.psyn) ;
\r
357 if d.psyn = none then
\r
358 if pom = none then
\r
359 nowymax := d.lsyn.klucz ;
\r
366 d.psyn.logl := false ;
\r
369 if d.lsyn.logp then
\r
372 d.lsyn := pom1.psyn.psyn ;
\r
373 pom1.psyn.psyn := d ;
\r
375 pom1.psyn := d.lsyn ;
\r
377 d.logl , d.lsyn.logp := false ;
\r
382 d.lsyn := d.lsyn.psyn ;
\r
385 pom1.logp , pom1.psyn.logl := true ;
\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
400 write ("nacisnij cokolwiek") ;
\r
401 call cursorleft (1) ;
\r
404 call setcursor (25,30) ;
\r
406 call setcursor(20,1) ;
\r
409 when koniec : terminate
\r
417 if pom <> none then
\r
423 (*-----------------------------------------------------------------------*)
\r
425 Unit delmin : procedure (inout d : drzewo) ;
\r
438 (*-----------------------------------------------------------------------*)
\r
441 (* PROCEDURY GRAFICZNE *)
\r
445 unit Reverse : procedure;
\r
447 write( chr(27), "[7m")
\r
450 unit Normal : procedure;
\r
452 write( chr(27), "[0m")
\r
456 unit EraseLine : procedure;
\r
458 write( chr(27), "[K")
\r
461 unit inchar : IIUWgraph function : integer;
\r
462 (*podaj nr znaku przeslanego z klawiatury *)
\r
467 if i <> 0 then exit fi;
\r
472 unit NewPage : procedure;
\r
474 write( chr(27), "[2J")
\r
477 unit SetCursor : procedure(row, column : integer);
\r
478 var c,d,e,f : char,
\r
485 i := column div 10;
\r
486 j := column mod 10;
\r
489 write( chr(27), "[", c, d, ";", e, f, "H")
\r
492 unit CursorLeft : procedure (columns : integer);
\r
496 i := columns div 10;
\r
497 j := columns mod 10;
\r
500 write( chr(27), "[", e, f, "D")
\r
503 unit CursorRight : procedure (columns : integer);
\r
507 i := columns div 10;
\r
508 j := columns mod 10;
\r
511 write( chr(27), "[", e, f, "C")
\r
514 unit CursorUp : procedure (rows : integer);
\r
522 write( chr(27), "[", c, d, "A")
\r
525 unit CursorDown : procedure (rows : integer);
\r
533 write( chr(27), "[", c, d, "B")
\r
536 (*-----------------------------------------------------------------------*)
\r
538 UNIT czekaj :procedure ;
\r
544 (*-----------------------------------------------------------------------*)
\r
546 UNIT tytul : procedure ;
\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
555 write ("nacisnij cokolwiek") ;
\r
556 call cursorleft (1) ;
\r
563 (*-----------------------------------------------------------------------*)
\r
565 UNIT menu : procedure ;
\r
567 Unit insdelmenu : procedure(formal : boolean) ;
\r
569 Var c1,c2,c3 : integer ;
\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
581 call setcursor(15,39);
\r
587 if c1 >= 48 andif c1 <= 57 then
\r
591 if c2 >= 48 andif c2 <= 57 then
\r
596 j := (c1-48) * 10 + (c2-48) ;
\r
601 call cursorleft(1) ;
\r
614 call cursorleft (1) ;
\r
624 if j < 100 andif j > 0 then
\r
626 call insert (j,node) ;
\r
628 call delete (j,node) ;
\r
630 call setcursor(20,1) ;
\r
641 Unit membermenu : procedure ;
\r
643 Var c1,c2,c3 : integer ,
\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
656 call setcursor(15,39);
\r
662 if c1 >= 48 andif c1 <= 57 then
\r
666 if c2 >= 48 andif c2 <= 57 then
\r
671 j := (c1-48) * 10 + (c2-48) ;
\r
676 call cursorleft(1) ;
\r
689 call cursorleft (1) ;
\r
699 if j < 100 andif j > 0 then
\r
700 bool1 := member (j,node) ;
\r
701 call setcursor (20,20) ;
\r
703 write(" Element ",j:2," znajduje sie w drzewie .")
\r
705 write (" Elementu ",j:2," nie ma w drzewie .")
\r
707 call setcursor (25,30) ;
\r
709 write ("nacisnij cokolwiek") ;
\r
710 call cursorleft (1) ;
\r
713 call setcursor (25,30) ;
\r
715 call setcursor(20,1) ;
\r
725 Unit help : procedure ;
\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
734 write ("nacisnij cokolwiek") ;
\r
735 call cursorleft (1) ;
\r
741 Unit emptymenu : procedure ;
\r
747 bo := empty (node) ;
\r
748 call setcursor (12,25) ;
\r
750 write ( "Drzewo jest puste .") ;
\r
752 write ("Drzewo nie jest puste .") ;
\r
754 call setcursor (25,30) ;
\r
756 write ("nacisnij cokolwiek") ;
\r
757 call cursorleft (1) ;
\r
763 Unit minimummenu:procedure ;
\r
768 if empty (node) then
\r
771 x := minimum(node) ;
\r
773 call setcursor(12,20) ;
\r
774 write ("Najmniejszy element w drzewie : ",x:2," .") ;
\r
775 call setcursor (25,30) ;
\r
777 write ("nacisnij cokolwiek") ;
\r
778 call cursorleft (1) ;
\r
781 call setcursor (25,30) ;
\r
783 call setcursor(20,1) ;
\r
789 Unit rysmenu :procedure ;
\r
791 Unit listawezlow : class ;
\r
794 next,pop : listawezlow ;
\r
797 Var aktualny : listawezlow ,
\r
798 pom : listawezlow ;
\r
801 aktualny := new listawezlow ;
\r
802 aktualny.dr := node ;
\r
805 call setcursor (10,30);
\r
807 write (" P O D M E N U ") ;
\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
818 while pom.pop <> none
\r
822 while pom.next <> none
\r
825 when 1 : write (lewy) ;
\r
826 when 2 : write (srodkowy) ;
\r
827 when 3 : write (prawy)
\r
836 when 27 : exit exit
\r
840 when 8 : if aktualny.dr <> node then
\r
841 aktualny := aktualny.pop ;
\r
842 call cursorleft(5) ;
\r
844 kill (aktualny.next) ;
\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
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
862 pom.dr := aktualny.dr.psyn
\r
864 aktualny.next := pom ;
\r
865 aktualny.kier := 3 ;
\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
884 call rys (aktualny.dr)
\r
892 call setcursor (13,31);
\r
894 write (" M E N U ") ;
\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
911 call setcursor (25,1);
\r
912 write (" F1 - HELP , Esc - wyjscie z programu ");
\r
922 when 105 : call insdelmenu(true) ;
\r
924 when 100 : call insdelmenu(false) ;
\r
926 when 109 : call membermenu ;
\r
928 when 101 : call emptymenu ;
\r
930 when 119 : call rysmenu ;
\r
935 when 64 : call delmin (node) ;
\r
937 when 73 : call minimummenu ;
\r
939 when 1 : call help ;
\r
948 (*-----------------------------------------------------------------------*)
\r
950 UNIT rys:IIUWGraph procedure(d:drzewo) ;
\r
954 Var licznik,poziom,licznik2 : integer ,
\r
955 krok,krok2,staryx,staryy : integer ;
\r
958 Unit ramka :procedure (wr,kol,dl:integer) ;
\r
960 Var x1,y1,l,h :integer ;
\r
963 x1 := (wr) * 8 - 2 ;
\r
964 y1 := (kol) * 8 -2 ;
\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
977 Unit print : procedure (a : integer) ;
\r
981 call hascii (48 + a div 10)
\r
983 call hascii (48 + a mod 10)
\r
986 Unit odstep : function(d :drzewo,poziom :integer) : integer ;
\r
988 var i,j : integer ;
\r
991 j := licznosc (d,poziom,true) ;
\r
992 i := licznosc (d,poziom,false) ;
\r
993 result :=( 85 - i ) div (j+1)
\r
996 Unit linia :procedure (d:drzewo);
\r
998 (* poziom = drukowany poziom *)
\r
999 (* i - numer poziomu *)
\r
1003 if poziom - 1 = i then
\r
1005 staryx := licznik2 * 8 + 20;
\r
1006 staryy := i * skok * 8 + 10 ;
\r
1007 licznik2 := licznik2 + 6 + krok2
\r
1009 staryx := licznik2 * 8 + 8;
\r
1010 staryy := i * skok * 8 + 10 ;
\r
1011 licznik2 := licznik2 + 3 +krok2
\r
1014 if i = poziom 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
1022 call ramka (licznik, poziom*skok ,2) ;
\r
1023 call print (d.klucz) ;
\r
1024 licznik := licznik + 3 + krok
\r
1027 call linia (d.lsyn) ;
\r
1029 call linia(d.psyn.lsyn) ;
\r
1030 call linia(d.psyn.psyn) ;
\r
1032 call linia(d.psyn)
\r
1038 Unit napis1 : procedure ;
\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
1063 Unit napis2 : procedure ;
\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
1082 Unit napis3 : procedure ;
\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
1097 j := licznosc(d,poziom,false) ;
\r
1098 if j>0 andif j<82 then
\r
1100 krok2 := odstep (d,poziom-1) ;
\r
1101 krok := odstep (d,poziom) ;
\r
1102 licznik := krok + 1 ;
\r
1103 licznik2 :=krok2 + 1 ;
\r
1105 staryy := skok * 8 -2 ;
\r
1107 poziom := poziom+1
\r
1122 (*-----------------------------------------------------------------------*)
\r
1125 when emptytree : call newpage ;
\r
1126 call setcursor(12,30) ;
\r
1127 write ("PUSTE DRZEWO !") ;
\r
1128 call setcursor (25,30) ;
\r
1130 write ("nacisnij cokolwiek") ;
\r
1131 call cursorleft (1) ;
\r
1136 (*-----------------------------------------------------------------------*)
\r
1137 (* program glowny *)
\r
1138 (*-----------------------------------------------------------------------*)
\r