文書整形 -- 出力の右揃えなど ― 2016年12月14日 18:13
現在の出力は、行の右端が不揃いになる。これを解消するのに、 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
最近のコメント