program LPPOLL(input,output);

   { Program to run a Reading system on polling day from a file in Database format}

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

   
TYPE
   pns = string[40];
   stf = record
       street: string[22];
       index: 0..255;
       knockup: 0..255;
       promises: 0..60000;
       collected: 0..60000;
       r_no: 0..60000;
   end;
   stfa = ARRAY[0..60] OF stf;
   stfpa = ^ stfa;
   stindf = ARRAY[0..250] OF 0..255;   {points from dbfile.street into stfa}
   hitf = ARRAY[0..40] OF 0..255;

   {$I lptype.pas}

VAR
   stx: stfpa;
   stind: stindf;
   hit: hitf;
   xfn : string[14];
   s, target: string[40];  
   tgt: string[4];
   i,flag, max, last_address, indx, max_add: integer;

{$i lpexti}
{$I lpprii}

PROCEDURE construct_index; EXTERNAL;
FUNCTION find_voter: integer;   EXTERNAL;    {both in LPSRX.REL}

PROCEDURE show_kn(i: s_integer);
   BEGIN
      write(scr_inv, stx^[i].knockup:3, scr_nor);
   end;

FUNCTION get_xoption(from, tx: s_integer): integer;
   VAR i, j, n: integer;
   BEGIN
      REPEAT
         clearline(24); clearline(22); n := -1;
         cursor(22,0); write('Option (',from:1,'-',tx:1,')?'); n := getint(22,14);
         if (n<from) or (n>tx) then begin
            cursor(23, 0);writeln('please retype'); n := -1;
         end;
     UNTIL n >= 0;
     get_xoption := n; 
   END;

FUNCTION get_street: integer;
   VAR i,j, n, h, q, x, y: s_integer;
   BEGIN
         n := 0;
         clearscreen;
         h := 0;
         cursor(0,0);
         for i := 1 to 2 do write('Street               Knockup  rem. prom. ');
         writeln;
         writeln(0:4, ' None of these streets');
         y := 21; x := 0;
         for i := 1 to max_add-1 do begin
            q := i;
            cursor(y+i-20, x); write(i:4, ' ', stx^[q].street); show_kn(q);
            write(stx^[q].promises-stx^[q].collected:5);
            if i = 20 then begin
               y := 0; x := 40;
            end;
         end;
         n := get_xoption(0, i);
         get_street := n;
   END;

PROCEDURE bar_graph;
   VAR i, n, j, a, x: s_integer;
       y: integer;
       q: real;
   BEGIN
      x:= 26; y := 0;
      cursor(0, 26); write('  50%   100%');
      cursor(0, 70); write('  50%   100%');
      for i := 1 to max_add do begin
         if stx^[i].promises = 0 then q := 0 else
            q := (stx^[i].collected*10)/stx^[i].promises;
         a := trunc(q);
         if i = max_row-1 then begin
            y := -(max_row-2); x := 70;
         end;
         cursor(y+i, x); 
         if a > 0 then for j := 1 to a do write('*');
         if a < 16 then for j := a to 16 do write(' ');
      end;
   END;

PROCEDURE status(z: byte);
   VAR i,j,k,n,x,y: integer;
       q: real;
       s: pns;
       c: char;
   BEGIN
      clearscreen; y := 0; x := 0;
      if z=0 then
         for i := 1 to 2 do write('Street           Knock-up Vtd  Prom %Vtd    ') else
                      writeln(out,'Street           Knock-up Vtd  Prom %Vtd');
      for i := 1 to max_add do begin
         if i = max_row-1 then begin
            y := -(max_row-2); x := 45;
         end;
         s := stx^[i].street; n:= stx^[i].promises;
         if n = 0 then q := 0 else q := (stx^[i].collected*100)/n;
         if z = 0 then begin
            cursor(y+i, x); 
            write(s); show_kn(i);
            write(stx^[i].collected:5, n:5, trunc(q):5,'%');
         end else 
            writeln(out,s,stx^[i].knockup:3,stx^[i].collected:5, n:5, trunc(q):5,'%');
     
      end;
      if z = 0 then begin
      REPEAT
         cursor(max_row,0); write('   *** Press [+] for bar graph, exit to continue ***');
         repeat  c := get until (ord(c)=22) or (ord(c)=27);
         if ord(c) <> 27 then 
            bar_graph;
      UNTIL ord(c) = 27;
      end else write(out, chr(12));
      clearscreen;
   END;

