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 / LANGUAGS / FORTRAN / RATFOR.LBR / ENTAB.RTF < prev    next >
Text File  |  2000-06-30  |  1KB  |  73 lines
  1. # entab - replace blanks by tabs and blanks
  2.  
  3.    include "b:ratdefn.rtf"
  4.  
  5.    character getc
  6.    character c
  7.    integer tabpos
  8.    integer col, i, newcol, tabs(MAXLINE)
  9.  
  10.    call initio
  11.  
  12.    call settab(tabs)
  13.    col = 1
  14.    repeat {
  15.       newcol = col
  16.       while (getc(c) == BLANK) {   # collect blanks
  17.      newcol = newcol + 1
  18.      if (tabpos(newcol, tabs) == YES) {
  19.         call putc(TAB)
  20.         col = newcol
  21.         }
  22.      }
  23.       for ( ; col < newcol; col = col + 1)
  24.      call putc(BLANK)      # output leftover blanks
  25.       if (c == EOF)
  26.      {call putc(EOF); stop}
  27.       call putc(c)
  28.       if (c == NEWLINE)
  29.      col = 1
  30.       else
  31.      col = col + 1
  32.       }
  33.  
  34.    call putc(EOF)
  35.  
  36.    stop
  37.    end
  38.  
  39. # tabpos - return YES if col is a tab stop
  40.    integer function tabpos(col, tabs)
  41.    integer col, i, tabs(MAXLINE)
  42.  
  43.    if (col > MAXLINE)
  44.       tabpos = YES
  45.    else
  46.       tabpos = tabs(col)
  47.    return
  48.    end
  49.  
  50. # settab - set initial tab stops
  51.    subroutine settab(tabs)
  52.    integer mod
  53.    integer i, tabs(MAXLINE)
  54.  
  55.    for (i = 1; i <= MAXLINE; i = i + 1)
  56.       if (mod(i, 8) == 1)
  57.      tabs(i) = YES
  58.       else
  59.      tabs(i) = NO
  60.    return
  61.    end
  62. 
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.