int mxp, mxc, n, root
int lf, rt, text, nu
int base(1), av(127-1)
char tr(127*80-1)
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 nu
]

delete [
  int ptr(0),k,pp(0),pr(0),res,np,cl
  char st(mxc - 3)
  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
      if (pp(0)) tr(sb(pp(0),((pr(0)+3)/2)))=np
      else root=np
      push ptr(0)
      pl "Record"
      pn ptr(0)
      ps " deleted"
    ]
  ]
  pl "";pl "Empty";pl ""
  init
]

treed [
  int choice
  init
  pl "treed.tc - 12/4/8"
  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=Ins 2=Del 3=Search 4=List 5=Write 6=Read 7=File Ins : "
  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,lk
  pl ""
  ps "Enter string: "
  k=gs(st)
  while (k>(mxc-2)) [
    pl "String exceeds max length of "
    pn mxc-2;ps " re-enter";pl "";k=gs(st)
  ]
  return k
]

init [
  root=1
  lf=1
  rt=2
  text=3
  mxp=127 /* 0 <= mxp <= 127 
  mxc=80
  av=base+2*4 /* note the 4!
  tr=av+mxp*4 /* note the 4!
  n=mxp+1
  while (--n) av(n-1)=n
]

insert [
  int k,ptr(0),res,dummy(0),np
  char st(mxc-3)
  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
      if (np!=root) tr(sb(ptr(0),((res+3)/2)))=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)
]

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

search [
  int res,k,ptr(0),dummy(0)
  char st(mxc-3)
  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
  pp(0)=pr(0)=0
  ptr(0)=root
  while (1) [
    res=co(st,(tr+sb(ptr(0),text)),k)
    if (!res) return 0
    temp=tr(sb(ptr(0),((res+3)/2)))
    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 (tr(sb(ptr(0),lf))) [
    ptr(0)=tr(sb(ptr(0),lf))
    traverse(index,ptr,stack)
    ]
  pl ""
  format(ptr(0))
  ps tr+sb(ptr(0),text)
  if (tr(sb (ptr(0),rt))) [
    ptr(0)=tr(sb(ptr(0),rt))
    traverse(index,ptr,stack)
    ]
  if (!index(0)) return
  index(0)=index(0)-1
  ptr(0)=stack(index(0))
]

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
  writefile (fname,base,tr+sb(mxp,mxc),1)
]

reverse char s(4) [ /* 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(4) [ /* 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
  char st(mxc-3)
  char lbs(2);lbs(0)=' ';lbs(1)='Z'+1 /* left bracket
  char dups(4)
  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 left bracket followed by nn
        strcat(st,lbs);itoa(++gdup,dups);strcat(st,dups)
        res=sniff(st,ptr,k+5,dummy,dummy)  
        ]
      np=pop
      if (np!=root) tr(sb(ptr(0),((res+3)/2)))=np
      move (st,(tr+sb(np,text)))
      pl "Key ="
      pn np
      ] /* 1 
    ] /* while
    if (!i) [
      pl "";return
      ]
    else [
      pl "";pl "Table is full";pl ""
      ]
]