8 unit inchar :function: integer;
\r
13 if i <> 0 then exit fi;
\r
27 var name:arrayof char;
\r
34 var name:arrayof char;
\r
41 unit directory:procedure;
\r
42 var hel1,hel2,hel3,hel4:menu;
\r
48 hel1.name:=sa("DISC ");
\r
52 hel2.name:=sa("TREE ");
\r
58 hel3.name:=sa("EXIT ");
\r
66 hel3.name:=sa("UPDIR ");
\r
72 hel1.name:=sa("SAVEnot");
\r
78 hel4.name:=sa("LOADnot");
\r
87 hel3.name:=sa("UPDIR ");
\r
93 hel2.name:=sa("CREATE ");
\r
99 hel4.name:=sa("INSERT ");
\r
105 hel2.name:=sa("DELETE ");
\r
111 hel4.name:=sa("MEMBER ");
\r
117 hel2.name:=sa("CHANGE ");
\r
123 hel4.name:=sa("WRITE ");
\r
131 hel2.name:=sa("UPDIR ");
\r
137 hel4.name:=sa("DRAW ");
\r
143 hel3.name:=sa("PREFIX ");
\r
149 hel4.name:=sa("INFIX ");
\r
155 hel3.name:=sa("POSTFIX");
\r
167 unit RANGE:procedure(x:integer,y:integer,i:integer);
\r
171 call draw(x+120,y);
\r
172 call draw(x+120,y+20);
\r
178 unit BOX:procedure(xc,yc:integer;lenght,szer:integer);
\r
182 call draw(xc+lenght,yc);
\r
183 call draw(xc+lenght,yc+szer);
\r
184 call draw(xc,yc+szer);
\r
188 unit CLR:procedure;
\r
194 call draw(618,319);
\r
199 unit drawmenu:procedure(pointer:menu);
\r
203 var sub,run:arrayof char;
\r
209 call box(400,20,200,30);
\r
210 call box(398,18,204,34);
\r
211 if actual=/=none then
\r
213 call outhline(actual.name);
\r
222 while yhelp=/= phelp.y do
\r
228 y:=(320-n*20-20)/2;
\r
230 call draw(x+140,y);
\r
231 call draw(x+140,y+n*20+20);
\r
232 call draw(x,y+n*20+20);
\r
239 call draw(x+144,y);
\r
240 call draw(x+144,y+n*20+24);
\r
241 call draw(x,y+n*20+24);
\r
245 call move(x+144+i,y+5);
\r
246 call draw(x+144+i,y+n*20+24+i);
\r
247 call draw(x+5,y+n*20+24+i);
\r
255 call OUTHLINE(phelp.name);
\r
257 if phelp.sub =/=none then;
\r
258 call OUTHLINE(sub);
\r
260 call OUTHLINE(run);
\r
271 unit OUTHLINE:procedure(a:arrayof char);
\r
277 call color(11); (* czerwony *)
\r
281 call hascii(ord(a(j)));
\r
286 unit INHLINE:function(xc:integer;yc:integer):arrayof char;
\r
291 var ar:arrayof char;
\r
296 array ar dim(1:13);
\r
298 while ik=/=13 and count<13 do
\r
300 if ik=8 and count>0 then
\r
303 call move(xc+(count)*8,yc);
\r
308 ar(count):=chr(ik);
\r
315 array result dim(1:count);
\r
316 for i:=1 to count do
\r
323 unit SEARCH:class(where:node;what:arrayof char);
\r
325 var hel1:node,hel2:node;
\r
332 if hel1=none then exit
\r
334 if equal(hel1.e,what) then exit
\r
337 if not less(hel1.e,what) then
\r
345 if hel1=/=none then isit:=true;
\r
350 unit membe:SEARCH procedure;
\r
355 call outhline(sa(" EXISTS "));
\r
357 call outhline(sa(" DOESN'T EXIST"));
\r
361 unit INSER:SEARCH procedure;
\r
366 call OUTHLINE(sa(" O.K."));
\r
371 call OUTHLINE(sa(" ALREADY EXIXTS"));
\r
374 call OUTHLINE(sa(" O.K."));
\r
376 if not less(hel2.e,what) then
\r
385 unit delet:SEARCH procedure;
\r
391 call OUTHLINE(sa(" TREE IS EMPTY "));
\r
394 call OUTHLINE(sa("DOESN'T EXIST"));
\r
396 call outhline(sa(" O.K. "));
\r
399 if hel1.right<>none then
\r
403 if pom.left=none then exit;
\r
404 else pom:=pom.left;
\r
407 pom.left:=hel1.left;
\r
412 if hel1.left<>none then
\r
416 if pom.right=none then exit;
\r
417 else pom:=pom.right;
\r
420 pom.right:=hel1.right;
\r
426 fi; fi; (****** 1 to 2 *****)
\r
428 if not less(hel1.e,hel2.e) then
\r
429 if hel1.left=none then
\r
430 hel2.right:=hel1.right;
\r
433 if hel1.right=none then
\r
434 hel2.right:=hel1.left;
\r
437 hel2.right:=hel1.right;
\r
439 while pom.left=/=none do
\r
442 pom.left:=hel1.left;
\r
447 if hel1.left=none then
\r
448 hel2.left:=hel1.right;
\r
451 if hel1.right=none then
\r
452 hel2.left:=hel1.left;
\r
455 hel2.left:=hel1.left;
\r
457 while pom.right=/=none do
\r
460 pom.right:=hel1.right;
\r
470 unit GIVEME:function:arrayof arrayof char;
\r
472 var a:arrayof arrayof char;
\r
473 var ac:arrayof char;
\r
479 call box(100,20,200,30);
\r
480 call box(98,18,204,34);
\r
482 call outhline(sa(" GIVE ME ELEMENTS"));
\r
483 call box(100,60,200,200);
\r
491 call outhline(sa(">"));
\r
493 if ac=none or j> 15 then exit
\r
501 array result dim(1:j);
\r
510 unit SA:function(s:string):arrayof char;
\r
515 unit CHOOSE:procedure;
\r
522 call range(x,pointer.y-5,0);
\r
523 pointer:=pointer.next;
\r
524 call range(x,pointer.y-5,14);
\r
527 call range(x,pointer.y-5,0);
\r
528 pointer:=pointer.prev;
\r
529 call range(x,pointer.y-5,14);
\r
540 unit ESCAPE:procedure;
\r
546 unit RUNNER:procedure;
\r
548 if pointer.sub=/=none then
\r
549 pointer:=pointer.sub;
\r
550 call drawmenu(pointer);
\r
552 if equal(pointer.name,sa("EXIT ")) then
\r
555 if equal(pointer.name,sa("CREATE ")) then
\r
558 if equal(pointer.name,sa("INSERT ")) then
\r
561 if equal(pointer.name,sa("DELETE ")) then
\r
564 if equal(pointer.name,sa("MEMBER ")) then
\r
567 if equal(pointer.name,sa("CHANGE ")) then
\r
570 if equal(pointer.name,sa("UNION ")) then
\r
572 if equal(pointer.name,sa("BALANCE")) then
\r
574 if equal(pointer.name,sa("DRAW ")) then
\r
577 if equal(pointer.name,sa("PREFIX ")) then
\r
580 if equal(pointer.name,sa("INFIX ")) then
\r
583 if equal(pointer.name,sa("POSTFIX")) then
\r
586 if equal(pointer.name,sa("SAVE ")) then
\r
588 if equal(pointer.name,sa("LOAD ")) then
\r
589 fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;
\r
593 unit CREATE:procedure;
\r
596 var ac:arrayof char;
\r
600 call range(x,pointer.y-5,0);
\r
602 call box(401+i,21+i,178-2*i,28-2*i);
\r
604 call move (410,30);
\r
605 call outhline(sa(" "));
\r
607 call outhline(sa(">"));
\r
608 ac:=inhline(430,30);
\r
611 call box(401+i,21+i,178-2*i,28-2*i);
\r
614 call range(x,pointer.y-5,1);
\r
619 if actual=/=none then
\r
620 while actual.next=/=none do
\r
621 actual:=actual.next;
\r
631 unit INSERT:procedure;
\r
634 var ai:arrayof arrayof char;
\r
638 if actual=none then
\r
639 call BOX(250,150,250,30);
\r
640 call BOX(248,148,254,34);
\r
641 call move(270,160);
\r
642 call OUTHLINE(unpack("YOU CAN'T USE INSERT NOW !"));
\r
646 call box(400,20,200,30);
\r
647 call box(398,18,204,34);
\r
649 call OUTHLINE(sa("INSERT"));
\r
650 call box(400,60,200,200);
\r
652 actual.size:=actual.size+i;
\r
656 call inser(actual.tre,ai(j));
\r
663 call DRAWMENU(pointer);
\r
666 unit MEMBER:procedure;
\r
669 var ai:arrayof arrayof char;
\r
673 if actual=none then
\r
674 call BOX(250,150,250,30);
\r
675 call BOX(248,148,254,34);
\r
676 call move(270,160);
\r
677 call OUTHLINE(unpack("YOU CAN'T USE MEMBER NOW !"));
\r
681 call box(400,20,200,30);
\r
682 call box(398,18,204,34);
\r
684 call OUTHLINE(sa("MEMBER"));
\r
685 call box(400,60,200,200);
\r
690 call membe(actual.tre,ai(j));
\r
697 call DRAWMENU(pointer);
\r
701 unit delete:procedure;
\r
704 var ai:arrayof arrayof char;
\r
708 if actual=none then
\r
709 call BOX(250,150,250,30);
\r
710 call BOX(248,148,254,34);
\r
711 call move(270,160);
\r
712 call OUTHLINE(unpack("YOU CAN'T USE DELETE NOW !"));
\r
716 call box(400,20,200,30);
\r
717 call box(398,18,204,34);
\r
719 call OUTHLINE(sa("DELETE"));
\r
720 call box(400,60,200,200);
\r
722 actual.size:=actual.size-i;
\r
726 call delet(actual.tre,ai(j));
\r
733 call DRAWMENU(pointer);
\r
736 unit CHANGE:procedure;
\r
739 if actual=none then
\r
741 call BOX(250,150,250,30);
\r
742 call BOX(248,148,254,34);
\r
743 call move(270,160);
\r
744 call OUTHLINE(unpack("YOU CAN'T USE CHANGE NOW !"));
\r
746 call drawmenu(pointer);
\r
748 call range(x,pointer.y-5,0);
\r
750 call box(401+i,21+i,178-2*i,28-2*i);
\r
752 call move (410,30);
\r
753 call outhline(sa(" "));
\r
758 call outhline(sa(" "));
\r
760 call outhline(actual.name);
\r
764 if actual.next=/=none then
\r
765 actual:=actual.next;
\r
774 call box(401+i,21+i,178-2*i,28-2*i);
\r
777 call range(x,pointer.y-5,1);
\r
783 unit PAINT:procedure;
\r
786 var toobig:boolean;
\r
788 unit dr:procedure(elem:node,xo:integer,delta:integer,level:integer);
\r
790 call move(xo-upper(elem.e)*4,level*40+10);
\r
791 call outhline(elem.e);
\r
792 if elem.left=/=none then
\r
793 call move(xo,level*40+20);
\r
794 call draw(xo-delta,(level+1)*40);
\r
795 call dr(elem.left,xo-delta,delta/2,level+1);
\r
797 if elem.right=/=none then
\r
798 call move(xo,level*40+20);
\r
799 call draw(xo+delta,(level+1)*40);
\r
800 call dr(elem.right,xo+delta,delta/2,level+1);
\r
806 if actual=none then
\r
807 call BOX(250,150,250,30);
\r
808 call BOX(248,148,254,34);
\r
809 call move(270,160);
\r
810 call OUTHLINE(unpack("YOU CAN'T USE DRAW NOW !"));
\r
815 call outhline(sa(" TREE IS EMPTY "));
\r
818 call dr(elem,320,160,0);
\r
820 call outhline(sa(" TREE IS TOO BIG "));
\r
825 call drawmenu(pointer);
\r
828 unit PREFIX:procedure;
\r
832 unit go4:procedure(elem:node);
\r
834 if elem=/=none then
\r
836 call outhline(elem.e);
\r
843 call go4(elem.left);
\r
844 call go4(elem.right);
\r
849 if actual=none then
\r
850 call BOX(250,150,250,30);
\r
851 call BOX(248,148,254,34);
\r
852 call move(270,160);
\r
853 call OUTHLINE(unpack("YOU CAN'T USE PREFIX NOW !"));
\r
855 call box (260,10,200,30);
\r
856 call box (258,8,204,34);
\r
857 call move (300,20);
\r
858 call outhline(sa("PREFIX"));
\r
859 call box(20,50,200,250);
\r
860 call box(260,50,200,250);
\r
864 if actual.tre=none then
\r
865 call outhline(sa(" TREE IS EMPTY "));
\r
867 call go4(actual.tre);
\r
871 call DRAWMENU(pointer);
\r
874 unit INFIX:procedure;
\r
879 unit go4:procedure(elem:node);
\r
881 if elem=/=none then
\r
883 call go4(elem.left);
\r
885 call outhline(elem.e);
\r
891 call go4(elem.right);
\r
896 if actual=none then
\r
897 call BOX(250,150,250,30);
\r
898 call BOX(248,148,254,34);
\r
899 call move(270,160);
\r
900 call OUTHLINE(unpack("YOU CAN'T USE INFIX NOW !"));
\r
902 call box (260,10,200,30);
\r
903 call box (258,8,204,34);
\r
904 call move (300,20);
\r
905 call outhline(sa("INFIX"));
\r
906 call box(20,50,200,250);
\r
907 call box(260,50,200,250);
\r
911 if actual.tre=none then ;
\r
912 call outhline(sa(" TREE IS EMPTY "));
\r
914 call go4(actual.tre);
\r
918 call DRAWMENU(pointer);
\r
921 unit POSTFIX:procedure;
\r
925 unit go4:procedure(elem:node);
\r
927 if elem=/=none then
\r
929 call go4(elem.left);
\r
930 call go4(elem.right);
\r
933 call outhline(elem.e);
\r
944 if actual=none then
\r
945 call BOX(250,150,250,30);
\r
946 call BOX(248,148,254,34);
\r
947 call move(270,160);
\r
948 call OUTHLINE(unpack("YOU CAN'T USE POSTFIX NOW !"));
\r
950 call box (260,10,200,30);
\r
951 call box (258,8,204,34);
\r
952 call move (300,20);
\r
953 call outhline(sa("POSTFIX"));
\r
954 call box(20,50,200,250);
\r
955 call box(260,50,200,250);
\r
959 if actual.tre=none then
\r
960 call outhline(sa(" TREE IS EMPTY "));
\r
962 call go4(actual.tre);
\r
966 call DRAWMENU(pointer);
\r
969 unit equal:function(a1:arrayof char, a2:arrayof char):boolean;
\r
971 var len1,len2:integer;
\r
977 if len1=/=len2 then
\r
981 for i:=1 to len1 do
\r
982 if ord(a1(i))=/=ord(a2(i)) then
\r
990 unit less:function(a1:arrayof char,a2:arrayof char):boolean;
\r
991 var len1,len2:integer;
\r
1003 if not equal(a1,a2) then
\r
1004 while ord(a1(i))=ord(a2(i)) do
\r
1007 if ord(a1(i))>ord(a2(i)) then result:=false; fi;
\r
1014 var v:arrayof char;
\r
1026 call BOX(210,110,260,80);
\r
1027 call BOX(208,108,264,84);
\r
1029 v:=sa("Binary Search Tree Scanner");
\r
1030 call move(240,125);
\r
1032 v:=sa("written by Peter Miekus");
\r
1033 call move(250,145);
\r
1035 v:=sa("January 6,1989 Ver. 1.0");
\r
1036 call move(250,165);
\r
1038 v:=sa("Hit any key to start");
\r
1039 call move(50,300);
\r
1046 call drawmenu(pointer);
\r