文書整形 -- テキストの書き出し: アナクロなコンピューターエンジニアのつぶやき

指令以外の行は、テキストである。これを書き出すルーチンtext()の 臨時第一版を示す。この版は下請けルーチンput()を呼び出すだけである。

RATFORでは、

# text.r4 -- process text lines (interim version 1)
      subroutine text(inbuf)
      character inbuf(INSIZE)

      call put(inbuf)
      return
      end

WATCOM fortran 77では、

c text.f -- process text lines (interim version 1)
      subroutine text(inbuf)
      integer*1 inbuf(82)               ! INSIZE(82)

      call put(inbuf)
      return
      end

下請けルーチンput()では、ページのレイアウトを考慮した出力が作り出される。

RATFOR版は、以下の通り。

# put.r4 -- put out line with proper spacing and indenting
      subroutine put(buf)
      character buf(MAXLINE)
      integer min
      integer i
      include cpage.ri
      include cparam.ri

      if (lineno == 0 | lineno > bottom)
          call phead

      for (i = 1; i <= tival; i = i + 1) # indenting
          call putc(BLANK)
      tival = inval
      call putlin(buf,STDOUT)
      call skip(min(lsval-1,bottom-lineno))
      lineno = lineno + lsval
      if (lineno > bottom)
          call pfoot
      return
      end

WATCOM fortran77版は、以下の通り。

c put.f -- put out line with proper spacing and indenting
      subroutine put(buf)
      integer*1 buf(82)                 ! MAXLINE(82)
      integer min
      integer i
      include cpage.fi
      include cparam.fi

      if ((lineno .eq. 0) .or. (lineno .gt. bottom)) then
          call phead
      end if

      i = 1                             ! indenting
      while (i .le. tival) do
          call putc(32)                 ! BLANK(32)
          i = i + 1
      end while

      tival = inval
      call putlin(buf,6)                ! STDOUT(6)
      call skip(min(lsval-1,bottom-lineno))
      lineno = lineno + lsval

      if (lineno .gt. bottom) then
          call pfoot
      end if
      return
      end

ページ見出し、ヘッダーとフッターは、phead()、pfoot()で書き出す。 put()は、これらを適当な位置で書き出すよう制御する。

phead()のRATFOR版は、以下の通り。

# phead.r4 -- put out page header
      subroutine phead
      include cpage.ri

      curpag = newpag
      newpag = newpag + 1
      if (m1val > 0) {
         call skip(m1val - 1)
         call puttl(header,curpag)
         }
      call skip(m2val)
      lineno = m1val + m2val + 1
      return
      end

WATCOM fortran 77版は、以下の通り。

c phead.f -- put out page header
      subroutine phead
      include cpage.fi

      curpag = newpag
      newpag = newpag + 1
      if (m1val .gt. 0) then
         call skip(m1val-1)
         call puttl(header,curpag)
      end if
      call skip(m2val)
      lineno = m1val + m2val + 1
      return
      end

pfoot()のRATFOR版は、以下の通り。

# pfoot.r4 -- put out page footer
      subroutine pfoot
      include cpage.ri

      call skip(m3val)
      if (m4val > 0) {
         call puttl(footer,curpag)
         call skip(m4val - 1)
         }

      return
      end

WATCOM fortran 77版は、以下の通り。

c pfoot.f -- put out page footer
      subroutine pfoot
      include cpage.fi

      call skip(m3val)
      if (m4val .gt. 0) then
         call puttl(footer,curpag)
         call skip(m4val - 1)
      endif

      return
      end

phead()、pfoot()とも、ページ見出しの書き出しはputtl()を使用する。 puttl()は、書き出す内容にPAGEMUN記号("#")が含まれていた場合、 その場所にページ番号を入れ込む。

puttl()のRATFOR版は、以下の通り。

# puttl.r4 -- put title line with optional page number
      subroutine puttl(buf,pageno)
      character buf(MAXLINE)
      integer pageno
      integer i

      for (i = 1; buf(i) != EOS; i = i + 1)
          if (buf(i) == PAGENUM)
              call putdec(pageno,1)
          else
              call putc(buf(i))
      return
      end

WATCOM fortran 77版は、以下の通り。

c puttl.for -- put title line with optional page number
      subroutine puttl(buf,pageno)
      integer*1 buf(82)                 ! MAXLINE(82)
      integer pageno
      integer i

      i = 1
      while (buf(i) .ne. -2) do         ! EOS(-2)
          if (buf(i) .eq. 35) then      ! PAGENUM('#',35)
              call putdec(pageno,1)
          else
              call putc(buf(i))
          end if
          i = i + 1
      end while
      return
      end

ページ見出しは、gettl()でページ見出し用のバッファーにセットする。

gettl()のRATFOR版は、以下の通り。

# gettl.r4 -- copy title from buf to ttl
      subroutine gettl(buf,ttl)
      character buf(MAXLINE),ttl(MAXLINE)
      integer i

      i = 1                             # skip command name
      while ( buf(i) != BLANK & buf(i) != TAB & buf(i) != NEWLINE )
          i = i + 1
      call skipbl(buf,i)                # find argument
      if (buf(i) == SQUORT | buf(i) == DQUORT) # strip quorte if found
          i = i + 1
      call scopy(buf, i, ttl, 1)
      return
      end

WATCOM fortran 77版は、以下の通り。

c gettl.for -- copy title from buf to ttl
      subroutine gettl(buf,ttl)
      integer*1 buf(82),ttl(82)         ! MAXLINE(82) MAXLINE(82)
      integer i

      i = 1                             ! skip command name
      while ((buf(i) .ne. 32)           ! BLANK(32)
     1    .and. (buf(i) .ne. 9)         ! TAB(9)
     2    .and. (buf(i) .ne. 10)) do    ! NEWLINE(10)
          i = i + 1
      end while

      call skipbl(buf,i)                ! find argument
      if ((buf(i) .eq. 39)
     1    .or. (buf(i) .eq. 34)) then   ! strip quorte if found SQUOTE(''',39) DQUOTE('"',34)
          i = i + 1
      end if
      call scopy(buf,i,ttl,1)
      return
      end

".sp"指令や".bp"指令は、space()で空行を出力しページレイアウトを 調整する。

space()のRATFOR版は、以下の通り。

# space.r4 -- space n lines or to bottom of page
      subroutine space(n)
      integer n
      integer min
      include cpage.ri

      call brk
      if (lineno > bottom)
          return
      if (lineno == 0)
          call phead
      call skip(min(n, bottom + 1 - lineno))
      lineno = lineno + n
      if (lineno > bottom)
          call pfoot
      return
      end

WATCOM fortran 77版は、以下の通り。

c space.f -- space n lines or to bottom of page
      subroutine space(n)
      integer n
      integer min
      include cpage.fi

      call brk
      if (lineno .gt. bottom) then
          return
      end if
      if (lineno .eq. 0) then
          call phead
      end if
      call skip(min(n,bottom+1-lineno))
      lineno = lineno + n
      if (lineno .gt. bottom) then
          call pfoot
      end if
      return
      end