{  18/7/86  21:42   persdbs}

%include "sm:consts.inc"
%include "sm:formats.inc"
%include "sm:persons.inc"
%include "sm:utils.inc"

%begin
%integer maxpers=20
%record(personf)%array a(1:maxpers)
%integer addressno          ;!  Number of distinct addresses in the database.
%record(personf) buff
%constinteger commandno=10
%switch comm(0:commandno)
%conststring(7)%array commands(1:commandno)= %c
"ch","cl","de","di","inp","ins","ou","sc",".a",".end"
%string(31) namelist
%string(31) outfile
%string(31) persfile
%record(personlistf) personlist
%string(255) w,x,y,z

%routine abandon
  message("Program abandoned.","stop")
%end

%integerfn index(%string(7) x,%string(7)%arrayname a,%integer max)
%string(7) y,z
%integer i
  %for i=1,1,max %cycle
    %result=i %if x->y.(a(i)).z %and y=""
  %repeat
  %result=0
%end

%routine read line(%string(*)%name a)
%integer j
  read symbol(j) %until graphic(j)=yes %and j#sp
  a="" %and %return %if j=nl
  a=""
  %cycle
    a=a.tostring(j)
    read symbol(j)
  %repeat %until j=nl
%end

!  This compares two lists of lines.
!  It returns -1 if the first precedes the second,
!  0 if they have the same precedence and 
!  1 if the second precedes the first.
!  A nil record precedes a non-nil record.

