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