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 / ENTERPRS / CPM / UTILS / S / TPASPGM.ARC / PRTFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-09-27  |  9KB  |  237 lines
  1. Program prtfile ;
  2.   { Prints a text file on the list device, formatted with various
  3.     user-supplied options.   WPM -- 10/12/84 -- TURBO Pascal }
  4.   { Fixed bug -- now it quits after last user-specified page -- 11/17/84 }
  5.  
  6. {$V-}  { Turn off strict type-checking for strings }
  7.  
  8.     label            99 ;               { for premature exit }
  9.  
  10.     const
  11.         formfeed   = ^L ;
  12.         bell       = ^G ;
  13.         linelength = 255 ;              { max length of text file lines }
  14.  
  15.     type
  16.         st_typ  = string[linelength] ;
  17.  
  18.     var
  19.         line, header               : st_typ ;      { print lines }
  20.         blank_line                 : st_typ ;      { to add indentation }
  21.         page_num, line_cnt, i, n   : integer ;     { counters }
  22.         indent, spacing, max_lines : integer ;     { user-supplied }
  23.         first_page, last_page      : integer ;     { user_supplied }
  24.         fname                      : string[14] ;  { file name }
  25.         ipt_file                   : text ;        { input file }
  26.         ok                         : boolean ;     { whether file exists }
  27.         reply                      : char ;        { to get user response }
  28.         quit                       : boolean ;     { to flag when last page printed }
  29.  
  30.     { - - - - - - - - - - - - - - - - }
  31.  
  32.     procedure print_page_header ;
  33.       { prints header line at top of each page -- revised, 11/17/84 }
  34.         var
  35.             i : integer ;
  36.         begin
  37.             page_num := page_num + 1 ;
  38.             if page_num > last_page then
  39.                 quit := true
  40.             else
  41.               begin
  42.                 if page_num >= first_page then
  43.                   begin
  44.                     if page_num > first_page then
  45.                         write (lst, formfeed) ;
  46.                     writeln (lst) ;
  47.                     write (lst, header) ;
  48.                     writeln (lst, page_num) ;
  49.                     writeln (lst) ;
  50.                     for i := 1 to spacing do
  51.                         writeln (lst)
  52.                   end ;
  53.                 line_cnt := 3 + spacing
  54.               end
  55.         end ;  { proc print_page_header }
  56.  
  57.     { - - - - - - - - - - - - - - - - }
  58.  
  59.     procedure print (line : st_typ ; num_newlines : integer) ;
  60.       { prints a line and the number of newlines indicated }
  61.         var
  62.             i : integer ;
  63.         begin
  64.             if line_cnt > max_lines then
  65.                 print_page_header ;
  66.             if  (page_num >= first_page)
  67.             and (page_num <= last_page) then
  68.               begin
  69.                 write (lst,line) ;
  70.                 for i := 1 to num_newlines do
  71.                     writeln (lst)
  72.               end ;
  73.             line_cnt := line_cnt + num_newlines
  74.         end ;  { proc print }
  75.  
  76.     { - - - - - - - - - - - - - - - - }
  77.  
  78.     procedure add_blanks (var st : st_typ ; num_blanks : integer) ;
  79.       { appends the number of blanks indicated to the string }
  80.         var
  81.             i : integer ;
  82.         begin
  83.             for i := 1 to num_blanks do
  84.                 st := concat (st,' ')
  85.         end ;  { proc add_blanks }
  86.  
  87.     { - - - - - - - - - - - - - - - - }
  88.  
  89.     function adjust_line (line : st_typ) : st_typ ;
  90.       { Converts tabs to spaces and adds indentation by moving characters
  91.         one by one from the input string to a work string.  If it encounters
  92.         a tab character it expands the tab to the proper number of spaces.
  93.         Finally, the indentation string is inserted in front of all the
  94.         characters and the function returns the work string. }
  95.         
  96.         const
  97.             tab = ^I ;
  98.         var
  99.             i            : integer ;    { loop counter }
  100.             next_char    : integer ;    { where the next character goes
  101.                                           in the work string }
  102.             work_str     : st_typ ;     { work string to build adjusted line }
  103.         begin
  104.             work_str := '' ;
  105.             next_char := 1 ;
  106.             for i := 1 to length(line) do
  107.                 if not (line[i] = tab) then
  108.                   begin
  109.                     work_str := concat(work_str,line[i]) ;
  110.                     next_char := next_char + 1
  111.                   end
  112.                 else         { character is a tab -- convert to spaces }
  113.                     repeat
  114.                         work_str := concat(work_str,' ') ;
  115.                         next_char := next_char + 1
  116.                     until (next_char > 8) and ((next_char mod 8) = 1) ;
  117.             insert (blank_line,work_str,1) ;
  118.             adjust_line := work_str
  119.         end ;  { --- proc adjust_line --- }
  120.  
  121.     { - - - - - - - - - - - - - - - - }
  122.  
  123.     begin { --- MAIN --- }
  124.         while true do                            { endless loop }
  125.           begin
  126.             writeln ;
  127.             writeln ('This prints a text file, paginated with header.') ;
  128.             writeln ('Please specify options --  <cr> on file name to cancel.') ;
  129.             writeln ('Defaults are no indent, single spacing, 58 lines per page,') ;
  130.             writeln ('start at first page, stop after last.') ;
  131.             writeln ;
  132.  
  133.             repeat                               { get file name }
  134.                 fname := '' ;
  135.                 write   ('File name? ') ;
  136.                 readln  (fname) ;
  137.                 if fname = '' then
  138.                     halt                         { --- Exit loop here --- }
  139.                 else
  140.                   begin
  141.                     assign (ipt_file,fname) ;
  142.                     {$i-}
  143.                     reset (ipt_file) ;
  144.                     {$i+}
  145.                     ok := (ioresult = 0) ;
  146.                     if not ok then
  147.                         writeln (bell,'File not found.')
  148.                   end
  149.             until ok ;
  150.  
  151.             indent := 0 ;                        { get indentation }
  152.             write   ('Number of spaces to indent? ') ;
  153.             readln  (indent) ;
  154.             if indent < 0 then indent := 0 ;
  155.             blank_line := '' ;
  156.             if not (indent = 0 ) then
  157.                 for i := 1 to indent do
  158.                     blank_line := concat (' ',blank_line) ;
  159.  
  160.             spacing := 0 ;                       { get spacing }
  161.             write   ('Line spacing? ') ;
  162.             readln  (spacing) ;
  163.             if spacing < 1 then spacing := 1 ;
  164.  
  165.             max_lines := 0 ;                     { get page length }
  166.             write   ('Max lines per page? ') ;
  167.             readln  (max_lines) ;
  168.             if max_lines < 1 then
  169.                 max_lines := 58 ;
  170.  
  171.             line := '' ;                         { get header }
  172.             write  ('Header/date? ') ;
  173.             readln (line) ;
  174.  
  175.             first_page := 0 ;                    { get first page to print }
  176.             write ('Start at what page? ') ;
  177.             readln (first_page) ;
  178.             if first_page < 1 then
  179.                 first_page := 1 ;
  180.  
  181.             last_page := 0 ;                     { get last page to print }
  182.             write ('Quit after what page? ') ;
  183.             readln (last_page) ;
  184.             if last_page < 1 then
  185.                 last_page := maxint ;
  186.  
  187.             header := blank_line ;               { build header line }
  188.             header := concat(header,fname,'  ',line) ;
  189.             if length(header) < 72 then
  190.                 add_blanks (header, 72 - length(header))
  191.             else
  192.                 add_blanks (header,2) ;
  193.             header := concat (header,'Page ') ;
  194.             page_num := 0 ;
  195.             line_cnt := maxint ;                 { force first page header }
  196.  
  197.             quit := false ;
  198.             while not (eof(ipt_file)) do         { print the text file }
  199.               begin
  200.                 readln (ipt_file,line) ;
  201.                 if not (indent = 0) then         { add identation }
  202.                     line := adjust_line (line) ;
  203.                 repeat
  204.                     n := pos(formfeed,line) ;    { handle embedded formfeeds }
  205.                     if not (n = 0) then
  206.                       begin
  207.                         print (copy(line,1,n-1),spacing) ;
  208.                         print_page_header ;
  209.                         if quit then
  210.                             goto 99 ;
  211.                         delete (line,1,n) ;
  212.                         for i := 1 to indent do
  213.                             line := concat(' ',line) ;
  214.                       end
  215.                 until n = 0 ;
  216.                 print  (line,spacing) ;
  217.  
  218.                 if keypressed then               { check for premature exit }
  219.                   begin
  220.                     writeln ;
  221.                     write  ('+++ Quit now? (Y/N): ') ;
  222.                     readln (reply) ;
  223.                     if upcase(reply) = 'Y' then
  224.                         goto 99
  225.                   end ;
  226.                 if quit then
  227.                     goto 99
  228.               end ;
  229.  
  230. 99:         write (lst,formfeed) ;
  231.             writeln (bell,'Done!')
  232.           end
  233.     end.
  234. s }
  235.                     if not (n = 0) then
  236.                       begin
  237.