%integerfn address order(%record(line80listf)%name a,b)
%record(line80f)%name p,q
  %result=-1 %if (a==nil %or a_head==nil) %and (b##nil %and b_head##nil)
  %result=0 %if (a==nil %or a_head==nil) %and (b==nil %or b_head==nil)
  %result=1 %if (a##nil %and a_head##nil) %and (b==nil %or b_head==nil)
  p==a_head; q==b_head
  %while p##nil %cycle
    %result=1 %if q==nil
    %result=-1 %if p_line<q_line
    %result=1 %if p_line>q_line
    p==p_next; q==q_next
  %repeat
  %result=0 %if q==nil
  %result=-1
%end

%routine copy
%record(personf) p
  select input(1); select output(1)
  print person(buff,"file") %unless buff_id=end
  %cycle
    read person(p)
    %exit %if p_id=end
    print person(p,"file")
  %repeat
  select input(0); select output(0)
%end

%integerfn person order(%record(personf)%name a,b)
%integer i,j
%string(255) x,y
!  Compare IDs.
  x=a_id; lower(x)
  y=b_id; lower(y)
  %if x#"*"#y %thenstart
    %result=-1 %if x<y
    %result=1 %if x>y
  %finish
!  Compare surnames.
  x=a_surname; lower(x)
  y=b_surname; lower(y)
  %if x#"*"#y %thenstart
    %result=-1 %if x<y
    %result=1 %if x>y
  %finish
!  Compare forenames.
  x=a_forenames; lower(x)
  y=b_forenames; lower(y)
  %if x#"*"#y %thenstart
    %result=-1 %if x<y
    %result=1 %if x>y
  %finish
!  Compare addresses.
  %if a_officeaddr_head##nil %and a_officeaddr_head_line#"" %c
  %and b_officeaddr_head##nil %and b_officeaddr_head_line#"" %thenstart
    i=address order(a_officeaddr,b_officeaddr)
    %result=i %if i#0
  %finish
  %result=0
%end

%routine mergeaf(%record(personf)%array(1)%name a,%integer q)
%record(personf)%name s
%string(63) x,y
%integer flag,i
  i=1
  read person(buff)
  %if buff_id=end %thenstart
    print person(a(i),"file") %for i=i,1,q
    %return
  %finish
  %cycle
    s==a(i)
    flag=person order(s,buff)
    %if flag<=0 %thenstart
      print person(a(i),"file")
      i=i+1
      copy %and %return %if i>q
    %finishelsestart
      print person(buff,"file")
      read person(buff)
      %if buff_id=end %thenstart
        print person(a(i),"file") %for i=i,1,q
        %return
      %finish
    %finish
  %repeat
%end

%routine close
%string(15) x
  %if ".in"#namelist#":t" %thenstart
    select input(1); close input; select input(0)
    message("Input ".namelist." closed","")
  %finish
  select output(1); close output; select output(0)
  x="DBS".seqno
  rename(namelist,x) %if namelist=persfile
  rename(outfile,persfile)
  delete(x) %if namelist=persfile
%end

%routine done
  copy
  close
  %stop
%end

%routine reset input
%string(255) x
  select input(1)
  close input
  select input(0)
  message("Input ".namelist." closed.","")
  prompt("Input stream: ")
  %cycle
    read line(x)
    lower(x)
    message("Stopped from console.","stop") %if x=end
    x=fixfile(x,defaultdir,defaultext)
    %exit %if exists(x)
    message(x." does not exist or no access.","")
  %repeat
  open input(1,x)
  select input(1)
%end

%routine reset output
%string(255) x
  select output(1)
  %unless outfile=":t" %thenstart
    close output
    rename(outfile,persfile)
    message("Output ".persfile." closed.","")
  %finish
  select input(0); select output(0)
  prompt("Output stream: ")
  read line(x)
  x=fixfile(x,defaultdir,"imp")
  open output(1,x)
  select output(1)
%end

!  This leaves streams 0 selected for input and output.
!  It returns the name of the file connected to input stream 1.

%string(255)%fn get streams
%string(255) x,y
  %on %event 15 %start
    %stop %if event_sub=1
    %signal %event 15,event_sub
  %finish
  namelist=""; persfile=""
  prompt(prt(43))
  %cycle
    input(x,43)
    lower(x)
    %result=x %if x=end
    y="" %unless x->x.("/").y
    x=fixfile(x,defaultdir,defaultext) %unless x=""
    %if y="" %then y=x %else y=fixfile(y,defaultdir,defaultext)
    %exit %if exists(x)
    print string(x." does not exist or no access.".snl)
  %repeat
  outfile="DBS".seqno.".imp"
  open input(1,x); open output(1,outfile)
  namelist=x; persfile=y
  %result=namelist
%end

%string(255)%fn nameof(%record(personf)%name a)
%string(255) x
  %if ""#a_style#"*" %then x=a_style." " %else x=""
  %if ""#a_initials#"*" %then x=x.a_initials %else x=x.a_forenames." "
  x=x.a_surname
  x=x." ".a_degrees %if ""#a_degrees#"*"
  %result=x
%end

%routine delete records
%integer i,j,next
%string(255) x,y,z
  select input(0); select output(0)
  %stop %if get streams=end
  print string( %c
  "Do you wish to delete all records from the output (".persfile.")?".snl)
  print string(prt(42).snl)
  %if panswer(42)=yes %thenstart
    select output(1)
    close output
    open output(1,outfile)
    close
    %return
  %finish
  select input(0); select output(0)
  %for next=1,1,maxpers %cycle
    read person(a(next))
    next=next-1 %and %exit %if a(next)_id=end
    print person(a(next),":tt")
    message( %c
    "To change any item in the record answer yes to the next prompt.","")
    %while panswer(29)=yes %cycle
      reedit person(a(next))
      print string(prt(29).snl)
    %repeat
  %repeat
  %if next=0 %thenstart
    message("No records identified for deletion.","")
    %return
  %finish
!  Put out an updated file of records.
  select input(1); select output(1)
  j=0
  %for i=1,1,next %cycle
    %cycle
      %if j>=0 %thenstart
        read person(buff)
        %if buff_id=end %thenstart
          x=nameof(a(i))
          message("Input file ".namelist." exhausted. ".snl. %c
          "First remaining record not to be deleted is for ".snl.x,"")
          %return
        %finish
      %finish
      j=person order(a(i),buff)
      print person(buff,"file") %if j=1
    %repeat %until j#1
    %if j=-1 %thenstart
      x=nameof(a(i))
      message("No record available for deletion in the file ".namelist.snl. %c
      "for ".x,"")
    %finishelsestart
      message("Do you really want to delete the record:-","")
      select input(0); select output(0)
      print person(buff,":t")
      print string(prt(46).snl)
      %if panswer(46)=no %thenstart
        select input(1); select output(1)
        print person(buff,"file")
      %finishelsestart
        select input(1); select output(1)
      %finish
      clear person(buff)
    %finish
  %repeat
  copy
  close
%end

%routine print next
!  Print current record in input file.
  select output(1)
  print person(buff,"file") %unless buff_id=end
!  Get next record and print it.
  select input(1)
  read person(buff)
  select input(0); select output(0)
  %if buff_id=end %then message("End of file ".namelist,"") %c
  %else print person(buff,":t")
%end

%routine make
%integer i,next
  select input(0); select output(0)
  %stop %if get streams=end
  %for next=1,1,maxpers %cycle
    read person(a(next))
    next=next-1 %and %exit %if a(next)_id=end
    print person(a(next),":tt")
    message( %c
    "To change any item in the record answer yes to the next prompt.","")
    %while panswer(29)=yes %cycle
      reedit person(a(next))
      print string(prt(29).snl)
    %repeat
  %repeat
  sort persons(a,next)
!  Put out an updated file of records.
  select input(1); select output(1)
  mergeaf(a,next)
  select input(1); select output(1)
  close
%end

%routine change
 select input(0); select output(0)
 %stop %if get streams=end
 select input(1); select output(1)
 %cycle
   read person(buff)
   %exit %if buff_id=end
   message("Do you want to edit this record?","")
   select input(0); select output(0)
   print person(buff,":t")
   print string(prt(29).snl)
   reedit person(buff) %if panswer(29)=yes
   select input(1); select output(1)
   print person(buff,"file")
 %repeat
 close
%end

%routine scan
  select input(0); select output(0)
  %stop %if get streams=end
  select input(1); select output(1)
  %cycle
    read person(buff)
    %exit %if buff_id=end
    message("Do you want to delete this record?","")
    select input(0); select output(0)
    print person(buff,":t")
    print string(prt(46).snl)
    %if panswer(46)=no %thenstart
      select input(1); select output(1)
      print person(buff,"file")
    %finishelse select input(1) %and select output(1)
  %repeat
  close
%end

{Main program}

  %on %event 9 %start
    done
  %finish

  select input(0); select output(0)
  clear person(buff)
  print string("? for help;  .end to stop.".snl)
  %cycle
    select input(0); select output(0)
    prompt("Operation: ")
    read line(x)
    lower(x)
    %if x="?" %thenstart
      print string("The operations available are:".snl)
      print string("Change:    Alter existing records,".snl)
      print string("Close:     Close input and output files,".snl)
      print string("Delete:    Delete chosen existing records,".snl)
      print string("Display:   Display the next record.".snl)
      print string("Input:     Open input stream.".snl)
      print string("Insert:    Add records to the exisiting file,".snl)
      print string("Output:    Open output stream.".snl)
      print string("Scan:      Look at records with the option of deletion".snl)
      print string(".a :       Abandon the program without changing".snl. %c
                   "           anything  since the last closures.".snl)
      print string(".end :     Stop the program.".snl)
      newlines(2)
    %finishelsestart
      ->comm(index(x,commands,commandno))
comm(0):  message(x." not recognised.",""); ->cont
comm(1):  change; -> cont
comm(2):  close; ->cont
comm(3):  delete records; ->cont
comm(4):  print next; ->cont
comm(5):  reset input; ->cont
comm(6):  make; ->cont
comm(7):  reset output; ->cont
comm(8):  scan; ->cont
comm(9):  abandon;
comm(10):  %stop
cont:
    %finish
  %repeat
%endofprogram