[tree();]
putchar char c[if(!c)c='"';return MC c,1]
getchar[return MC 2]
chrdy[return MC 12]
pft char f(0),t(0)[MC f,t,13]
gs char b(0)[return MC b,15]
ps char b(0);[int l;char c;l=-1;while(c=b(++l))MC c,1;return l]
pl char b(0)[MC 13,1;MC 10,1;ps b]
alpha char a[
if((a>='a')*(a<='z')+(a>='A')*(a<='Z'))return 1
]
num char b(0);int v(0)[int k;v(0)=0
while(k<5)[if((b(k)<'0')+(b(k)>'9'))return k
v(0)=10*v(0)+b(k)-'0';++k]
return k]
atoi char b(0);int v(0)[int k,s;char c;s=1;c=b(0)
while((c==' ')+(c=='-')+(c=='+'))[
if(c=='-')s=-1;c=b(++k)]
k=k+num(b+k,v);v(0)=s*v(0);return k]
pn int n[MC ' ',1;MC n,14]
gn[char b(20);int v(0)
while(1)[gs b;if(atoi b,v)return v(0)
ps"number required "]]
ceqn char a(0),b(0);int n[int k;k=-1
while((++k)<n)if(a(k)!=b(k))return 0
return 1]
index char i(0);int l;char f(0);int n[
if(n<=0)return 1
if(l<=0)return 0
int a,d(0);while(a+n<=l)[d(0)=1;a=a+1+scann(i+a,i+l-n,f(0),d)
if(d(0))return 0
if(ceqn(i+a,f+1,n-1))return a]]
move char a(0),b(0)[int k,l(0);l(0)=1;k=scann(a,a+32765,0,l)
movebl(a,a+k,b-a);return k
]
gc[char f;f=MC 2;while(MC(2)!=13)[]
return f
]
movebl char a(0),b(0);int n[MC(a,b,n,7)]
countch char a(0),b(0),c[return MC(a,b,c,8)]
scann char a(0),b(0),c;int n(0)[return MC(a,b,c,n,9)]
readfile char n(0),w(0),l(0);int u[int k,t
if(MC(1,n,0,u,3)<0)[pl"File not found";MC(u,6)return -1]
while(w<=l+1)[k=MC(w,u,4)
if(k==-1)[MC(u,6);return t]
if(k<-1)[MC(u,6);return k]
w=w+k;t=t+k
]
pl"Too big";pl"";MC(u,6);return -2
]
writefile char n(0),b(0),e(0);int u[int k,t,l
if(MC(2,n,e-b+1,u,3)<0)[pl"Unit 1 open";MC(u,6);return -1]
while(b<=e)[l=e-b;if(l>511)l=511
k=MC(b,b+l,u,5);if(k<0)[MC(u,6);return k]
t=t+l+1;b=b+l+1
]
k=MC(u,6);return t
]
fopen int rw;char n(0);int s,u[return MC(rw,n,s,u,3)]
fread char a(0);int u[return MC(a,u,4)]
fwrite char f(0),t(0);int u[return MC(f,t,u,5)]
fclose int u[MC(u,6)]
beep int f,d[MC f,d,17]
cnormal [MC 1000]
chide [MC 1001]
csolid [MC 1002]
cls[MC '\'-'A',1;MC '\'-1,1;MC '2',1;MC 'J',1;posc 1,1]
color char c[MC '\'-'A',1;MC '\'-1,1;MC '3',1;MC c,1;MC 'm',1]
posc int r,c[int R,C;R=25;C=80
if((r>=1)*(r<=R)*(c>=1)*(c<=C)==0)return 1
MC '\'-'A',1;MC '\'-1,1;pos r;MC ';',1;pos c;MC 'H',1;return 0
]
pos int rc[if(rc>9)[MC rc/10+48,1;rc=rc%10]
MC rc+48,1
]
hilo char c[MC '\'-'A',1;MC '\'-1,1;MC c,1;MC 'm',1]
off [chide]
on [cnormal]
solid[csolid]
version [return MC 1003]
int last,seed
random int low,high[int range;if(!last)last=seed=99
range=high-low+1;last=last*seed;if(last<0)last=-last
return low+(last/7)%range
]
strlen char st(0)[int i;while(st(i))++i;return i]
strcat char s(0),t(0)[int i,j;i=strlen(s)
while(t(j))[s(i)=t(j);++i;++j];s(i)=0]
strcpy char s(0),t(0)[
int i;while((s(i)=t(i)))++i
]
sak[pl"Press Enter ... ";return getchar]
exit[MC 10]
tolower char s(0)[int i;for(i=0;i<strlen(s);++i)
if((s(i)>='A')*(s(i)<='Z'))s(i)=s(i)+' '
]
toupper char s(0)[int i;for(i=0;i<strlen(s);++i)
if((s(i)>='a')*(s(i)<='z'))s(i)=s(i)-' '
]
memset char s(0);int b;char c[MC s,b,c,16]
endlibrary

/* 12/14/8 - lrb - treed.ipl - standalone for DOS

int mxp,mxc,n,root
int lf,rt,text
int base(2),av(100) /* for starters ...
char tr(100*80)
int gdup

co char st1(0),st2(0);int n [
  int ctr
  while (n-ctr) [
    if (st1(ctr)<st2(ctr)) return -1
    if (st1(ctr)>st2(ctr)) return +1
    ++ctr
    ]
  return 0
]

delete [
  int ptr(0),k,pp(0),pr(0),res,np,cl,rez
  char st(mxc-5)
  pl "-> Del <-"
  while (n) [
    pl ""
    k = getst(st)
    if (!k) return
    res=sniff(st,ptr,k,pp,pr)
    if (res) pl "Not found"
    else [
      np=rub(ptr(0))
      cl=mxc+1
      while (--cl) tr(sb(ptr(0),cl))=0
      rez=lf;if (pr(0)==1) rez=rt
      if (pp(0)) pia((tr+sb(pp(0),rez)),np)
      else root=np
      push ptr(0)
      pl "Record"
      pn ptr(0)
      ps " deleted"
      ]
    ]
  pl "";pl "Empty";pl ""
  init
]

tree [
  int choice
  init
  cls;posc 2,10
  hilo '1';color '4'
  pl "treed.ipl - 12/14/8"
  hilo '0'
  pl ""
  while (choice=getchoice()) [
    if (choice==1) insert
    else if (choice==7) finsert
    else if (choice==2) delete
    else if (choice==3) search
    else if (choice==4) list
    else if (choice==5) write
    else if (choice==6) read
    ]
]

getchoice [
  pl "0=Quit 1=Insert from keyboard 2=Delete 3=Search"
  pl "4=List tree 5=Write tree 6=Read tree 7=Insert from file"
  pl "";pl "Enter number [0-7] "
  return gn
]

format int nm [
  int spaces
  pn nm
  if (nm<10) spaces=8
  else if (nm<100) spaces=7
  else if (nm<1000) spaces=6
  while (--spaces) ps " "
]

getname char fname(13) [
  int k
  k=gs(fname)
  if (k>14) [
    pl "Name too long"
    return 1
    ]
  return k
]

getst char st(0) [
  int k
  pl ""
  ps "Enter string: "
  k=gs(st)
  while (k>(mxc-4)) [
    pl "String exceeds max length of "
    pn mxc-4;ps " re-enter";pl "";k=gs(st)
    ]
  return k
]

init [
  root=1
  lf=1
  rt=3
  text=5
  mxp=100 /* for starters ...
  mxc=80
  av=base+3*2 /* note the 2's
  tr=av+mxp*2
  n=mxp+1
  while (--n) av(n-1)=n
]

insert [
  int k,ptr(0),res,dummy(0),np,rez
  char st(mxc-5)
  pl "-> Insertion <-"
  while (n<mxp) [
    pl "";k=getst(st)
    if (!k) return
    res=sniff(st,ptr,k,dummy,dummy)
    if (!res) pl "Record exists"
    else [
      np=pop
      rez=lf;if (res==1) rez=rt
      if (np!=root) pia((tr+sb(ptr(0),rez)),np)
      move(st,(tr+sb(np,text)))
      pl "Key ="
      pn np
      ]
    ]
  pl ""
  pl "Table is full"
  pl ""
]

list [
  int index(0),ptr(0),stack(mxp-1)
  pl ""
  if (n) [
    pl "Key     Text"
    pl ""
    index(0)=-1
    ptr(0)=root
    traverse(index,ptr,stack)
    pl ""
    ]
  else [
    pl "Nothing to list"
    pl ""
    ]
]

pop [
  int nextptr
  nextptr=av(n)
  ++n
  return nextptr
]

push int oldptr [
  --n
  av(n)=oldptr
  return n
]

read [
  pl ""
  pl "-> Read <-"
  pl ""
  char fname(13)
  int k
  pl "Input file: "
  k=getname(fname)
  if ((k==1)+(k==0)) return
  readfile(fname,base,tr+sb(mxp,mxc),1)
  n=base(0)
  root=base(1)
  gdup=base(2)
]

rub int ptr [
  int r,s,t
  t=ptr
  if (!gia(tr+sb(t,rt))) return gia(tr+sb(t,lf))
  if (!gia(tr+sb(t,lf))) return gia(tr+sb(t,rt))
  r=gia(tr+sb(t,rt))
  if (!gia(tr+sb(r,lf))) [
    pia((tr+sb(r,lf)),gia(tr+sb(t,lf)))
    return r
    ]
  s=gia(tr+sb(r,lf))
  while (gia(tr+sb(s,lf))) [
    r=s
    s=gia(tr+sb(r,lf))
    ]
  pia((tr+sb(s,lf)),gia(tr+sb(t,lf)))
  pia((tr+sb(r,lf)),gia(tr+sb(s,rt)))
  pia((tr+sb(s,rt)),gia(tr+sb(t,rt)))
  return s
]

search [
  int res,k,ptr(0),dummy(0)
  char st(mxc-5)
  pl "-> Search <-"
  while (1) [
    pl ""
    k=getst(st)
    if (!k) return
    res=sniff(st,ptr,k,dummy,dummy)
    if (res) pl "Not found"
    else [
      pl "Found at "
      pn ptr(0)
      ps " : "
      ps tr+sb(ptr(0),text)
      ]
    ]
]

sniff char st(0)
  int ptr(0),k,pp(0),pr(0) [
  int temp,res,rez
  pp(0)=pr(0)=0
  ptr(0)=root
  while (1) [
    res=co(st,(tr+sb(ptr(0),text)),k)
    if (!res) return 0
    rez=lf;if (res==1) rez=rt
    temp=gia(tr+sb(ptr(0),rez))
    if (!temp) return res
    pp(0)=ptr(0)
    pr(0)=res
    ptr(0)=temp
    ]
]

sb int row, col [return col-1+mxc*(row-1)]

traverse int index(0),ptr(0),stack(mxp-1) [
  index(0)=index(0)+1
  stack(index(0))=ptr(0)
  if (gia(tr+sb(ptr(0),lf))) [
    ptr(0)=gia(tr+sb(ptr(0),lf))
    traverse(index,ptr,stack)
    ]
  pl ""
  format(ptr(0))
  ps tr+sb(ptr(0),text)
  if (gia(tr+sb(ptr(0),rt))) [
    ptr(0)=gia(tr+sb(ptr(0),rt))
    traverse(index,ptr,stack)
    ]
  if (!index(0)) return
  index(0)=index(0)-1
  ptr(0)=stack(index(0))
]

gia char a(0) [ /* get integer in a(0),a(1)
return 128*a(0)+a(1)
]

pia char a(0);int i [ /* put integer i in a(0),a(1)
a(1)=i%128;a(0)=i/128
]

write [
  char fname(13)
  pl "-> Write <-"
  pl ""
  pl "Output file: "
  int k
  k=getname(fname)
  if ((k==0)+(k==1)) return
  base(0)=n
  base(1)=root
  base(2)=gdup
  writefile (fname,base,tr+sb(mxp,mxc),1)
]

reverse char s(0) [ /* reverse string s in place
int c,i,j
i=0;j=strlen(s)-1
while (i<j) [c=s(i);s(i)=s(j);s(j)=c;++i;--j]
]

itoa int n;char nst(0) [ /* convert integer n to string nst
int w
w=0;nst(0)=n%10+'0';n=n/10
while(n) [nst(++w)=n%10+'0';n=n/10]
nst(++w)=0
reverse(nst)
]

finsert [ /* insert from file
  int k,ptr(0),res,dummy(0),np,rez
  char st(mxc-5)
  char lbs(2);lbs(0)=' ';lbs(1)='Z'+1 /* left bracket
  char dups(5) /* space left bracket nnn
  pl "-> Insertion from File <-"
  char tex(5000);int i,j,tl;char nls(1),fname(13)
  nls(0)=10
  pl "";pl "Input file: "
  k=getname(fname)
  if ((k==1)+(k==0)) return
  if ((tl=readfile(fname,tex,tex+4500,1))<0) return
  char crs(1);crs(0)=13
  while(j=index(tex,tl,crs,1)) [movebl(tex+j,tex+j+tl,-1);--tl]
  strcat(tex,nls);pl ""
  while ((n<mxp)*(i=index(tex,strlen(tex),nls,1))) [
    if (i==1) strcpy(tex,tex+1)
    else [ /* 1
      tex(i-1)=0;strcpy(st,tex);strcpy(tex,tex+i)
      k=strlen(st)
      res=sniff(st,ptr,k,dummy,dummy)
      if (!res) [
        /* duplicate - tack on space left bracket nnn
        strcat(st,lbs);itoa(++gdup,dups);strcat(st,dups)
        res=sniff(st,ptr,k+5,dummy,dummy)
        ]
      np=pop
      if (np!=root) [
        rez=lf;if (res==1) rez=rt
        pia((tr+sb(ptr(0),rez)),np)
        ]
      move (st,(tr+sb(np,text)))
      pl "Key ="
      pn np
      ] /* 1
    ] /* while
    if (!i) [
      pl "";return
      ]
    else [
      pl "";pl "Table is full";pl ""
      ]
]