program LPVOT(input,output);

   { Program to examine and modify a file in Database format}

   {Brian Gilmore May 1987}

   
LABEL 9999;

TYPE
   {$I lptype.ins}
   adulta = ARRAY[1..10] OF integer;
   fsa = ARRAY[1..4] OF integer;
   fparty = ARRAY[0..8] OF string[3];
   fattrn = ARRAY[0..15] OF string[15];
   fsname = PACKED ARRAY[1..19] OF char;
   ffname = PACKED ARRAY[1..25] OF char;
   fhname = PACKED ARRAY[1..5] OF char;
   fstne  = PACKED ARRAY[1..34] OF char;
   fpcode = PACKED ARRAY[1..8] OF char;
   s_integer = 0..60000;
   byte = 0..255;
   xattr = (sa, sb, sc, sd, se, sf, sg, sh, si, sj, sk, sl, sm, sn, so, sp);
   sattr = SET OF xattr;

   vf = RECORD
     sname: fsname;
     fname: ffname;
     hname: fhname;
     street: s_integer;
     r_no:   s_integer;
     cvote: byte;
     pvote: byte;
     attr: sattr;
     spare1, spare2: byte;
  END;

  vfp = ^vf;
  ntfile = FILE of vf;    

  rf = RECORD
    street: fstne;
    postcode: fpcode;
  END;

  rfp = ^rf;
  rffile = FILE of rf;
 
 
VAR
   vv: vfp;
   dbfile: ntfile;
   rv: rfp;
   rdfile: rffile;
   party, sparty: fparty;
   attrn: fattrn;
   source,nat,temp, outfile: text;  {source file}
   reg, filename, ofn, rfn, name: string[14];
   line,rname, snr, r2name, sname, padd, add, this_add, code, initial, 
     last_line, house: string[120];
   target, count, p1, p2, lno,vkey,row,col,spt,i,flag,dstart,rlen,lflag: integer;
   x_party, p3, labels, addno, final, last_address: integer;
   adult: adulta;
   field_size, field_max: fsa;
   key: char;

PROCEDURE cursor(y,x: integer);
   BEGIN
      write(chr(1bh), 'Y', chr(y+20h), chr(x+20h));
   END;

PROCEDURE clearscreen;
   BEGIN
      write(chr(1bH)); write('E'); cursor(0, 1);
   END;

PROCEDURE Clear_from_Line(n: integer);
   BEGIN
      cursor(n, 0); write(chr(1bh), 'J');
   END;

PROCEDURE Clearline(n: integer);
   BEGIN
      cursor(n,0); write(chr(1bH),'K');
   END;

PROCEDURE set_viewport(n: integer);
   BEGIN
      write(chr(1bH),'X',chr(n+33),chr(32),chr(28+32),chr(90-1+32));
       {set 1,0,29,90 - protects top row}
   END;

PROCEDURE reset_viewport;
   BEGIN
      write(chr(1bH),'X  ',chr(30+32),chr(90+32));
   END;

FUNCTION get: char;
   VAR Key: char;
   BEGIN
      REPEAT
         if eoln(nat) then begin
            key := chr(13); readln(nat); {clear eol flag}
         END ELSE read(nat, key);
      UNTIL ord(key) > 0;
      if ord(key) = 3 then goto 9999;
      write(key);
      get := key;
   END;

FUNCTION readint: integer;
   VAR i, j, n, q: integer;
   BEGIN
      n := 0; final := -1; q := 0;
      REPEAT
         i := ord(get); j := i-ord('0');
         if (j>=0) and (j<=9) then begin
            n := n*10+j; q := 1;
         end else final := i;
      UNTIL final > 0;
      if q = 0 then n := -1;
      readint := n;
   END;

FUNCTION getchar: integer;
   VAR i: integer;
   BEGIN
      i := ord(get);
      getchar := i;
   END;   

FUNCTION getint(x, y:integer): integer;
   VAR i,j,n,fl: integer;
   BEGIN
      fl := 0;
      REPEAT
         n := readint;
         if (final<>32) and (final<>ord('-')) and (final<>13) then begin
            cursor(x+1,0); write('Not a number, please retype');
            cursor(x, y); write('                '); cursor(x, y);
         end else fl := 1;
      UNTIL fl <> 0;
      getint := n;
   END;
