program LPSORT(input,output);

   { Program to construct an index file from a file in Database format}

   {Brian Gilmore August 1987}

const  n_max = 6500;
   
TYPE
   nf = RECORD
      sname: string [8];
   end;
   nfa = ARRAY[0..n_max] of nf;
   nfp = ^nfa;

   iaf = ARRAY[0..n_max] of 0..30000;

   {$I lptype}
 
VAR
   na: nfp;
   ia: iaf;
   xa, xb: xaf;
   ofn, rfn, xfn, nfn: string[14];
   s: string[40];  
   i,flag: integer;
   max: integer;
   count: s_integer;
   key: char;

FUNCTION memavail: integer; EXTERNAL;

procedure ClrScr; External;
procedure GoToXY(i, j : byte); External;

procedure clearscreen;
   begin
      ClrScr;
   end;

procedure cursor(y,x : integer);
   begin
      GoToXY(x, y);
   end;

PROCEDURE getstx(VAR s:sts; VAR x: s_integer);
   VAR i, j: byte;
   BEGIN
      seek(nafile, x); x := x+1;
      s := '';
      j := ord(nafile^);
      if j > 40 then j := 40;      {max length of sts !!!}
      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 x, y: s_integer;
       vote: byte;
   BEGIN
           {get surname & firstname from the NAME file}

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

PROCEDURE read_file(max: integer);
   LABEL 1;
   VAR i, j, n: s_integer;
       s, prev: string[40];
       c: char;
   BEGIN
      prev := '';
      FOR i := 1 to max-1 do begin
         seek(dbfile, i);
         if eof(dbfile) then goto 1;
         get_xnames;
         j := length(surname); if j > 8 then j := 8;
         s := copy(surname, 1, j);
         if (s[1] = ' ') or (length(surname)=40) or (length(surname)<2)
         then begin
            writeln('Name? [',surname,']', i);
            j := length(surname); if j > 9 then j := 9;
            s := copy(surname, 2, j);
         end;
         na^[i].sname := s;
         c := s[1];
         if (c < 'A') or (c > 'Z') then begin
            writeln('Letter? [',surname,']', i);
         end;
         n := ord(c)-ord('A');
         xa[n] := xa[n]+1;
      END;
1:    max := i;
   END;
         
PROCEDURE print_tot(q: integer);
   VAR i, j, n: s_integer;
   BEGIN
      for i := 0 to 25 do begin
         cursor(i+1, q); write(i:3, xa[i]:5);
      end;
   END;

PROCEDURE construct_index(max : integer);
   VAR i,j,n,x,y: s_integer;
       c, key: char;
       q: boolean;
       s: string[15];
   BEGIN
      read_file(max);
      clearscreen;
      print_tot(40);

      For i := 25 downto 1 do xa[i] := xa[i-1];
      xa[0] := 1; 
      For i := 1 to 25 do begin
         xa[i] := xa[i]+xa[i-1];      {xa is now index}
         xb[i] := xa[i];              {xb will be next empty slot}
      end;
      xb[0] := 1;
      print_tot(60);
      for i := 1 to max-1 do begin
         s := na^[i].sname; 
         c := s[1];
         n := ord(c)-ord('A');
         ia[xb[n]] := i; xb[n] := xb[n]+1;
      end;

      j := max-1;
      REPEAT
         j := j-1;
         count := 0;
         FOR i := 1 to j do begin
            x := ia[i]; y := ia[i+1]; q := false;
            if na^[x].sname > na^[y].sname then q := true else begin
            end;
            if q then begin
               ia[i+1] := x; ia[i] := y;
               count := count+1;
            end;
         end;
         cursor(25,10); write(j:5,count:5,'   ');
         {read(nat, key);}  key := chr(0);
     UNTIL (j=2) or (count=0) or (key<>chr(0));

     xa[26] := max;
     if key <> chr(3) then begin
        for i := 0 to 26 do begin
           seek(ndfile, i+1);
           ndfile^.r_no := xa[i];
           put(ndfile);
        end; 
        for i := 1 to max-1 do begin
           n := ia[i];
           seek(ndfile, i+27);  seek(dbfile, n);
           for j := 1 to 4 do ndfile^.sname[j] := ' ';
           j := length(na^[n].sname); if j > 4 then j := 4;
           ndfile^.sname := copy(na^[n].sname, 1, j);
           ndfile^.street := dbfile^.street;
           ndfile^.r_no := n;
           put(ndfile);
        end;
     end;
   END;

BEGIN
   writeln; writeln;

   write(memavail);
   new(na);
   writeln(memavail);

   getcomm(ofn);
   if ofn = '' then begin
      write('Register Name:'); readln(ofn);
   end;
   xfn := concat(ofn,'.IND');
   nfn := concat(ofn,'.NAM');
   ofn := concat(ofn,'.DAT');

   clearscreen;
   write('Construct Name Index');

   cursor(0,1);
   assign(dbfile, ofn); update(dbfile);
   assign(ndfile, xfn); update(ndfile);
   assign(nafile, nfn); update(nafile);
   flag := 0; 

   cursor(0,1); writeln('Database File:', ofn);

   seek(dbfile, 0);
   i := dbfile^.namind;    {total number of names}
   writeln; writeln('Number of names:', i);
   if i > n_max then begin
      cursor(10,0); writeln('SORRY, register too big !');
   end;

   construct_index(i);

END.