文書整形 -- 出力の右揃えなど: アナクロなコンピューターエンジニアのつぶやき

現在の出力は、行の右端が不揃いになる。これを解消するのに、 putwrd()を修正する。この中のspread()は、語の間の空白を調整し一行の中に、語を 割り付ける。

RATFORでは

# putwrd.r4 -- put a word in outbuf; include margin justification
      subroutine putwrd(wrdbuf)
      character wrdbuf(INSIZE)
      integer length,width
      integer last,llval,nextra,w
      include cout.fi
      include cparam.fi

      w = width(wrdbuf)
      last = length(wrdbuf) + outp + 1  ! new end of outbuf
      llval = rmval - tival
      if ((outp > 0) & (outw+w > llval | last >= MAXOUT)) { # too big
          last = last - outp            # remember end of wrdbuf
          nextra = llval - outw + 1
          call spread(outbuf,outp,nextra,outwds)
          if ((nextra > 0) & (outwds > 1))
               outp = outp + nextra

          call brk                      # flush previous line
          }
      call scopy(wrdbuf,1,outbuf,outp+1)
      outp = last
      outbuf(outp) = BLANK              # blank between words
      outw = outw + w + 1               # 1 for blank
      outwds = outwds + 1
      return
      end

WATCOM fortran 77では、

c putwrd.f -- put a word in outbuf; include margin justification
      subroutine putwrd(wrdbuf)
      integer*1 wrdbuf(82)              ! INSIZE(82)
      integer length,width
      integer last,llval,nextra,w
      include cout.fi
      include cparam.fi

      w = width(wrdbuf)
      last = length(wrdbuf) + outp + 1  ! new end of outbuf
      llval = rmval - tival
      if ((outp .gt. 0) .and.
     1    ((outw+w .gt. llval) .or. (last .ge. 74))) then ! MAXOUT(74)  too big
          last = last - outp            ! remember end of wrdbuf
          nextra = llval - outw + 1
          call spread(outbuf,outp,nextra,outwds)
          if ((nextra .gt.0) .and. (outwds .gt. 1)) then
               outp = outp + nextra
          end if
          call brk                      ! flush previous line
      end if
      call scopy(wrdbuf,1,outbuf,outp+1)
      outp = last
      outbuf(outp) = 32                 ! BLANK(32)       blank between words
      outw = outw + w + 1               ! 1 for blank
      outwds = outwds + 1
      return
      end

spread()は、以下の通り

RATFORでは

# spread.r4 -- spread words to justify right margin
      subroutine spread(buf,outp,nextra,outwds)
      character buf(MAXOUT)
      integer outp,nextra,outwds
      integer min
      integer dir,i,j,nb,ne,nholes
      data dir/0/

      if ((nextra <= 0) | (outwds <= 1))
          return
      dir = 1 - dir                     # reverce previouse direction
      ne = nextra
      nholes = outwds - 1
      i = outp - 1
      j = min(MAXLINE - 2, i + ne)      # leave room for NEWLINE, EOS
      while (i < j) {
          buf(j) = buf(i)
          if (buf(i) == BLANK) {
              if (dir == 0)
                  nb = (ne - 1) / nholes + 1
              else
                  nb = ne / nholes
              ne = ne - nb
              nholes = nholes - 1
              for ( ; nb > 0; nb = nb - 1) {
                  j = j - 1
                  buf(j) = BLANK
                  }
              }
          i = i - 1
          j = j - 1
          }
      return
      end

WATCOM fortran 77では、

c spread.for -- spread words to justify right margin
      subroutine spread(buf,outp,nextra,outwds)
      integer*1 buf(74)                 ! MAXOUT(74)
      integer outp,nextra,outwds
      integer min
      integer dir,i,j,nb,ne,nholes
      data dir/0/

      if ((nextra .le. 0) .or. (outwds .le. 1)) then
         return
      end if
      dir = 1 - dir                     ! reverce previouse direction
      ne = nextra
      nholes = outwds - 1
      i = outp - 1
      j = min(74-2, i+ne)               ! MAXOUT(74) -2 for leave room for NEWLINE, EOS

      while (i .lt. j) do
          buf(j) = buf(i)
          if (buf(i) .eq. 32) then      ! BLANK(32)
              if (dir .eq. 0) then
                  nb = (ne - 1) / nholes + 1
              else
                  nb = ne / nholes
              end if
              ne = ne - nb
              nholes = nholes - 1
              while (nb .gt. 0) do
                  j = j - 1
                  buf(j) = 32           ! BLANK(32)
                  nb = nb - 1
              end while
          end if
          i = i - 1
          j = j - 1
      end while
      return
      end