PROCEDURE get_address(n: integer);
   BEGIN
      if last_address <> n then seek(rdfile, n);
      last_address := n;
   END;

PROCEDURE print_attributes(q: integer);
   VAR i, j, k: integer;
   BEGIN
     if dbfile^.attr = [] then begin
        cursor(q,15); write('[None]');
     end else begin
        j := 1; cursor(q, 10);
        for i := 1 to 10 do begin
           k := 0;
           CASE i OF
              1: if dbfile^.attr * [sa] <> [] then k := 1;
              2: if dbfile^.attr * [sb] <> [] then k := 2;
              3: if dbfile^.attr * [sc] <> [] then k := 3;
              4: if dbfile^.attr * [sd] <> [] then k := 4;
              5: if dbfile^.attr * [se] <> [] then k := 5;
              6: if dbfile^.attr * [sf] <> [] then k := 6;
              7: if dbfile^.attr * [sg] <> [] then k := 7;
              8: if dbfile^.attr * [sh] <> [] then k := 8;
              9: if dbfile^.attr * [si] <> [] then k := 9;
             10: if dbfile^.attr * [sj] <> [] then k := 10;
          END {case};
           if k <> 0 then begin
              write(attrn[i]);
              j := j+1;
              if j = 4 then begin
                 q := q+1; cursor(q,10); j := 1;
              end;
           end;
        end;
     end;
   END;

PROCEDURE display_entry;
   VAR
     pos: integer;
   BEGIN
     pos := 3;
     cursor(pos, 1);   writeln('Register no. ',dbfile^.r_no);
     cursor(pos+1, 1); writeln('Surname             ',dbfile^.sname);
     cursor(pos+2, 1); writeln('First name          ',dbfile^.fname);
     cursor(pos+3, 1); writeln('House no.           ',dbfile^.hname);
     get_address(dbfile^.street);
     cursor(pos+4, 1); writeln('Street:             ',
        rdfile^.street,', ',rdfile^.postcode);
     cursor(pos+6,1);  writeln('Voting intention    ',party[dbfile^.cvote]);
     cursor(pos+7,1);  writeln('Previous            ',party[dbfile^.pvote]);
     cursor(pos+9,1);  writeln('Further Information:');
     print_attributes(pos+10);
  END;

PROCEDURE Print_Party_options;
  VAR i,j: integer;
  BEGIN
    FOR i := 0 to 8 do begin
       cursor(13+i,70); write(i:3,'   ',party[i]);
    END;
  END;

PROCEDURE set_party;
  VAR i: integer;
  BEGIN
    party[0] := '???'; sparty[0] := '?';
    party[1] := 'Lab'; sparty[1] := 'L';
    party[2] := 'Con'; sparty[2] := 'C';
    party[3] := 'All'; sparty[3] := 'A';
    party[4] := 'SNP'; sparty[4] := 'S';
    party[5] := 'Gre'; sparty[5] := 'G';
    party[6] := 'Oth'; sparty[6] := 'O';
    party[7] := 'Pos'; sparty[7] := 'P';
    party[8] := 'Dou'; sparty[8] := 'D';

    attrn[1] := 'Moved/Dead     '; attrn[2] := 'Postal Vote    ';
    attrn[3] := 'New Voter      '; attrn[4] := 'Window Poster  ';
    attrn[5] := 'Member         '; attrn[6] := 'Car Wanted     ';
    attrn[7] := 'Council Tenant '; attrn[8] := 'Student        ';
    attrn[9] := 'Pensioner      '; attrn[10]:= 'In Master File ';
 END;


PROCEDURE Get_Party;
  VAR i,j,n: integer;
  BEGIN
     REPEAT
        print_party_options;
        clearline(22);
        cursor(22,0); write('Which Party (1-8)?'); {i := getchar-ord('0');}
        i := getint(22,18);
        if (i < 0) or (i > 8) then begin
           cursor(24,0); writeln('Party between 0 and 8 only !');
        end;
     UNTIL (i>=0) and (i<9);
     x_party := i;
     cursor(0,40); write('Party: ', party[i]);
     clearline(23);
  END;

