home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / MAIL20.ARK / MSETUP.INC < prev   
Text File  |  1986-09-25  |  17KB  |  515 lines
  1. {   File = MSETUP.INC -- Include file for Reliance Mailing List
  2.     Copyright (c) 1986 William Meacham, All Rights Reserved
  3.     Revised: 3/11/86 }
  4.  
  5. overlay procedure set_up ;
  6.   { Get user input for available K, printer, etc. }
  7.  
  8. { ==================== }
  9.  
  10. procedure compute_max_names ;
  11.   { Get user input for available K, compute max names allowed.
  12.     If user escapes, reset values to what they were on entry. }
  13. var
  14.     max_names_ok  : boolean ;
  15.     i,
  16.     entry_num_k,
  17.     entry_max_rec : integer ;
  18.     k,                         { real of num_k }
  19.     m             : real ;     { real of max_rec }
  20. begin
  21.     clrscr ;
  22.     write_str ('COMPUTE MAXIMUM NAMES ALLOWED', 26,3) ;
  23.     write_str ('How many "K" are available on drive', 8,8) ;
  24.     write     (' ',drive,' ') ;
  25.     write     ('for your data files?') ;
  26.     write_str ('You may have a maximum of       names', 8,11) ;
  27.     write_str ('Is this satisfactory? (Y/N)', 8,13) ;
  28.     write_int (scr.num_k,4,67,8) ;
  29.     write_int (scr.max_rec,5,34,11) ;
  30.     entry_num_k := scr.num_k ;
  31.     entry_max_rec := scr.max_rec ;
  32.  
  33.     fld := 1 ;
  34.     max_names_ok := false ;
  35.     repeat
  36.         case fld of
  37.          1: begin
  38.               read_int (scr.num_k,4,67,8) ;  { get number of k available }
  39.               if (fld > 1) and (fld < maxint) then fld := 2
  40.             end ; { 1 }
  41.          2: begin                            { compute max rec, ask if ok }
  42.               if scr.num_k < 8 then
  43.                   scr.max_rec := 0
  44.               else
  45.                 begin
  46.                   i := scr.num_k ;
  47.                   if not(i mod 2 = 0) then
  48.                       i := pred(i) ;
  49.                   k := i ;
  50.                   m := (k - 2) * 3.50 ;
  51.                       { Subtract 2K for SCR, then figure 3 1/2 data file
  52.                         entries per K.  Formula comes from trial and error
  53.                         and is deliberately conservative.  }
  54.                   if m < 0.0 then
  55.                       m := 0.0
  56.                   else if m > 32000.0 then
  57.                       m := 32000.0 ;          { bullet-proofing }
  58.                   scr.max_rec := trunc(m)
  59.                 end ;
  60.               write_int (scr.max_rec,5, 34,11) ;
  61.               read_bool (max_names_ok,36,13)
  62.             end { 2 }
  63.         end ; {case }
  64.         if not (fld = maxint) then
  65.             if (fld < 1)
  66.             or ((fld > 2) and not (max_names_ok)) then
  67.                 fld := 1
  68.     until max_names_ok or (fld = maxint) ;
  69.  
  70.     if fld = maxint then
  71.       begin
  72.         scr.num_k := entry_num_k ;
  73.         scr.max_rec := entry_max_rec
  74.       end
  75.     else if not(scr.num_k = entry_num_k)
  76.          or not(scr.max_rec = entry_max_rec) then
  77.             write_scr ;
  78.     fld := 1
  79. end ; { proc compute_max_names }
  80.  
  81. { ==================== }
  82.  
  83. procedure set_up_printer ;
  84.   { get initialization and reset strings for compressed print }
  85.  
  86. var
  87.     init, rset : array [1 .. 4] of integer ;  { ord of chars in string }
  88.     i          : integer ;                    { loop control }
  89.     entry_init,
  90.     entry_rset  : str4 ;                       { values on entry to proc }
  91.  
  92. begin
  93.     clrscr ;
  94.     write_str ('SET UP YOUR PRINTER',31,2) ;
  95.     write_str ('This program prints mailing labels and lists in compressed',10,4) ;
  96.     write_str ('print.  Please enter the codes needed to control your printer.',10,5) ;
  97.     write_str ('INITIALIZATION',10,7) ;
  98.     write_str ('Enter the decimal equivalents of up to four control codes',10,8) ;
  99.     write_str ('to turn ON compressed print:',10,9) ;
  100.     write_str ('==>      ==>      ==>      ==>',10,11) ;
  101.     write_str ('RESET',10,14) ;
  102.     write_str ('Enter the decimal equivalents of up to four control codes',10,15) ;
  103.     write_str ('to turn OFF compressed print:',10,16) ;
  104.     write_str ('==>      ==>      ==>      ==>',10,18) ;
  105.  
  106.     with scr do
  107.       begin
  108.         entry_init := prt_init ;
  109.         entry_rset := prt_rset ;
  110.         for i := 1 to 4 do                  { initialize variables }
  111.           begin
  112.             init[i] := 0 ;
  113.             rset[i] := 0
  114.           end ;
  115.         for i := 1 to length(prt_init) do
  116.             init[i] := ord (prt_init[i]) ;
  117.         for i := 1 to length(prt_rset) do
  118.             rset[i] := ord (prt_rset[i]) ;
  119.  
  120.         for i := 2 to 4 do                  { display vars on screen }
  121.             write_int (init[i],3,14+(9*(i-1)),11) ;
  122.         for i := 1 to 4 do
  123.             write_int (rset[i],3,14+(9*(i-1)),18) ;
  124.  
  125.         fld := 1 ;                          { get info from user }
  126.         repeat
  127.             case fld of
  128.               1 .. 4 : read_int (init[fld],3, 14+(9*(fld-1)),11) ;
  129.               5 .. 8 : read_int (rset[fld-4],3, 14+(9*(fld-5)),18) ;
  130.               9 : pause ;
  131.             end ;   { case fld of }
  132.             if fld < 1 then fld := 1
  133.             else if (fld > 99) and (fld < maxint) then fld := 9
  134.         until fld > 9 ;
  135.  
  136.         if not(fld = maxint) then           { update SCR only if normal exit }
  137.           begin
  138.             prt_init := '' ;
  139.             prt_rset := '' ;
  140.             for i := 1 to 4 do
  141.               begin
  142.                 if not(init[i] = 0) then
  143.                     prt_init := concat(prt_init,chr(init[i])) ;
  144.                 if not(rset[i] = 0) then
  145.                     prt_rset := concat(prt_rset,chr(rset[i]))
  146.               end ;  { for i := 1 to 4 }
  147.             if not(prt_init = entry_init)
  148.             or not(prt_rset = entry_rset) then
  149.                 write_scr
  150.           end { if not(fld = maxint) }
  151.       { else (user cancelled) values remain unchanged }
  152.  
  153.      end ;  { with scr do }
  154.  
  155.      fld := 1                          { reset fld for calling routine }
  156.  
  157. end ; { proc set_up_printer }
  158.  
  159. { ==================== }
  160.  
  161. procedure define_categories  ;
  162. var
  163.     i              : integer ;
  164.     entry_cat_name : array [1..8] of str20 ;
  165.     changed        : boolean ;
  166. begin
  167.     with scr do
  168.       begin
  169.         for i := 1 to 8 do
  170.             entry_cat_name[i] := cat_name[i] ;
  171.         clrscr ;
  172.         write_str ('DEFINE SELECTION CATEGORIES',27,2) ;
  173.         write_str ('1  ',29,6) ;
  174.         write     (cat_name[1]) ;
  175.         write_str ('2  ',29,7) ;
  176.         write     (cat_name[2]) ;
  177.         write_str ('3  ',29,8) ;
  178.         write     (cat_name[3]) ;
  179.         write_str ('4  ',29,9) ;
  180.         write     (cat_name[4]) ;
  181.         write_str ('5  ',29,10) ;
  182.         write     (cat_name[5]) ;
  183.         write_str ('6  ',29,11) ;
  184.         write     (cat_name[6]) ;
  185.         write_str ('7  ',29,12) ;
  186.         write     (cat_name[7]) ;
  187.         write_str ('8  ',29,13) ;
  188.         write     (cat_name[8]) ;
  189.  
  190.         fld := 1 ;
  191.         repeat
  192.             while (fld > 0) and (fld < 9) do
  193.                 read_str (cat_name[fld],20,32,fld+5) ;
  194.             if fld = 9 then
  195.                 pause ;
  196.             if fld < 1 then fld := 1
  197.             else if (fld > 99) and (fld < maxint) then fld := 9
  198.         until fld > 9 ;
  199.         if fld = maxint then
  200.             for i := 1 to 8 do
  201.                 cat_name[i] := entry_cat_name[i]
  202.         else
  203.           begin
  204.             changed := false ;
  205.             for i := 1 to 8 do
  206.                 if not(cat_name[i] = entry_cat_name[i]) then
  207.                     changed := true ;
  208.             if changed then
  209.                 write_scr
  210.           end
  211.       end ; { with }
  212.     fld := 1
  213. end ; { proc define_categories }
  214.  
  215. { ==================== }
  216.  
  217. procedure change_ID ;
  218.   { Change descriptive file ID in SCR }
  219. var
  220.     entryID : str30 ;
  221. begin
  222.     clrscr ;
  223.     entryID := scr.ID ;
  224.     write_str ('CHANGE DATA FILE ID',30,2) ;
  225.     write_str ('Data file ID:',16,5) ;
  226.     repeat
  227.         fld := 1 ;
  228.         read_str (scr.ID,30,31,5) ;
  229.         if fld < 1 then fld := 1
  230.     until fld > 1 ;
  231.     if  (fld < maxint)
  232.     and not (entryID = scr.ID) then
  233.         write_scr
  234.     else
  235.         scr.ID := entryID ;
  236.     fld := 1
  237. end ; { procedure change_ID }
  238.  
  239. { ==================== }
  240.  
  241. procedure count_names ;
  242.  
  243. label 98, 99 ;
  244.  
  245. var
  246.     tot_recs,
  247.     num_found   : integer ;
  248.     ch          : char ;
  249.     stop        : boolean ;
  250.     which_ones  : prt_criterion ;
  251.     how_to_sort : sort_criterion ;
  252.  
  253. begin
  254.     select (which_ones,how_to_sort,count) ;
  255.     if fld = maxint then goto 99 ;
  256.  
  257.     if which_ones = all then
  258.       begin
  259.         num_found := scr.num_recs ;
  260.         goto 98
  261.       end ;
  262.  
  263.     write_str ('Counting names . . .',31,20) ;
  264.     write_str ('Press ESC to stop ',31,21) ;
  265.     openfile (mf_file,mf_fname,sizeof(master)) ;
  266.     if not OK then
  267.       begin
  268.         show_msg (concat('CANNOT OPEN ',mf_fname)) ;
  269.         halt
  270.       end ;
  271.     num_found := 0 ;
  272.     tot_recs := filelen(mf_file) ;
  273.     rec_num := 1 ;
  274.     while rec_num < tot_recs do
  275.       begin
  276.  
  277.         if keypressed then
  278.           begin
  279.             keyin (ch) ;
  280.             if ch = #$1B then
  281.               begin
  282.                 write_str ('STOP NOW? (Y/N)',31,22) ;
  283.                 beep ;
  284.                 read_yn (stop,47,22) ;
  285.                 if stop then
  286.                   begin
  287.                     closefile (mf_file) ;
  288.                     goto 99
  289.                   end
  290.                 else
  291.                     clrline(31,22) ;
  292.               end
  293.           end ;
  294.  
  295.         getrec(mf_file,rec_num,master) ;
  296.         if master.status = 0 then
  297.           case which_ones of
  298.             pcat : if (master.flags and mask) > 0 then
  299.                       num_found := succ(num_found) ;
  300.             pct  : if master.precinct = pcinct then
  301.                       num_found := succ(num_found) ;
  302.             pzip : if copy(master.zip,1,5) = copy(zipcode,1,5) then
  303.                       num_found := succ(num_found) ;
  304.             dt   : if not (greater_date(lastdt,master.last_date) = 1) then
  305.                       num_found := succ(num_found) ;
  306.             amt  : if not (greater(contrib,master.tot_amt)) then
  307.                       num_found := succ(num_found) ;
  308.           end ; { case }
  309.         rec_num := succ(rec_num) ;
  310.       end ; { while }
  311.     closefile (mf_file) ;
  312. 98:
  313.     gotoxy (31,22) ;
  314.     write (num_found) ;
  315.     write (' records found',^G) ;
  316.     hard_pause ;
  317. 99:
  318.     fld := 1
  319. end ; { proc count_names }
  320.  
  321. { ==================== }
  322.  
  323. procedure display_scr ;
  324. var
  325.     init, rset : array[1 .. 4] of integer ; { ord of chars in strings }
  326.     i          : integer ;
  327. begin
  328.     with scr do
  329.       begin
  330.         for i := 1 to 4 do
  331.           begin
  332.             init[i] := 0 ;
  333.             rset[i] := 0
  334.           end ;
  335.         for i := 1 to length(prt_init) do
  336.             init[i] := ord(prt_init[i]) ;
  337.         for i := 1 to length(prt_rset) do
  338.             rset[i] := ord(prt_rset[i]) ;
  339.         clrscr ;
  340.         write_str ('SYSTEM CONTROL INFORMATION', 28,1) ;
  341.         write_str (center(ID,30), 26,2) ;
  342.         write_str ('Today''s date:',23,4) ;
  343.         write_date (cur_proc_dt,49,4) ;
  344.         write_str ('Disk space available for data:',23,6) ;
  345.         write_int (num_k,4,55,6) ;
  346.         write (' K') ;
  347.         write_str ('Maximum names allowed:',23,8) ;
  348.         write_int (max_rec,5,54,8) ;
  349.         write_str ('Number of names used:',23,10) ;
  350.         write_int (scr.num_recs,5,54,10) ;
  351.         write_str ('Number of names left:',23,12) ;
  352.         write_int (max_rec - scr.num_recs,5,54,12) ;
  353.         write_str ('Printer:',8,14) ;
  354.         write_str ('Selection categories',45,14) ;
  355.         write_str ('Turn compressed print ON:',10,15) ;
  356.         write_str ('1  ',47,15) ;
  357.         write     (cat_name[1]) ;
  358.         write_str ('2  ',47,16) ;
  359.         write     (cat_name[2]) ;
  360.         for i := 1 to 4 do
  361.             if not (init[i] = 0) then
  362.                 write_int (init[i],3,10+(4*(i-1)),17) ;
  363.         write_str ('3  ',47,17) ;
  364.         write     (cat_name[3]) ;
  365.         write_str ('4  ',47,18) ;
  366.         write     (cat_name[4]) ;
  367.         write_str ('Turn compressed print OFF:',10,19) ;
  368.         write_str ('5  ',47,19) ;
  369.         write     (cat_name[5]) ;
  370.         write_str ('6  ',47,20) ;
  371.         write     (cat_name[6]) ;
  372.         for i := 1 to 4 do
  373.             if not (rset[i] = 0) then
  374.                 write_int (rset[i],3,10+(4*(i-1)),21) ;
  375.         write_str ('7  ',47,21) ;
  376.         write     (cat_name[7]) ;
  377.         write_str ('8  ',47,22) ;
  378.         write     (cat_name[8]) ;
  379.         hard_pause
  380.       end ; { with }
  381.     fld := 1
  382. end ; { proc display_scr }
  383.  
  384. { ==================== }
  385.  
  386. procedure print_scr ;
  387.  
  388. var
  389.     ch : char ;
  390.     st : str80 ;
  391.     dt : datestring ;
  392.     i  : integer ;
  393.  
  394. begin
  395.     write_str ('PUT PLAIN PAPER IN THE PRINTER',22,23) ;
  396.     write_str ('PRESS SPACE BAR TO CONTINUE OR ESC TO CANCEL',22,24) ;
  397.     repeat
  398.         keyin (ch)
  399.     until (ch in [' ',#$1B]) ;
  400.     if ch = ' ' then                  { print the report }
  401.       begin
  402.         write (lst,scr.prt_rset) ;
  403.         st:= '' ;
  404.         add_blanks (st,12) ;
  405.         writeln (lst,concat(st,'RELIANCE MAILING LIST SYSTEM CONTROL INFORMATION')) ;
  406.         writeln(lst) ;
  407.  
  408.         st := 'Data file ID:' ;
  409.         add_blanks (st,13) ;
  410.         writeln(lst,concat(st,scr.ID)) ;
  411.         writeln(lst) ;
  412.  
  413.         st := 'Today''s date:' ;
  414.         add_blanks (st,13) ;
  415.         dt := mk_dt_st (cur_proc_dt) ;
  416.         writeln (lst,concat(st,dt)) ;
  417.         writeln(lst) ;
  418.  
  419.         write (lst,'Disk space available for data: ') ;
  420.         write (lst,scr.num_k:5) ;
  421.         writeln (lst,' K') ;
  422.         writeln (lst) ;
  423.  
  424.         st := 'Maximum names allowed:' ;
  425.         add_blanks (st,9) ;
  426.         write (lst,st) ;
  427.         writeln (lst,scr.max_rec:5) ;
  428.         writeln (lst) ;
  429.  
  430.         st := 'Number of names used:' ;
  431.         add_blanks (st,10) ;
  432.         write (lst,st) ;
  433.         writeln (lst,scr.num_recs:5) ;
  434.         writeln (lst) ;
  435.  
  436.         st := 'Number of names left:' ;
  437.         add_blanks (st,10) ;
  438.         write (lst,st) ;
  439.         writeln (lst,scr.max_rec - scr.num_recs:5) ;
  440.         writeln (lst) ;
  441.  
  442.         writeln (lst,'Printer:') ;
  443.         write (lst,'  Turn compressed print ON:     ') ;
  444.         i := 1 ;
  445.         while i <= length(scr.prt_init) do
  446.           begin
  447.             write (lst,ord(scr.prt_init[i]):4) ;
  448.             i := succ(i)
  449.           end ;
  450.         writeln (lst) ;
  451.         writeln (lst) ;
  452.  
  453.         write (lst,'  Turn compressed print OFF:    ') ;
  454.         i := 1 ;
  455.         while i <= length(scr.prt_rset) do
  456.           begin
  457.             write (lst,ord(scr.prt_rset[i]):4) ;
  458.             i := succ(i)
  459.           end ;
  460.         writeln (lst) ;
  461.         writeln (lst) ;
  462.  
  463.         writeln (lst,'Selection categories:') ;
  464.         for i := 1 to 8 do
  465.           begin
  466.             write (lst,'  ') ;
  467.             write (lst,i) ;
  468.             writeln (lst,concat('  ',scr.cat_name[i]))
  469.           end ;
  470.         page (lst)
  471.       end  { if ch = ' ' }
  472. end ; { proc print_scr }
  473.  
  474. { ==================== }
  475.  
  476. begin { proc set_up ------------------------ }
  477.     repeat
  478.         clrscr ;
  479.         write_str ('SET-UP MENU', 35,1) ;
  480.         write_str ('Please select:', 22,3) ;
  481.         write_str ('1    Compute maximum names allowed', 22,5) ;
  482.         write_str ('2    Set up your printer', 22,7) ;
  483.         write_str ('3    Define selection categories', 22,9) ;
  484.         write_str ('4    Change data file ID',22,11) ;
  485.         write_str ('5    Count names used', 22,13) ;
  486.         write_str ('6    Display system control information', 22,15) ;
  487.         write_str ('7    Print system control information', 22,17) ;
  488.         write_str ('ESC  Return to Main Menu', 22,19) ;
  489.         write_str ('==>', 22,21) ;
  490.         repeat
  491.             fld := 1 ;
  492.             choice := 0 ;
  493.             read_int (choice,1, 27,21) ;
  494.             if fld < 1 then choice := 0
  495.         until (choice in [1 .. 7]) or (fld = maxint) ;
  496.         if not (fld = maxint) then
  497.             case choice of
  498.              1: compute_max_names ;
  499.              2: set_up_printer ;
  500.              3: define_categories ;
  501.              4: change_ID ;
  502.              5: count_names ;
  503.              6: display_scr ;
  504.              7: print_scr
  505.            else
  506.                 beep
  507.            end ; { case }
  508.     until fld = maxint ;
  509.     fld := 1
  510. end ; { proc set_up }
  511.  
  512. { -------- EOF MSETUP.INC ----------------------------------- }
  513. str ('4    Change data file ID',22,11) ;
  514.         write_str ('5    Count names used', 22,13) ;
  515.