FUNCTION promise: boolean;
   BEGIN
     if dbfile^.attr * [13] <> [] then promise := true  else
                                       promise := false;
                   {WAS: lab this time or lab last time & not dead/moved}
                   {NOW: lpprint marks attrribute no 13 as card is issued}
   END;

PROCEDURE cancel_p(n: s_integer);
   VAR i, j, k: integer;
   BEGIN
      if n > 0 then begin
         seek(dbfile, n);
         display_entry(n);
         IF promise then begin
            if dbfile^.attr * [12] = [] then begin
               dbfile^.attr := dbfile^.attr + [12];
                                                {voted this time}
               put(dbfile);
               k := stind[dbfile^.street];
               stx^[k].collected := stx^[k].collected+1;
               stx^[max_add].collected := stx^[max_add].collected+1;
            end;
            cursor(18, 0); write(' *** Ok ***, Card Cancelled');
         end else begin
            cursor(18, 0); write(' *** No Promise card ***   ');
         end;
      end;
   END;

PROCEDURE reinstate(n: s_integer);
   VAR i, j, k: s_integer;
       q: boolean;
   BEGIN
      q := false;
      if n > 0 then begin
         seek(dbfile, n); display_entry(n);
         if promise then begin
            if dbfile^.attr * [12] <> [] then begin
               q := true;
               dbfile^.attr := dbfile^.attr - [12];
               k := stind[dbfile^.street];
               put(dbfile);
               stx^[k].collected := stx^[k].collected-1;
               stx^[max_add].collected := stx^[max_add].collected-1;
            end;
         end;
      end;
      cursor(18, 0);
      if q then write(' *** Ok ***, Card Reinstated     ') else
                write(' ??? no promise/not cancelled ???');
   END;

PROCEDURE nu_enter(can: boolean);
   VAR i, j, k, n: integer;
       c: char;
   BEGIN
      clearscreen;
      REPEAT
         clearline(22);
         cursor(22, 0); write('Enter voter number (or EXIT to finish)');
         n := getint(22, 39);
         if n >= 0 then begin
            if can then cancel_p(n) else reinstate(n);
         end;
         clearline(24);
      UNTIL n < 0;
      clearscreen;
   END;

PROCEDURE na_enter;
   VAR n: integer;
       c: char;
   BEGIN
      clearscreen;
      REPEAT
         n := find_voter;
         clearline(18); clearline(22); cursor(22,0);
         write('Press [+] to Cancel Card or EXIT to abandon');
         REPEAT
            read(nat, c);
         UNTIL (ord(c)=22) or (ord(c)=27);
         if ord(c) = 22 then cancel_p(n);
      UNTIL (n <= 0) or (ord(c)=27);
      clearscreen;
   END;
 
PROCEDURE Lists;
   VAR i, j, q, lastptr, from, tx: integer;
       n: s_integer;
       s: string[40];
   BEGIN
      REPEAT
         n := get_street;
         if n <> 0 then begin
            cursor(23, 40);
            write('Producing List for [',stx^[n].street,']');
            stx^[n].knockup := stx^[n].knockup+1;

            from := stx^[n].r_no; tx := stx^[n+1].r_no-1;
            i := from-1; q := 0;
            REPEAT
               i := i+1;
               seek(dbfile, i); Get_names;
               if promise then begin
                  if dbfile^.attr * [12] = [] then begin
                     if q = 0 then begin
                        writeln(out); writeln(out, stx^[n].street); writeln(out);
                     end;
                     q := q+1;
                     write(out, i:4, '  ', surname, firstname, housename);
                     if cvote = 0 then write(out, ' ?');
                     writeln(out);
                     lastptr := dbfile^.namind;               {remember pointer to sname}
                     seek(dbfile, i+1);
                     if (q > 27) and (lastptr <> dbfile^.namind) then begin
                        writeln(out, chr(12)); q := 0;
                     end;
                  end;
               end;
            UNTIL i=tx;
            if q <> 0 then writeln(out, chr(12));

            seek(rdfile, stx^[n].index); 
            rdfile^.spare := rdfile^.spare+1;
            put(rdfile);
         end;
      UNTIL n = 0;
      clearscreen;
   END;

