program lpmerge;

   {merge name index files into one large one}

   {Brian Gilmore August 1987}
                 {October - modified for new database format}

TYPE
   nxf = record
        s : string[40];
        sname : string[4];
        street : 0..255;
        r_no: 0..65000;
        reg, lreg: 0..255;
        max : integer;
        nam : string[4];
   end;
   nxff = array [1..6] of nxf;
   indxx = array [0..50] of 0..65000;

   {$I lptype} 

VAR
   control: text;
   chainfile: prog;
   number, attr_clear, last_address: byte;
   dbfilx, dbfil2, dbfil3, dbfil4, dbfil5, dbfil6 : ntfile;
   nafilx, nafil2, nafil3, nafil4, nafil5, nafil6 : namf;
   ndfilx, ndfil2, ndfil3, ndfil4, ndfil5, ndfil6 : nffile;
   na : nxff;
   i, q, xx, x1, x2, x3, x4, x5, x6 : s_integer;
   max1, max2, max3, max4 : integer;
   indx : indxx;
   r1,r2,r3,r4,r5,r6 : string[4];

   {$I lpexti}


PROCEDURE Request_xRegister(VAR dbfile : ntfile; VAR nafile: namf;
                            VAR ndfile : nffile; s : sts; VAR max_val: integer);
   var i: byte;
       xxx : integer;
       ofn, nfn, ndn, ffn, pfn: string[14];
   BEGIN
      xxx := max_val;
      REPEAT
      i := 1;
      if s = '' then begin     {no input file specification}
         clearline(max_row-2);
         write('Register Name?'); readln(reg);
      end else begin
         reg := s;  s := '';
         cursor(21,0); writeln('[', reg, ']');
      end;
      if pos(':', reg) = 2 then begin        {force a disc drive specification}
         disc := copy(reg, 1, 2);
         if length(reg)>2 then reg := copy(reg, 3, length(reg)-2);
      end;

      ofn := concat(disc,reg,'.DAT');
      nfn := concat(disc,reg,'.NAM');
      ndn := concat(disc,reg,'.IND');
      if reg[1] = 's' then begin
         if not fstat(ofn) then begin
            cursor(max_row-2,30);
            write('Database file missing, Check name or Change disc!');
            cursor(max_row-2, 15); write('      '); i := 0;
         end;
      end;
      UNTIL i<>0;

      if reg[1] = 's' then begin
         assign(dbfile, ofn); update(dbfile);
         assign(nafile, nfn); update(nafile);
         seek(dbfile, 0); max_val := dbfile^.namind;
      end;
      if xxx = 0 then begin
          assign(ndfile, ndn); update(ndfile);
      end;
   END;

PROCEDURE getxstr(VAR nafile : namf; VAR s:sts; VAR x: s_integer);
   VAR i, j: byte;
   BEGIN
      seek(nafile, x); x := x+1;
      s := '';
      j := ord(nafile^);
      if j > 0 then begin
         for i := 1 to j do begin
            seek(nafile, x); x := x+1;
            s := concat(s, nafile^);
         end;
      end;
   END;

PROCEDURE get_xnames(VAR dbfile: ntfile; VAR nafile : namf);
   VAR x, y: s_integer;
       vote: byte;
   BEGIN
           {get surname & firstname from the NAME file}

      x := dbfile^.namind;    {pointer for surname in name file}
      getxstr(nafile, surname, x);
   END;

PROCEDURE gxn(VAR ndfile : nffile; VAR dbfile : ntfile; VAR nafile : namf;
             VAR x : s_integer; VAR n : s_integer);
   VAR q: integer;
       c: byte;
       s: string[4];
   begin
      seek(ndfile, x);
      if eof(ndfile) then begin
         surname := 'Zzzzzzzz'; na[n].sname := 'Zzzz';
      end else begin
         x := x+1;
         c := ndfile^.regl;
         if na[n].nam[1] <> 's' then begin    {already multiple index}
{write('bong ',na[n].nam);}
            if c <> na[n].lreg then begin     {change of register}
               s := concat('s', chr(c)); q := 1;
               request_xregister(dbfile, nafile, ndfile, s, q);
               na[n].lreg := c;
            end;
         end;
         seek(dbfile, ndfile^.r_no);
         get_xnames(dbfile, nafile);
         na[n].sname := ndfile^.sname;
         na[n].street := ndfile^.street;
         na[n].r_no := ndfile^.r_no;
     end;
   end;

