program LPPRINT(input,output);

   { Program to print out Information from a file in Database format}

   {Brian Gilmore September 1987}

   
TYPE
   pns = string[40];

   {$I lptype} 

VAR
   target, count: integer;
   output_type, x_now, x_party: integer;
   Range_Control: byte;
   setup_done : boolean;

{$i lpexti}
{$i lpprii}

FUNCTION memavail: integer; EXTERNAL;

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

PROCEDURE get_street(VAR from, tx: integer);
                                         {NB: Not the same as in lppoll - it holds an}
                                         {    in-store array, and displays knock-up}
   VAR j, h, q, last_from: s_integer;
       n : integer;
       x, y, i, ind : byte;
       eoff: boolean;
   BEGIN
      n := 0; ind := 0;
      REPEAT
         clear_from_line(1);
         h := 0;
         cursor(1,0);
         for i := 1 to 2 do write('      Street               No of Voters ');
         writeln;
         writeln(0:4, ' Return to Main Menu');
         y := 21; x := 0; i := 1; eoff := false;
         seek(rdfile, ind+i); last_from := rdfile^.r_no;
         REPEAT
            seek(rdfile, ind+i+1); tx := rdfile^.r_no;
            if eof(rdfile) then begin eoff := true; tx := max_val end;
            cursor(y+i-19, x); write(i:4, ' ', rdfile^.street, 
                                        scr_inv,tx-last_from:4,scr_nor);

            if i = 20 then begin
               y := 0; x := 40;
            end;
            last_from := tx;
            i := i+1;
         UNTIL (eoff) or (i=42);
         if NOT eoff then begin
            cursor(23, 80-28); write(scr_inv, 'Press RETURN for next screen', scr_nor);
         end;
         n := get_xoption(0, i);
         if (n=-1) and (final=13) then begin n := -5; ind := ind+41 end;
      until n <> -5;
      if n <> 0 then n := n+ind;
      if n = 0 then tx := -1 else begin
         seek(rdfile, n+1); tx := rdfile^.r_no-1;
         if eof(rdfile) then tx := max_val;
         seek(rdfile, n);   from := rdfile^.r_no;
      end;
   END;

FUNCTION get_attribute_number: integer;
   VAR i,j, n: integer;
   BEGIN
      show_attributes;
         n := get_option(ord('a'), ord('a')+max_attr, 1);
         if (n=-1) and (final=13) then n := 0;
      get_attribute_number := n;
      clear_from_line(3);
   END;

PROCEDURE Print_Party_options;
  VAR i,j: integer;
  BEGIN
    cursor(0,67);
    if x_now = 0 then write('Using Current Vote') else write('Using previous Vote');
    FOR i := 0 to 8 do begin
       cursor(13+i,60); write(i:3,'   ',party[i]);
    END;
  END;

PROCEDURE Get_Party;
  VAR i,j,n: integer;
  BEGIN
     REPEAT
        print_party_options;
        i := get_option(0, max_party, 1);
     UNTIL i<9;         {return gives -1 -> take no action}
     x_party := i;
     clearline(23);
  END;

PROCEDURE prt_entry(n: s_integer; typ: byte);
  VAR i, j: s_integer;
      c: char;
      s, t, u: pns;
  BEGIN
     s := firstname;
     i := length(s);
     u := housename;
     t := surname; j := length(t);
     Get_Postcode(n);
     if output_type = 1 then begin
        while (i+j) < 25 do begin t := concat(t, ' '); i := i+1; end;
        write(out, s, ' ', t, ' ', u);
        writeln(out, ' ', rdfile^.street, postcode);
     end else begin
        if output_type = 4 then begin
           {locoscript mail/merge format}
           writeln(out, s); writeln(out, t); writeln(out, u);
           writeln(out, rdfile^.street);
           writeln(out, postcode);
           write(out, chr(12));
        end else begin
           writeln(out, '              ',reg,n:5);
           if typ <> 0 then 
              writeln(out, s,' ',t) else
              writeln(out, 'The ',t, ' Family');
           writeln(out, u,' ',rdfile^.street);
           if output_type = 2 then begin   {full label}
              writeln(out, 'Edinburgh'); writeln(out, postcode);
           end else begin
              writeln(out); writeln(out);
           end;
           writeln(out); writeln(out); writeln(out); writeln(out);
        end;
     end;
  END;