PROCEDURE emergency_startup(typ: integer);
   VAR i, j, n, from, tx, prom, tprom, alr, talr, fst: s_integer;
       s, t: string[25];
       ss: string [34];
       stop: boolean;
   BEGIN
      i := 0; n := 1; s := ''; t := ''; from := 0; stop := false; fst := 0; tprom := 0;
      alr := 0; talr := 0; tx := 0;
      REPEAT
         stind[i] := n;           {reverse index from dbfile.street to stx}
         i := i+1;                {NB: Current vsn of lpconv starts with a null record}
         seek(rdfile, i);
         if eof(rdfile) then begin
            stop := true; s := 'END'; tx := 9999;
         end else begin
            ss := rdfile^.street; tx := rdfile^.r_no;
            if length(ss) < 22 then s:= '' else s := copy(ss, 1, 22);              
            if tx = 0 then s := '' else tx := tx-1;  {1st null trecord}
                                              {address is padded with ' '}
         end;
         if s <> t then begin      {really a new street}
            from := from+1;
            cursor(15,5); writeln('Processing [',t,'] ',from,tx,i,n,'     ');
            if tx > from then begin
               prom := 0; alr := 0;
               j := from-1;
               REPEAT
                  j := j+1;
                  seek(dbfile, j);              {get voter record}
                  fst := dbfile^.street+1;
                  if eof(rdfile) then j := tx else begin
                     if promise then prom := prom+1;  {is a Labour promise}
                     if dbfile^.attr * [12] <> [] then begin
                        if typ = 0 then begin
                           dbfile^.attr := dbfile^.attr - [12]; put(dbfile);
                        end else alr := alr+1;
                     end;
                  end;
               UNTIL j = tx;
               stx^[n].street := t; stx^[n].promises := prom; 
               stx^[n].collected:=alr;
               stx^[n].index := fst; stx^[n].knockup := 0; stx^[n].r_no := from;
               if typ = 0 then begin
                  rdfile^.spare := 0;       {temp marker for knockup, held in file}
                  put(rdfile);
               end else stx^[n].knockup := rdfile^.spare;
               n := n+1; from := tx; 
               tprom := tprom+prom; talr := talr+alr;
            end;
            t := s;
         end;
      until stop;
      max_add := n;
      stx^[n].street := 'Total                 '; stx^[n].promises := tprom;
      stx^[n].knockup := 0; stx^[n].collected := talr; 
   END;

PROCEDURE first_startup;
   BEGIN
      emergency_startup(0);
   END;

PROCEDURE Startup;
   VAR i: integer;
   BEGIN
      title := 'Startup Menu';
      mess[1].s := 'First Startup of Polling Day ';
      mess[2].s := 'Startup during the day       ';
      i := get_option(1, 2, 0);
      if i = 1 then first_startup else emergency_startup(1);
   END;

PROCEDURE Main_menu;
  VAR i,j : integer;
  BEGIN
    REPEAT
       title := 'Main Menu';
       mess[0].s := 'Exit Program                      ';
       mess[1].s := 'Show status of Promise collection ';
       mess[2].s := 'Print status of Promise Collection';
       mess[3].s := 'Enter Promise Cards by NUMBER     ';
       mess[4].s := 'Enter Promise Cards by NAME       ';
       mess[5].s := 'Print Knock-up Lists              ';
       mess[6].s := 'Reinstate Promise Card            ';

       i := get_option(0, 6, 0);

       CASE i of
         0: ;
         1: status(0);
         2: status(1);
         3: nu_enter(true);
         4: na_enter;
         5: lists;
         6: nu_enter(false);
       END;
    UNTIL i = 0;
  END;


PROCEDURE initialise;
   BEGIN
      set_party;
      Request_Register;
      i := 0;
   END;


BEGIN

   new(stx);
   initialise;
   xfn := concat(disc,reg,'.IND');      {for LPSRX}

   Ready_Keyboard;

   File_or_Printer;

   assign(ndfile, xfn); update(ndfile);   {for LPSRX}

   construct_index;                       {for LPSRX}
   startup;
   main_menu;

   reset_viewport;
   close_Printer;
   back_to_menu;
END.