{ File = MROOT1.INC -- Include file for Reliance Mailing List
    Copyright (c) 1986 William Meacham, All Rights Reserved
    Revised: 3/7/86 }

{ ------------------------------------------------------------- }

procedure setbit (var dbyt : byte ; n : integer) ;
  { sets bit n of a byte to 1 }

begin
    dbyt := ((1 shl n) or dbyt)
end ;

{ ------------------------------------------------------------- }

procedure clrbit (var dbyt : byte ; n : integer ) ;
  { sets bit n of a byte to 0 }

begin
    dbyt := ((not(1 shl n)) and dbyt)
end ;

{ ------------------------------------------------------------- }

function tstbit (dbyt : byte ; n : integer) : boolean ;
  { test bit n of a byte -- True if 1, False if 0 }

begin
    tstbit := not(((1 shl n) and dbyt) = 0)
end ;

{ ------------------------------------------------------------- }

function center (st : str80 ; n : integer) : str80 ;
  { Returns a string of length n.  The input string is centered
    in a field of length n, framed by blanks. }

    var
        i   : integer ;
        out : str80 ;

    begin
        if n <= length(st) then
            out := st
        else
          begin
            out := '' ;
            for i := 1 to (n - length(st)) div 2 do
                out := concat (out, ' ') ;
            out := concat (out, st) ;
            for i := length(out)+1 to n do
                out := concat (out, ' ')
          end ;
        center := out
    end ; { function center }

{ ------------------------------------------------------------- }

procedure page (var f : text) ;
    const
        formfeed = ^L ;
    begin
        write (f,formfeed)
    end ;

{ ------------------------------------------------------------ }

procedure add_blanks (var st : str132 ; num_blanks : integer) ;
  { appends the number of blanks indicated to the string }
    var
        i : integer ;
    begin
        for i := 1 to num_blanks do
            st := concat (st,' ')
    end ;  { proc add_blanks }

{ ------------------------------------------------------------ }

PROCEDURE EDITNUM (RNUM : REAL ; MAXLEN, FRAC : INTEGER ;
                   VAR RSTR : num_str_typ) ;
  { Insert commas into string representation of real number -- 8/24/84 }
    VAR
        I    : INTEGER ;
        NEG  : BOOLEAN ;
    BEGIN
        NEG := FALSE ;
        IF RNUM < 0 THEN
            BEGIN
                NEG := TRUE ;
                RNUM := -RNUM
            END ;
        STR (RNUM:MAXLEN:FRAC,RSTR) ;
        RSTR := STRIPCH (RSTR, ' ') ;
        IF NOT (POS('.',RSTR) = 0) THEN     { If there is a dec pt ... }
                I := POS('.',RSTR)          { mark where it is }
        ELSE                                { If no dec pt ... }
                I := LENGTH(RSTR) + 1 ;     { mark where it would be }
        WHILE I > 4 DO
            BEGIN
                I := I-3 ;
                INSERT (',', RSTR, I)
            END ;
        IF NEG THEN
                INSERT ('-', RSTR, 1)
    END ; {--- EDITNUM ---}

{ ------------------------------------------------------------ }

procedure write_scr ;
  begin
    rewrite(scr_file) ;
    write(scr_file,scr) ;
    close(scr_file)
  end ; { proc write_scr }

{ ----------------------------------------------------------- }

procedure read_scr ;
  begin
    reset(scr_file) ;
    read(scr_file,scr) ;
    close(scr_file)
  end ; { proc read_scr }

{ ----------------------------------------------------------- }

procedure open_database ;
  { Open master file and index files }

  procedure bomb (filename : str14) ;
    begin
      show_msg (concat('CANNOT OPEN ',filename,'!')) ;
      halt
    end ; { proc bomb }

begin
    openfile (mf_file,mf_fname,sizeof(master)) ;
    if not OK then bomb (mf_fname) ;
    openindex (ix1_file,ix1_fname,sizeof(key1),dups_ok) ;
    if not OK then bomb (ix1_fname) ;
    openindex (ix2_file,ix2_fname,sizeof(key2),dups_ok) ;
    if not OK then bomb (ix2_fname)
end ; { proc open_database }

{ ----------------------------------------------------------- }

procedure close_database ;
  { Close master file and index files }
begin
    closefile (mf_file) ;
    closeindex (ix1_file) ; 
    closeindex (ix2_file)
end ; { proc close_database }

{ ----------------------------------------------------------- }