PROCEDURE get_next(n : s_integer);
   VAR i,j,k: s_integer;
   begin
      CASE n of
       1: gxn(ndfile, dbfile, nafile, x1, n);
       2: gxn(ndfil2, dbfil2, nafil2, x2, n);
       3: gxn(ndfil3, dbfil3, nafil3, x3, n);
       4: gxn(ndfil4, dbfil4, nafil4, x4, n);
       5: gxn(ndfil5, dbfil5, nafil5, x5, n);
       6: gxn(ndfil6, dbfil6, nafil6, x6, n);
      END;
   END;

FUNCTION lowest: byte;
   var i,n : byte;
   begin
      n := 1;
      for i := 2 to number do begin
         if na[i].s < na[n].s then n := i
      end;
      lowest := n;
   end;

BEGIN
   set_party;
   ready_keyboard;

   x1 := 28; x2 := 28; x3 := 28; x4 := 28; x5 := 28; x6 := 28;   

   write('Reg 1?'); readln(r1);
   write('Reg 2?'); readln(r2);
   write('Reg 3?'); readln(r3);
   write('Reg 4?'); readln(r4);
   write('Reg 5?'); readln(r5);
   write('reg 6?'); readln(r6);

   na[1].nam := r1; na[2].nam := r2; na[3].nam := r3; na[4].nam := r4;
   na[5].nam := r5; na[6].nam := r6;

   request_xregister(dbfile, nafile, ndfile, r1, na[1].max);
   request_xregister(dbfil2, nafil2, ndfil2, r2, na[2].max);
   if r3 <> '' then request_xregister(dbfil3, nafil3, ndfil3, r3, na[3].max);
   if r4 <> '' then request_xregister(dbfil4, nafil4, ndfil4, r4, na[4].max);
   if r5 <> '' then request_xregister(dbfil5, nafil5, ndfil5, r5, na[5].max);
   if r6 <> '' then request_xregister(dbfil6, nafil6, ndfil6, r6, na[6].max);

   number := 6;
   if r6 = '' then number := 5;
   if r5 = '' then number := 4;
   if r4 = '' then number := 3;
   if r3 = '' then number := 2;

   for i := 1 to number do na[i].reg := ord(na[i].nam[2]);
   for i := 1 to number do na[i].lreg := na[i].reg;

   assign(ndfilx, 'xx.ind'); update(ndfilx);
   xx := 28;

   for i := 0 to 26 do indx[i] := 0;
   q := 0;
   for i := 1 to number do q := q+na[i].max;
   writeln('Total voters =', q);

   for i := 1 to number do begin
      get_next(i);
      na[i].s := surname;
     cursor(11+i, 0); writeln(i, ' ', na[i].s);
   end;
   repeat
      i := lowest;
      seek(ndfilx, xx);
      ndfilx^.sname := na[i].sname;
      ndfilx^.street:= na[i].street;
      ndfilx^.r_no := na[i].r_no;
      ndfilx^.regl := na[i].lreg;
      cursor(10,0); write(i, chr(na[i].lreg),' ', na[i].sname);
      put(ndfilx); xx := xx+1;
      q := ord(na[i].sname[1])-ord('A');
      indx[q] := indx[q]+1;
      get_next(i);
      na[i].s := surname;
   until (test_input) or (surname = 'Zzzzzzzz');

   indx[26] := xx; q := 1;
   for i := 0 to 26 do begin
      seek(ndfilx, i+1);
      ndfilx^.r_no := q;
      q := q+indx[i]; writeln(i, indx[i], q);
      put(ndfilx);
   end;
   close(ndfilx, true);

END.