PROCEDURE set_up_labels;
  VAR i, j: integer;
      key: char;
  BEGIN
     if NOT setup_done then begin
        setup_done := true;
        for i := 1 to 6 do 
           writeln(out, 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx');
        writeln(out); writeln(out);
        cursor(23, 0); writeln('Please check allignment of the labels then press any key');
        key := get;
     end;
  END;

PROCEDURE list_or_label;
  VAR i, j, n: integer;
  BEGIN
    title := 'Type of Output';
    mess[1].s :=' Output as a list            ';
    mess[2].s := 'Full Labels output          ';
    mess[3].s := 'Short Labels (no postcode)  ';
    mess[4].s := 'Locoscript mail merge format';
    output_type := get_option(1, 4, 0);
    if (output_type = 2) or (output_type = 3) then set_up_labels;
    
  END;

PROCEDURE Ask_for_limits(VAR from, tx: integer);
   BEGIN
        cursor(0,60); write('Press EXIT to abandon');
        tx := -1;
        clearline(23);
        If Range_Control = 2 then begin   {by voter}
           cursor(23,0); write('Give Start Voter Number (EXIT to abandon)?'); 
           from := getint(23,43);
           if from > 0 then begin
              clearline(23);
              cursor(23,0); write('Give Final voter number (RETURN for all register)?');
              tx := getint(23, 53);
              if tx <= 0 then begin
                 if final=13 then tx := max_val else from := -1;
              end;
           end;
        end else begin                    {by street name}
           Get_Street(from, tx);
           if tx < 0 then from := -1;
        end;
        clear_from_line(1);
        cursor(1, 0); write('Selecting From:', from:4, '  To:', tx:4);
   END;

PROCEDURE list_on_attribute(entry: s_integer);
  VAR i,j,n, q, from, tx : integer;
      c: char;
  BEGIN
     clear_from_line(1);
     if entry <> 0  then begin
        q := get_attribute_number;
        cursor(0, 0); write('Use Attribute:[', attrn[q],']');
        if output_type = 1 then begin
           writeln(out, 'Register ', reg, '             Listing for [', attrn[q],']');
           writeln(out);
        end;
     end else q := 1;   {q is set to a dummy for the test below}

     REPEAT
        ask_for_limits(from, tx);
        if from > 0 then begin
           n := from;
           Disp_Form;
           REPEAT
              seek(dbfile, n);
              if eof(dbfile) then n := tx else begin
                 if (dbfile^.attr * [q] <> []) or (entry=0) then begin
                    disp_Voter(n);
                    prt_entry(n, 1);
                 end;
              end;
              n := n+1;
           until (n >= tx) or (Test_Input);
        end;
        clear_from_line(1); 
     UNTIL from <= 0;
  END;

PROCEDURE Use_Specific_vote(q: integer);
  VAR i,j,n, prev, from, tx: integer;
  BEGIN
                                                 {q = 0 - Current party}
                                                 {  < 0 - Previous party}
                                                 {  > 0 - Promise cards (now&previous}
     x_now := q;
     cursor(0,0); writeln('Use Specific Party:');
     clear_from_line(1);
     get_party; n := 0;
     cursor(0, 19); write('Party:', party[x_party]);

     REPEAT
        ask_for_limits(from, tx);
        if from >= 0 then begin
           n := from;
           Disp_Form;
           REPEAT
              count := n;
              seek(dbfile, n);
              if eof(dbfile) then n := tx else begin
                 cvote := dbfile^.xvote MOD 16; pvote := dbfile^.xvote DIV 16;
                 if ((q = 0) and (cvote = x_party)) or 
                    ((q < 0) and (pvote = x_party)) or
                    ((q > 0) and ((cvote = 1) or
                                   (cvote+pvote=1))) then begin 
                    if dbfile^.attr * [1] = [] then begin   {NOT moved/dead}
                       disp_Voter(n);
                       prt_entry(n, 1);
                       if q > 0 then begin    {mark issue of promise card}
                          dbfile^.attr := dbfile^.attr + [13];
                          put(dbfile);
                       end;
                    end;
                 end;
              end;
              n := n+1;
           UNTIL (n >= tx) or (Test_Input);
        end;
        clear_from_line(1);
     UNTIL from <= 0;
   END;

PROCEDURE households;
  VAR i, x, q, ad, hit, prt, from, tx: integer;
      s: string [40];
  BEGIN
      title := 'Label per house, ';
      s := ''; hit := 1; prt := 0;
     mess[1].s := 'All Households                  ';
     mess[2].s := 'Households with 2 or more adults';
     mess[3].s := 'Households with 3 or more adults';
      ad := get_option(1, 3, 0);
      cursor(0, 17); write(scr_inv, 'for',ad:2,' Adults', scr_nor);
      REPEAT
         ask_for_limits(from, tx);
         if from>0 then begin
         i := from-1; x := 1;
         Disp_Form;
         REPEAT
            i := i+1;
            seek(dbfile, i);
            if NOT eof(dbfile) then begin
               get_names;
               if s = surname then hit := hit+1 else begin
                  s := surname; hit := 1; prt := 0;
               end;
               if (hit >= ad) and (prt=0) then begin
                  if ad=1 then begin
                     q := dbfile^.namind;        {test for same surname(ptr are =)}
                     seek(dbfile, i+1);
                                        {get next to see if 'family' or 'single'}
                     if q = dbfile^.namind then x := 0 else x := 1;
                     seek(dbfile, i);
                                        {must go back to original for 'single'}
                  end;
                  disp_Voter(i); prt_entry(i, x); prt := 1;
               end;
            end else i := tx;
         UNTIL (i >= tx) OR eof(dbfile) OR (Test_Input);
         end;
      UNTIL from <= 0;
      clearscreen;
  END;

PROCEDURE street_list;
  VAR i,j,x: s_integer;
      s: string[40];
  BEGIN
     i := 0; x := 0; s := '';
     writeln(out, 'Street List and First Elector Number for Register ',reg);
     REPEAT
        i := i+1;
        seek(rdfile, i);
        s := rdfile^.street;
        writeln(out, s, reg,rdfile^.r_no:5);
     UNTIL eof(rdfile);
  END;

PROCEDURE Street_or_number;
   VAR i: s_integer;
   BEGIN
      mess[1].s := 'Print Lists by Street Name    ';
      mess[2].s := 'Print Lists by Register Number';
      i := get_option(1, 2, 0);
      Range_Control := i;
   END;

PROCEDURE Prt_Canvas;
  VAR i,j : integer;
  BEGIN
    REPEAT
       mess[0].s := 'Exit Program                       ';
       mess[1].s := 'Print list of streets              ';
       mess[2].s := 'Print Labels for a Specific Party  ';
       mess[3].s := 'Print Labels using PREVIOUS Canvass';
       mess[4].s := 'Print Labels for a given Attribute ';
       mess[5].s := 'Print Labels for ALL electors      ';
       mess[6].s := 'Print Labels for Households        ';
       mess[7].s := 'Print Labels for Promise Cards     ';
       mess[8].s := 'Select NEW Register                ';

       i := get_option(0, 8, 0);
       if (i > 1) and (i<8) then begin
          list_or_label; Street_or_number;
       end;
       CASE i of
         0: ;
         1: street_list;
         2: Use_specific_vote(0);
         3: Use_Specific_vote(-1);
         4: List_on_attribute(1);
         5: List_on_attribute(0);
         6: Households;
         7: Use_specific_vote(1);
         8: begin Close_Register; Request_register; 
                         writeln(out); writeln(out); writeln(out);
            end;
       END;
    UNTIL i = 0;
  END;

BEGIN

   setup_done := false;

   Ready_Keyboard;
   set_party;

   Request_register;
   writeln('Space left:', memavail);
   file_or_printer;

   prt_canvas;

   close_Printer;
   back_to_menu;
END.