program BSTscanner; begin pref iiuwgraph block unit inchar :function: integer; var i : integer; begin do i := inkey; if i <> 0 then exit fi; od; result := i; end inchar; unit node:class; var left:node; var right:node; var e:arrayof char; end node; unit head:class; var tre:node; var size:integer; var name:arrayof char; var next:head; end; unit MENU:class; var y:integer; var name:arrayof char; var sub:menu; var next:menu; var prev:menu; end menu; unit directory:procedure; var hel1,hel2,hel3,hel4:menu; var tru:boolean; begin tru:=true; hel1:=new menu; pointer:=hel1; hel1.name:=sa("DISC "); hel1.y:=135; hel2:=new menu; hel2.name:=sa("TREE "); hel2.y:=155; hel1.next:=hel2; hel2.prev:=hel1; hel3:=new menu; hel3.name:=sa("EXIT "); hel3.y:=175; hel2.next:=hel3; hel3.prev:=hel2; hel3.next:=hel1; hel1.prev:=hel3; hel3:=new menu; hel3.name:=sa("UPDIR "); hel3.y:=135; hel3.sub:=hel1; hel1.sub:=hel3; hel1:=new menu; hel1.name:=sa("SAVEnot"); hel1.y:=155; hel3.next:=hel1; hel1.prev:=hel3; hel4:=new menu; hel4.name:=sa("LOADnot"); hel4.y:=175; hel3.prev:=hel4; hel4.next:=hel3; hel1.next:=hel4; hel4.prev:=hel1; hel1:=hel3.sub; hel3:=new menu; hel3.name:=sa("UPDIR "); hel3.y:=95; hel2.sub:=hel3; hel3.sub:=hel1; hel2:=new menu; hel2.name:=sa("CREATE "); hel2.y:=115; hel2.prev:=hel3; hel3.next:=hel2; hel4:=new menu; hel4.name:=sa("INSERT "); hel4.y:=135; hel4.prev:=hel2; hel2.next:=hel4; hel2:=new menu; hel2.name:=sa("DELETE "); hel2.y:=155; hel2.prev:=hel4; hel4.next:=hel2; hel4:=new menu; hel4.name:=sa("MEMBER "); hel4.y:=175; hel4.prev:=hel2; hel2.next:=hel4; hel2:=new menu; hel2.name:=sa("CHANGE "); hel2.y:=195; hel2.prev:=hel4; hel4.next:=hel2; hel4:=new menu; hel4.name:=sa("WRITE "); hel4.y:=215; hel4.prev:=hel2; hel2.next:=hel4; hel4.next:=hel3; hel3.prev:=hel4; hel2:=new menu; hel2.name:=sa("UPDIR "); hel2.y:=115; hel4.sub:=hel2; hel2.sub:=hel3; hel4:=new menu; hel4.name:=sa("DRAW "); hel4.y:=135; hel4.prev:=hel2; hel2.next:=hel4; hel3:=new menu; hel3.name:=sa("PREFIX "); hel3.y:=155; hel3.prev:=hel4; hel4.next:=hel3; hel4:=new menu; hel4.name:=sa("INFIX "); hel4.y:=175; hel4.prev:=hel3; hel3.next:=hel4; hel3:=new menu; hel3.name:=sa("POSTFIX"); hel3.y:=195; hel3.prev:=hel4; hel4.next:=hel3; hel3.next:=hel2; hel2.prev:=hel3; pointer:=hel1; end directory; unit RANGE:procedure(x:integer,y:integer,i:integer); begin call color(i); call move(x,y); call draw(x+120,y); call draw(x+120,y+20); call draw(x,y+20); call draw(x,y); call color(2); end range; unit BOX:procedure(xc,yc:integer;lenght,szer:integer); begin call move(xc,yc); call color(14); call draw(xc+lenght,yc); call draw(xc+lenght,yc+szer); call draw(xc,yc+szer); call draw(xc,yc); end box; unit CLR:procedure; begin call cls; call color(14); call move(0,0); call draw(618,0); call draw(618,319); call draw(0,319); call draw(0,0); end clr; unit drawmenu:procedure(pointer:menu); var phelp:menu; var yhelp:integer; var n,i,j:integer; var sub,run:arrayof char; begin call clr; call color(2); call box(400,20,200,30); call box(398,18,204,34); if actual=/=none then call move(420,30); call outhline(actual.name); fi; sub:=sa(" sub"); run:=sa(" run"); phelp:=pointer; yhelp:=phelp.y; n:=1; phelp:=phelp.next; while yhelp=/= phelp.y do phelp:=phelp.next; n:=n+1; od; call color(14); x:=270; y:=(320-n*20-20)/2; call move(x,y); call draw(x+140,y); call draw(x+140,y+n*20+20); call draw(x,y+n*20+20); call draw(x,y); x:=268; y:=y-2; call move(x,y); call draw(x+144,y); call draw(x+144,y+n*20+24); call draw(x,y+n*20+24); call draw(x,y); for i:=1 to 8 do call move(x+144+i,y+5); call draw(x+144+i,y+n*20+24+i); call draw(x+5,y+n*20+24+i); od; x:=x+20; for j:=1 to n do y:=phelp.y; call move(x,y); call OUTHLINE(phelp.name); if phelp.sub =/=none then; call OUTHLINE(sub); else call OUTHLINE(run); fi; phelp:=phelp.next; od; x:=x-10; y:=phelp.y-5; call RANGE(x,y,1); end drawmenu; unit OUTHLINE:procedure(a:arrayof char); var i:integer; var j:integer; begin call color(11); (* czerwony *) i:=upper(a); for j:=1 to i do call hascii(0); call hascii(ord(a(j))); od; end outhline; unit INHLINE:function(xc:integer;yc:integer):arrayof char; var i:integer; var count:integer; var ik:integer; var ar:arrayof char; begin call move(xc,yc); count:=0; array ar dim(1:13); while ik=/=13 and count<13 do ik:=inchar; if ik=8 and count>0 then ar(count):=' '; count:=count-1; call move(xc+(count)*8,yc); call hascii(0); else if ik=/=13 then count:=count+1; ar(count):=chr(ik); call hascii(0); call hascii(ik); fi; fi; od; if count=/=0 then array result dim(1:count); for i:=1 to count do result(i):=ar(i); od; fi; end inhline; unit SEARCH:class(where:node;what:arrayof char); var hel1:node,hel2:node; var isit:boolean; begin hel1:=where; hel2:=none; do if hel1=none then exit else if equal(hel1.e,what) then exit else hel2:=hel1; if not less(hel1.e,what) then hel1:=hel1.left; else hel1:=hel1.right; fi; fi; fi; od; if hel1=/=none then isit:=true; else isit:= false; fi end search; unit membe:SEARCH procedure; begin if isit then call outhline(sa(" EXISTS ")); else call outhline(sa(" DOESN'T EXIST")); fi; end membe; unit INSER:SEARCH procedure; var help:node; begin if where=none then help:=new node; call OUTHLINE(sa(" O.K.")); help.e:=what; actual.tre:=help; else if isit then call OUTHLINE(sa(" ALREADY EXIXTS")); else help:=new node; call OUTHLINE(sa(" O.K.")); help.e:=what; if not less(hel2.e,what) then hel2.left:=help; else hel2.right:=help; fi; fi; fi; end inser; unit delet:SEARCH procedure; var i:integer; var pom:node; begin if where=none then call OUTHLINE(sa(" TREE IS EMPTY ")); else if not isit then call OUTHLINE(sa("DOESN'T EXIST")); else call outhline(sa(" O.K. ")); if hel2=none then if hel1.right<>none then where:=hel1.right; pom:=where; do if pom.left=none then exit; else pom:=pom.left; fi; od; pom.left:=hel1.left; kill(hel1); actual.tre:=where; else if hel1.left<>none then where:=hel1.left; pom:=where; do; if pom.right=none then exit; else pom:=pom.right; fi; od; pom.right:=hel1.right; kill(hel1); actual.tre:=where; else where:=none; kill (hel1); fi; fi; (****** 1 to 2 *****) else if not less(hel1.e,hel2.e) then if hel1.left=none then hel2.right:=hel1.right; kill (hel1); else if hel1.right=none then hel2.right:=hel1.left; kill (hel1); else hel2.right:=hel1.right; pom:=hel2.right; while pom.left=/=none do pom:=pom.left; od; pom.left:=hel1.left; kill (hel1); fi; fi; else if hel1.left=none then hel2.left:=hel1.right; kill (hel1); else if hel1.right=none then hel2.left:=hel1.left; kill (hel1); else hel2.left:=hel1.left; pom:=hel1.left; while pom.right=/=none do pom:=pom.right; od; pom.right:=hel1.right; kill (hel1); fi; fi; fi; fi; fi; fi; end delet; unit GIVEME:function:arrayof arrayof char; var i,j:integer; var a:arrayof arrayof char; var ac:arrayof char; var x,y:integer; var count:integer; begin call clr; call box(100,20,200,30); call box(98,18,204,34); CALL move(110,30); call outhline(sa(" GIVE ME ELEMENTS")); call box(100,60,200,200); x:=180; y:=70; j:=0; array a dim(1:16); do call move(x-10,y); call outhline(sa(">")); ac:=inhline(x,y); if ac=none or j> 15 then exit else j:=j+1; a(j):=ac; fi; y:=y+10; od; if j=/=0 then array result dim(1:j); for i:=1 to j do result(i):=a(i); od; fi; end giveme; unit SA:function(s:string):arrayof char; begin result:=unpack(s); end sa; unit CHOOSE:procedure; var i:integer; begin do i:=inkey; if i=-80 then call range(x,pointer.y-5,0); pointer:=pointer.next; call range(x,pointer.y-5,14); else if i=-72 then call range(x,pointer.y-5,0); pointer:=pointer.prev; call range(x,pointer.y-5,14); else if i=13 then call runner; fi; fi; fi; od; end choose; unit ESCAPE:procedure; begin call groff; call endrun; end escape; unit RUNNER:procedure; begin if pointer.sub=/=none then pointer:=pointer.sub; call drawmenu(pointer); else if equal(pointer.name,sa("EXIT ")) then call ESCAPE; else if equal(pointer.name,sa("CREATE ")) then call CREATE; else if equal(pointer.name,sa("INSERT ")) then call INSERT; else if equal(pointer.name,sa("DELETE ")) then call DELETE; else if equal(pointer.name,sa("MEMBER ")) then call MEMBER; else if equal(pointer.name,sa("CHANGE ")) then call CHANGE; else if equal(pointer.name,sa("UNION ")) then else if equal(pointer.name,sa("BALANCE")) then else if equal(pointer.name,sa("DRAW ")) then call PAINT; else if equal(pointer.name,sa("PREFIX ")) then call PREFIX; else if equal(pointer.name,sa("INFIX ")) then call INFIX; else if equal(pointer.name,sa("POSTFIX")) then call POSTFIX; else if equal(pointer.name,sa("SAVE ")) then else if equal(pointer.name,sa("LOAD ")) then fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi;fi; end; unit CREATE:procedure; var h:head; var ac:arrayof char; var i:integer; begin call range(x,pointer.y-5,0); for i:=0 to 7 do call box(401+i,21+i,178-2*i,28-2*i); od; call move (410,30); call outhline(sa(" ")); call move(420,31); call outhline(sa(">")); ac:=inhline(430,30); call color(0); for i:=0 to 7 do call box(401+i,21+i,178-2*i,28-2*i); od; call color(2); call range(x,pointer.y-5,1); if ac=/=none then h:=new head; h.name:=ac; actual:=tree; if actual=/=none then while actual.next=/=none do actual:=actual.next; od; actual.next:=h; else tree:=h; fi; actual:=h; fi; end create; unit INSERT:procedure; var i,j,y:integer; var ai:arrayof arrayof char; begin call clr; if actual=none then call BOX(250,150,250,30); call BOX(248,148,254,34); call move(270,160); call OUTHLINE(unpack("YOU CAN'T USE INSERT NOW !")); else ai:=giveme; if ai<>none then call box(400,20,200,30); call box(398,18,204,34); call move(470,30); call OUTHLINE(sa("INSERT")); call box(400,60,200,200); i:=upper(ai); actual.size:=actual.size+i; y:=70; for j:=1 to i do call move(430,y); call inser(actual.tre,ai(j)); y:=y+10; od; fi; fi; i:=inchar; call CLR; call DRAWMENU(pointer); end insert; unit MEMBER:procedure; var i,j,y:integer; var ai:arrayof arrayof char; begin call clr; if actual=none then call BOX(250,150,250,30); call BOX(248,148,254,34); call move(270,160); call OUTHLINE(unpack("YOU CAN'T USE MEMBER NOW !")); else ai:=giveme; if ai<>none then call box(400,20,200,30); call box(398,18,204,34); call move(470,30); call OUTHLINE(sa("MEMBER")); call box(400,60,200,200); i:=upper(ai); y:=70; for j:=1 to i do call move(430,y); call membe(actual.tre,ai(j)); y:=y+10; od; fi; fi; i:=inchar; call CLR; call DRAWMENU(pointer); end; unit delete:procedure; var i,j,y:integer; var ai:arrayof arrayof char; begin call clr; if actual=none then call BOX(250,150,250,30); call BOX(248,148,254,34); call move(270,160); call OUTHLINE(unpack("YOU CAN'T USE DELETE NOW !")); else ai:=giveme; if ai<> none then call box(400,20,200,30); call box(398,18,204,34); call move(470,30); call OUTHLINE(sa("DELETE")); call box(400,60,200,200); i:=upper(ai); actual.size:=actual.size-i; y:=70; for j:=1 to i do call move(430,y); call delet(actual.tre,ai(j)); y:=y+10; od; fi; fi; i:=inchar; call DRAWMENU(pointer); end delete; unit CHANGE:procedure; var i:integer; begin if actual=none then call clr; call BOX(250,150,250,30); call BOX(248,148,254,34); call move(270,160); call OUTHLINE(unpack("YOU CAN'T USE CHANGE NOW !")); i:=inchar; call drawmenu(pointer); else call range(x,pointer.y-5,0); for i:=0 to 7 do call box(401+i,21+i,178-2*i,28-2*i); od; call move (410,30); call outhline(sa(" ")); actual:=tree; do call move(420,30); call outhline(sa(" ")); call move(420,30); call outhline(actual.name); i:=inchar; if i=13 then exit else if actual.next=/=none then actual:=actual.next; else actual:=tree; fi; fi; od; call color(0); for i:=0 to 7 do call box(401+i,21+i,178-2*i,28-2*i); od; call color(2); call range(x,pointer.y-5,1); fi; end change; unit PAINT:procedure; var i:integer; var toobig:boolean; unit dr:procedure(elem:node,xo:integer,delta:integer,level:integer); begin call move(xo-upper(elem.e)*4,level*40+10); call outhline(elem.e); if elem.left=/=none then call move(xo,level*40+20); call draw(xo-delta,(level+1)*40); call dr(elem.left,xo-delta,delta/2,level+1); fi; if elem.right=/=none then call move(xo,level*40+20); call draw(xo+delta,(level+1)*40); call dr(elem.right,xo+delta,delta/2,level+1); fi; end dr; begin call clr; if actual=none then call BOX(250,150,250,30); call BOX(248,148,254,34); call move(270,160); call OUTHLINE(unpack("YOU CAN'T USE DRAW NOW !")); else elem:=actual.tre; if elem=none then call clr; call outhline(sa(" TREE IS EMPTY ")); else toobig:=false; call dr(elem,320,160,0); if toobig then ; call outhline(sa(" TREE IS TOO BIG ")); fi; fi; FI; i:=inchar; call drawmenu(pointer); end paint; unit PREFIX:procedure; var h:node; var i:integer; var x,y:integer; unit go4:procedure(elem:node); begin if elem=/=none then call move(x,y); call outhline(elem.e); y:=y+10; if y>290 then y:=60; x:=x+240; fi; call go4(elem.left); call go4(elem.right); fi; end go4; begin call CLR; if actual=none then call BOX(250,150,250,30); call BOX(248,148,254,34); call move(270,160); call OUTHLINE(unpack("YOU CAN'T USE PREFIX NOW !")); else call box (260,10,200,30); call box (258,8,204,34); call move (300,20); call outhline(sa("PREFIX")); call box(20,50,200,250); call box(260,50,200,250); x:=50; y:=60; if actual.tre=none then call outhline(sa(" TREE IS EMPTY ")); else call go4(actual.tre); fi; fi; i:=inchar; call DRAWMENU(pointer); end prefix; unit INFIX:procedure; var h:node; var i:integer; var x,y:integer; unit go4:procedure(elem:node); begin if elem=/=none then call go4(elem.left); call move(x,y); call outhline(elem.e); y:=y+10; if y>290 then y:=60; x:=x+240; fi; call go4(elem.right); fi; end go4; begin call CLR; if actual=none then call BOX(250,150,250,30); call BOX(248,148,254,34); call move(270,160); call OUTHLINE(unpack("YOU CAN'T USE INFIX NOW !")); else call box (260,10,200,30); call box (258,8,204,34); call move (300,20); call outhline(sa("INFIX")); call box(20,50,200,250); call box(260,50,200,250); x:=50; y:=60; if actual.tre=none then ; call outhline(sa(" TREE IS EMPTY ")); else call go4(actual.tre); fi; fi; i:=inchar; call DRAWMENU(pointer); end infix; unit POSTFIX:procedure; var h:node; var i:integer; var x,y:integer; unit go4:procedure(elem:node); begin if elem=/=none then call go4(elem.left); call go4(elem.right); call move(x,y); call outhline(elem.e); y:=y+10; if y>290 then y:=60; x:=x+240; fi; fi; end go4; begin call CLR; call color(12); if actual=none then call BOX(250,150,250,30); call BOX(248,148,254,34); call move(270,160); call OUTHLINE(unpack("YOU CAN'T USE POSTFIX NOW !")); else call box (260,10,200,30); call box (258,8,204,34); call move (300,20); call outhline(sa("POSTFIX")); call box(20,50,200,250); call box(260,50,200,250); x:=50; y:=60; if actual.tre=none then call outhline(sa(" TREE IS EMPTY ")); else call go4(actual.tre); fi; fi; i:=inchar; call DRAWMENU(pointer); end postfix; unit equal:function(a1:arrayof char, a2:arrayof char):boolean; var len1,len2:integer; var i:integer; begin len1:=upper(a1); len2:=upper(a2); if len1=/=len2 then result:=false else result:=true; for i:=1 to len1 do if ord(a1(i))=/=ord(a2(i)) then result:=false; fi; od; fi; end equal; unit less:function(a1:arrayof char,a2:arrayof char):boolean; var len1,len2:integer; var i:integer; begin len1:=upper(a1); len2:=upper(a2); if len1>len2 then result:=false; else result:=true; if len1=len2 then i:=1; if not equal(a1,a2) then while ord(a1(i))=ord(a2(i)) do i:=i+1; od; if ord(a1(i))>ord(a2(i)) then result:=false; fi; fi; fi; fi; end less; var v:arrayof char; var elem:node; var pointer:menu; var x,y:integer; var ii:integer; var actual:head; var tree:head; begin call gron(0); call color(14); call BOX(210,110,260,80); call BOX(208,108,264,84); v:=sa("Binary Search Tree Scanner"); call move(240,125); call outhline(v); v:=sa("written by Peter Miekus"); call move(250,145); call outhline(v); v:=sa("January 6,1989 Ver. 1.0"); call move(250,165); call outhline(v); v:=sa("Hit any key to start"); call move(50,300); call outhline(v); ii:=inchar; call cls; call color(2); call directory; call drawmenu(pointer); call choose; call groff; end; end