中央そろえは、center()で行う。実際は、一時字下げの値を調節する。

RATFORでは

# center.r4 -- center a line by setting tival
      subroutine center(buf)
      character buf(ARB)
      integer width,max
      include cparam.fi

      tival = max((rmval + tival - width(buf)) / 2, 0)
      return
      end

WATCOM fortran 77では、

c center.f -- center a line by setting tival
      subroutine center(buf)
      integer*1 buf(9999)               ! ARB(9999)
      integer width,max
      include cparam.fi

      tival = max((rmval + tival - width(buf)) / 2, 0)
      return
      end

下線は、書き出し文字とBACKSPACE、UNDERLINEを組み合わせ作り出す。 実際は、underl()で書き出し文字列を作り出す。

RATFORでは

# underl.r4 -- underline a line
      subroutine underl(buf,tbuf,size)
      character buf(size),tbuf(size)
      integer size
      integer type
      integer i,j,t

      j = 1
      for (i = 1; buf(i) != NEWLINE & j < size- 1; i = i + 1) {
          tbuf(j) = buf(i)
          j = j + 1
          if (buf(i) != BLANK & buf(i) != TAB & buf(i) != BACKSPACE) {
              tbuf(j) = BACSPACE
              tbuf(j+1) = UNDERLINE
              j = j + 2
              }
          }
      tbuf(j) = NEWLINE
      tbuf(j+1) = EOS
      call scopy(tbuf, 1, buf, 1)          # copy it back to buf
      return
      end

WATCOM fortran 77では、

c underl.for -- underline a line
      subroutine underl(buf,tbuf,size)
      integer*1 buf(size),tbuf(size)
      integer size
      integer i,j,t

      j = 1
      i = 1
      while ((buf(i) .ne. 10) .and. (j .lt. size-1)) do ! NEWLINE(10)
          tbuf(j) = buf(i)
          j = j + 1
          if ((buf(i) .ne. 32)          ! BLANK(32)
     1        .and. (buf(i) .ne. 9)     ! TAB(9)
     2        .and. (buf(i) .ne. 8)) then ! BACKSPACE(8)
              tbuf(j)   = 8             ! BACKSPACE(8)
              tbuf(j+1) = 95            ! UNDERLINE(95)
              j = j + 2
          end if
          i = i + 1
      end while
      tbuf(j)   = 10                    ! NEWLINE(10)
      tbuf(j+1) = -2                    ! EOS(-2)
      call scopy(tbuf,1,buf,1)          ! copy it back to buf
      return
      end

ここまで出てきた新機能を追加するには、text()を修正する必要がある。 text()の最終版は、以下の通り。

RATFORでは

# text.r4 -- process text lines (final version)
      subroutine text(inbuf)
      character inbuf(INSIZE), wrdbuf(INSIZE)
      integer getword
      integer i
      include cparam.ri

      if (inbuf(1) == BLANK | inbuf(1) == NEWLINE)
         call leadbl(inpuf)             # move left, set tival
      if (ulval > 0) {                  # underlining
          call underl(inbuf,wrdbuf,INSIZE)
          ulval = ulval - 1
          }
      if (ceval > 0) {                  # centering
          call center(inbuf)
          call put(inbuf)
          ceval = ceval - 1
          }
      else if (inbuf(1) == NEWLINE)     # all blank line
         call put(inbuf)
      else if (fill == NO)              # unfiled text
         call put(inbuf)
      else                              # filled text
         for (i = 1;getwrd(inbuf,i,wrdbuf)>0; )
             call putwrd(wrdbuf)
      return
      end

WATCOM fortran 77では、

c text.f -- process text lines (final version)
      subroutine text(inbuf)
      integer*1 inbuf(82), wrdbuf(82)   ! INSIZE(82) INSIZE(82)
      integer getwrd
      integer i
      include cparam.fi

      if (inbuf(1) .eq. 32 .or. inbuf(1) .eq. 10) then ! BLANK(32) NEWLINE(10)
         call leadbl(inpuf)             ! move left, set tival
      end if
      if (ulval .gt. 0) then            ! underlining
          call underl(inbuf,wrdbuf,INSIZE)
          ulval = ulval - 1
      end if
      if (ceval .gt. 0) then            ! centering
          call center(inbuf)
          call put(inbuf)
          ceval = ceval - 1
      else if (inbuf(1) .eq. 10) then   ! all blank line
         call put(inbuf)
      else if (fill .eq. 0) then        ! unfiled text NO(0)
         call put(inbuf)
      else                              ! filled text
         i = 1
         while (getwrd(inbuf,i,wrdbuf) .gt. 0 ) do
             call putwrd(wrdbuf)
         end while
      end if
      return
      end