9 unit sc : procedure(row, column : integer);
\r
21 write( chr(27), "[", c, d, ";", e, f, "H")
\r
24 unit inchar : IIUWgraph function : integer;
\r
25 (*podaj nr znaku przeslanego z klawiatury *)
\r
30 if i <> 0 then exit fi;
\r
35 unit node: class (e: integer);
\r
36 var left, right: node
\r
39 unit search: class (inout gdzie: node, co: integer);
\r
40 var pom: node, pom2: node;
\r
41 var czyjest: boolean
\r
60 unit np : procedure;
\r
62 write( chr(27), "[2J")
\r
65 unit cll: procedure (k: integer);
\r
66 unit EraseLine : procedure;
\r
68 write( chr(27), "[K")
\r
75 unit ramka: procedure (w1, w2, w3, k1, k2: integer);
\r
104 for i:=k1+1 to k2-1
\r
109 unit menu: procedure;
\r
112 call ramka (1,5,21,10,70);
\r
116 write ("1. Wstawienie elementu do drzewa");
\r
118 write ("2. Usuniecie elementu z drzewa");
\r
120 write ("3. Sprawdzenie, czy element jest w drzewie");
\r
122 write ("4. Sprawdzenie, czy drzewo jest puste");
\r
124 write ("5. Drukowanie drzewa w postaci grafu");
\r
126 write ("6. Drukowanie drzewa w postaci listy elementow");
\r
128 write ("7. Wyjscie")
\r
131 unit wprowliczbe: procedure (output liczba: integer, jest: boolean);
\r
133 var minus,l: boolean;
\r
137 unit cyfra: function (z: char): boolean;
\r
139 if ord(z) >= ord('0') and ord(z) <= ord('9')
\r
144 unit alarm: procedure;
\r
147 write ("To nie jest liczba calkowita");
\r
162 if not cyfra(znak)
\r
168 t:=t+ord(znak)-ord(z);
\r
174 if k=013 (* enter *)
\r
185 if not cyfra (chr(k))
\r
192 t:=10*t+k-ord('0');
\r
198 unit podkresl: procedure (k1, k2, opcja: integer, czym: char);
\r
199 var i, j, co: integer;
\r
202 for i:=co-1 step 2 to co+1
\r
205 for j:=k1+1 to k2-1
\r
212 unit robzsearch: procedure (r: integer);
\r
216 unit insert: search procedure;
\r
221 nowy:=new node(co);
\r
227 then pom2.left:=nowy
\r
228 else pom2.right:=nowy
\r
234 unit delete: search procedure;
\r
237 unit przestaw: procedure (naco: node);
\r
240 then (* usuwamy korzen *)
\r
244 then pom2.left:=naco
\r
245 else pom2.right:=naco
\r
255 call przestaw (pom.right)
\r
259 call przestaw (pom.left)
\r
260 else (* usuwany wezel ma dwoch synow *)
\r
261 if pom.right.left=none
\r
263 call przestaw(pom.right);
\r
264 pom.right.left:=pom.left
\r
268 while p2.left=/=none
\r
275 p2.right:=pom.right;
\r
283 unit member: search procedure;
\r
289 write ("Ten element jest w drzewie ")
\r
291 write ("Tego elementu nie ma w drzewie ")
\r
296 begin (* robzsearch *)
\r
298 write ("Podaj element ");
\r
299 call wprowliczbe (elem,licz);
\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
312 unit empty: procedure (k: node);
\r
318 write ("Drzewo jest puste ")
\r
320 write ("Drzewo nie jest puste ")
\r
325 unit drukuj: procedure;
\r
327 var g, ko: integer;
\r
331 unit druk: procedure (kor: node);
\r
332 var kondruk: boolean;
\r
334 unit dlugi: function (k: node): boolean;
\r
338 result:=k.e>99 or k.e<-9 or dlugi(k.left) or dlugi(k.right)
\r
342 unit krotkidruk: procedure (wiersz, pocz, kon: integer; drzewo: node);
\r
343 var y, i, z: integer;
\r
345 z:= (kon+pocz-1) div 2;
\r
346 call ramka (wiersz, 0, wiersz+2, z-1, z+2);
\r
352 call sc(wiersz+1,z);
\r
353 write (drzewo.e:2);
\r
354 if drzewo.left=/=none
\r
358 else (* drukowanie lewego poddrzewa *)
\r
359 y:= (z+pocz-1) div 2;
\r
360 call sc (wiersz+4,y);
\r
367 call sc(wiersz+3,z);
\r
369 call sc(wiersz+2,z);
\r
371 call krotkidruk (wiersz+5,pocz,z,drzewo.left)
\r
374 if drzewo.right=/=none
\r
378 else (* drukowanie prawego poddrzewa *)
\r
380 call sc(wiersz+2,z+1);
\r
382 call sc(wiersz+3,z+1);
\r
384 call sc(wiersz+4,z+1);
\r
391 call krotkidruk (wiersz+5,z+1,kon,drzewo.right)
\r
396 unit dlugidruk: procedure (wiersz, pocz, kon: integer, drzewo: node);
\r
397 var y, i, z: integer;
\r
399 z:= (kon+pocz-1) div 2;
\r
400 call ramka (wiersz, 0, wiersz+2, z-4, z+4);
\r
406 call sc(wiersz+1,z-3);
\r
407 write (drzewo.e:7);
\r
408 if drzewo.left=/=none
\r
413 else (* drukowanie lewego poddrzewa *)
\r
414 y:= (z+pocz-1) div 2;
\r
415 call sc(wiersz+5,y);
\r
417 call sc(wiersz+4,y);
\r
424 call sc(wiersz+3,z-2);
\r
426 call sc(wiersz+2,z-2);
\r
428 call dlugidruk (wiersz+6, pocz, z, drzewo.left)
\r
431 if drzewo.right=/=none
\r
436 else (* drukowanie prawego poddrzewa *)
\r
438 call sc (wiersz+2,z+2);
\r
439 write ("Â");
\r call sc(wiersz+3,z+2);
\r
441 call sc(wiersz+4,z+2);
\r
448 call sc(wiersz+5,y);
\r
450 call dlugidruk (wiersz+6, z+1, kon, drzewo.right)
\r
459 call dlugidruk(1,1,80,kor)
\r
461 call krotkidruk(1,1,80,kor)
\r
466 write ("Dalsza czesc drzewa nie miesci sie na ekranie ");
\r
474 write ("Drzewo jest puste")
\r
476 write ("Czy chcesz obejrzec drzewo od korzenia ?");
\r
484 write ("Podaj korzen poddrzewa, ktore chcesz obejrzec ");
\r
485 call wprowliczbe (g,h);
\r
490 x:=new search (korzen,g);
\r
494 write ("Tego elementu nie ma w drzewie ");
\r
506 unit fix: procedure (k: node);
\r
507 var n, kon: integer;
\r
510 unit prefix: procedure (d: node);
\r
516 call prefix (d.left);
\r
517 call prefix (d.right)
\r
521 unit infix: procedure (d: node);
\r
525 call infix (d.left);
\r
528 call infix (d.right)
\r
532 unit postfix: procedure (d: node);
\r
536 call postfix (d.left);
\r
537 call postfix (d.right);
\r
547 write ("Drzewo jest puste")
\r
550 call ramka (1,5,13,30,49);
\r
554 write ("1. prefix");
\r
556 write ("2. infix");
\r
558 write ("3. postfix");
\r
560 write ("Podaj numer opcji ");
\r
561 call wprowliczbe (n,f);
\r
562 if f andif (n >= 1 and n <= 3)
\r
564 call podkresl (30,49,n,'.');
\r
568 when 1 : call prefix (korzen);
\r
569 when 2 : call infix (korzen);
\r
570 when 3 : call postfix (korzen)
\r
578 unit czekaj: procedure;
\r
589 unit beep: procedure;
\r
594 unit zakonczenie: procedure;
\r
595 var i, j, t, k: integer;
\r
601 for i:=10 step 4 to 14
\r
609 for i:=10 step 60 to 70
\r
618 write ("DO ZOBACZENIA ");
\r
624 begin (* program glowny *)
\r
629 write ("Podaj numer opcji ");
\r
630 call wprowliczbe (num,op);
\r
635 if num < 1 or num > 7
\r
640 call podkresl (10,70,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
653 call podkresl (10,70,num,' ')
\r