function build_key1 (name : str30) : key1_typ ;
  { Construct key for index file 1, last name }
var
    work_area : key1_typ ;
    i         : integer ;
begin
    work_area := purgech(name,' ') ;
    for i := 1 to length(work_area) do
        work_area[i] := upcase(work_area[i]) ;
    build_key1 := work_area
end ;  { function build_key1 }

{ ----------------------------------------------------------- }

function build_key2 (name : str30 ; zip : str9) : key2_typ ;
  { Construct key for index file 2, zip plus last name }
begin
    build_key2 := concat(purgech(zip,' '),build_key1(name))
end ;  { function build_key2 }

{ ----------------------------------------------------------- }

procedure get_prev_rec ;
  { We have already established a value for key1.
    This procedure returns the previous key and associated record. }
var
    entrykey1 : key1_typ ;
begin
    entrykey1 := key1 ;
    prevkey (ix1_file,rec_num,key1) ;
    if OK then                           { OK = found previous key }
        getrec (mf_file,rec_num,master)
    else                                 { not OK = at first key }
      begin                              { re-establish pointer to key1 }
        key1 := entrykey1 ;
        findkey (ix1_file,rec_num,key1)
      end
end ; { proc get_prev_rec }

{ ----------------------------------------------------------- }

procedure get_next_rec ;
  { We have already established a value for key1.
    This procedure returns the next key and associated record. }
var
    entrykey1 : key1_typ ;
begin
    entrykey1 := key1 ;
    nextkey (ix1_file,rec_num,key1) ;
    if OK then                           { OK = found next key }
        getrec (mf_file,rec_num,master)
    else                                 { not OK = at last key }
      begin                              { re-establish pointer to key1 }
        key1 := entrykey1 ;
        findkey (ix1_file,rec_num,key1)
      end
end ; { proc get_prev_rec }

{ ----------------------------------------------------------- }

procedure paint_screen (n:integer) ;
  { Paints a screen on the CRT -- N tells which screen to paint }
    begin
        case n of
          0:    { Main menu }
            begin
              clrscr ;
              write_str ('RELIANCE MAILING LIST MAIN MENU', 25,1) ;
              write_str (center(scr.ID,30), 26,2) ;
              write_str ('Please select:', 26,4) ;
              write_str ('1    Set-Up Menu', 26,6) ;
              write_str ('2    Add a name', 26,8) ;
              write_str ('3    Display or Change a name', 26,9) ;
              write_str ('4    Delete a name', 26,10) ;
              write_str ('5    Record contributions', 26,11) ;
              write_str ('6    Print list of names', 26,13) ;
              write_str ('7    Print labels', 26,14) ;
              write_str ('8    Create MailMerge file', 26,15) ;
              write_str ('9    Change data diskette', 26,17) ;
              write_str ('ESC  Exit the program', 26,19) ;
              write_str ('==>', 26,21)
            end ; { 0 }
          1:    { data entry screen }
            begin
              write_str ('First Name:',2,3) ;
              write_str ('Contributions',47,3) ;
              write_str ('Last Name:',3,4) ;
              write_str ('Last amount:',49,4) ;
              write_str ('Last date:',51,5) ;
              write_str ('Title:',7,6) ;
              write_str ('Total amount:',48,6) ;
              write_str ('Salutation:',2,7) ;
              write_str ('Selection categories',47,8) ;
              write_str ('Address:',5,9) ;
              write_str ('1 ',49,9) ;
              write     (scr.cat_name[1]) ;
              write_str ('2 ',49,10) ;
              write     (scr.cat_name[2]) ;
              write_str ('City:',8,11) ;
              write_str ('3 ',49,11) ;
              write     (scr.cat_name[3]) ;
              write_str ('State:     Zip Code:',7,12) ;
              write_str ('4 ',49,12) ;
              write     (scr.cat_name[4]) ;
              write_str ('5 ',49,13) ;
              write     (scr.cat_name[5]) ;
              write_str ('Home Phone:',2,14) ;
              write_str ('Precinct:',31,14) ;
              write_str ('6 ',49,14) ;
              write     (scr.cat_name[6]) ;
              write_str ('Work Phone:',2,15) ;
              write_str ('7 ',49,15) ;
              write     (scr.cat_name[7]) ;
              write_str ('8 ',49,16) ;
              write     (scr.cat_name[8])
            end  { 1 }
          else
            beep ;
        end { case }
    end ; { --- Procedure Paint_screen --- }

{ ---- EOF FILE MROOT1.INC ---------------------------------- }