PROCEDURE Set_General;
  VAR i,j,n, prev: integer;
  BEGIN
     n := 0;
     REPEAT
        cursor(0,0); writeln('Add Canvas Returns');
        prev := n;
        cursor(22,0); write('Give Voter Number (0 to finish)?'); n := getint(22,32);
        clear_from_line(1);
        if (n = -1) and (final=13) then n := prev+1; 
        if n > 0 then begin
           count := n;
           seek(dbfile,n);
           display_entry;
           get_party;
           dbfile^.cvote := x_party;
           display_entry;
           put(dbfile);
        END;
     UNTIL n = 0;
     clearscreen;
  END;

PROCEDURE Set_Specific_Vote;
  VAR i,j,n, prev: integer;
  BEGIN
     cursor(0,0); writeln('Set Specific Party');
     clear_from_line(1);
     get_party; n := 0;

     REPEAT
        clearline(22); prev := n;
        cursor(22,0); write('Give Voter Number (0 to finish)?'); n := getint(22,32);
        if final = ord('-') then write(' all to - ');
        if (n=-1) and (final=13) then n := prev+1;
        if n > 0 then begin
           count := n;
           seek(dbfile, n);
           dbfile^.cvote := x_party;
           display_entry;
           put(dbfile);
        end;
     UNTIL n = 0;
     clearscreen;
   END;

PROCEDURE Add_Canvas;
  VAR i,j : integer;
  BEGIN
    clearscreen;
    REPEAT
       clearline(22);
       cursor(3,0); writeln(' 0 - Return to Main Menu');
       cursor(5,0); writeln(' 1 - Set Voter intention');
       cursor(7,0); writeln(' 2 - Set a series of one party only');

       cursor(22,0); write('Option (0-2)?'); {i := getchar-ord('0');}
       i := getint(22,13);
       if (i < 0) or (i > 2) then begin
          cursor(24,0); writeln('Option between 0 and 2 !');
       end else begin
          if i = 1 then begin
             set_General;
          end else begin
             if i = 2 then begin
                Set_specific_vote;
             end;
          end;
       end;
    UNTIL i = 0;
    set_viewport(1); clearscreen;
  END;

PROCEDURE Disp_Voter;
  VAR i, prev: integer;
  BEGIN
    clearscreen; i := 0;
    repeat
       clearline(22); prev := i;
       cursor(22,0); write('Voter number (0 to finish):');
       i := getint(22, 32);
       if (i=-1) and (final=13) then i:=prev+1;
       count := i;
       seek(dbfile, i);
       display_entry;
    until i = 0;
 END;

 PROCEDURE Main_menu;
   VAR i,j: integer;
   BEGIN
     set_viewport(1);
     REPEAT
        cursor(2,0); writeln('Main Menu');
        cursor(4,0); writeln('     0    -   Exit Program');
        cursor(6,0); writeln('     1    -   Display Voter details');
        cursor(8,0); writeln('     2    -   Add Canvas Returns');

        cursor(22,0); write('Action (0-2)?'); {j := getchar-ord('0');}
        j := getint(22, 13);
        clearline(24);

        if j = 1 then begin
           Disp_Voter;
           clearscreen;
        end else begin
           if j = 2 then begin
              Add_Canvas; clearscreen;
           end else begin
              if j <> 0 then begin
                 cursor(24,0); writeln('Input MUST be between 0 and 2');
              end;
           end;
        end;
      UNTIL j = 0;
   END;

BEGIN
   set_party;
   writeln; writeln;
   write('Register Name?'); readln(ofn);
   rfn := concat('B:',ofn,'.STR');
   ofn := concat('B:',ofn,'.DAT');
   clearscreen;

   cursor(0,1); lno := 1; row := 1; col := 1; vkey:=0; dstart:=0;
   assign(nat, 'KBD:'); reset(nat);  {get at keyboard directly}
   assign(dbfile, ofn); update(dbfile);
   assign(rdfile, rfn); update(rdfile); 
   flag := 0; count := 1; labels := 0;

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

   main_menu;

   reset_viewport; clearscreen;
9999:
END.