========== text formatter of chapter 7 ==========
define(INSIZE,300)
define(MAXOUT,300)
define(COMMAND,PERIOD)
define(PAGENUM,SHARP)
define(PAGEWIDTH,60)
define(PAGELEN,66)
define(UNKNOWN,0)
define(FI,1)
define(NF,2)
define(BR,3)
define(LS,4)
define(BP,5)
define(SP,6)
define(IN,7)
define(RM,8)
define(TI,9)
define(CE,10)
define(UL,11)
define(HE,12)
define(FO,13)
define(PL,14)
define(HUGE,1000)
common /cout/ outp, outw, outwds, outbuf(MAXOUT)
   integer outp      # last char position in outbuf; init = 0
   integer outw      # width of text currently in outbuf; init = 0
   integer outwds      # number of words in outbuf; init = 0
   character outbuf      # lines to be filled collect here
common /cpage/ curpag,newpag,lineno,plval,m1val,m2val,m3val,m4val,
   bottom, header(MAXLINE), footer(MAXLINE)
   integer curpag   # current output page number; init = 0
   integer newpag   # next output page number; init = 1
   integer lineno   # next line to be printed; init = 0
   integer plval   # page length in lines; init = PAGELEN = 66
   integer m1val   # margin before and including header
   integer m2val   # margin after header
   integer m3val   # margin after last text line
   integer m4val   # bottom margin, including footer
   integer bottom   # last live line on page, = plval-m3val-m4val
   character header   # top of page title; init = NEWLINE
   character footer   # bottom of page title; init = NEWLINE
common /cparam/ fill, lsval, inval, rmval, tival, ceval, ulval
   integer fill      # fill if YES; init = YES
   integer lsval   # current line spacing; init = 1
   integer inval   # current indent; >= 0; init = 0
   integer rmval   # current right margin; init = PAGEWIDTH = 60
   integer tival   # current temporary indent; init = 0
   integer ceval   # number of lines to center; init = 0
   integer ulval   # number of lines to underline; init = 0
# brk - end current filled line
   subroutine brk
   include cout
   if (outp > 0) {
      outbuf(outp) = NEWLINE
      outbuf(outp+1) = EOS
      call put(outbuf)
      $)
   outp = 0
   outw = 0
   outwds = 0
   return
   end
# center - center a line by setting tival
   subroutine center(buf)
   character buf(ARB)
   integer max, width
   include cparam
   tival = max((rmval+tival-width(buf))/2, 0)
   return
   end
# comand - perform formatting command
   subroutine comand(buf)
   character buf(MAXLINE)
   integer comtyp, getval, max
   integer argtyp, ct, spval, val
   include cpage
   include cparam
   ct = comtyp(buf)
   if (ct == UNKNOWN)   # ignore unknown commands
      return
   val = getval(buf, argtyp)
   if (ct == FI) {
      call brk
      fill = YES
      $)
   else if (ct == NF) {
      call brk
      fill = NO
      $)
   else if (ct == BR)
      call brk
   else if (ct == LS)
      call set(lsval, val, argtyp, 1, 1, HUGE)
   else if (ct == CE) {
      call brk
      call set(ceval, val, argtyp, 1, 0, HUGE)
      $)
   else if (ct == UL)
      call set(ulval, val, argtyp, 0, 1, HUGE)
   else if (ct == HE)
      call gettl(buf, header)
   else if (ct == FO)
      call gettl(buf, footer)
   else if (ct == BP) {
      if (lineno > 0)
         call space(HUGE)
      call set(curpag, val, argtyp, curpag+1, -HUGE, HUGE)
      newpag = curpag
      $)
   else if (ct == SP) {
      call set(spval, val, argtyp, 1, 0, HUGE)
      call space(spval)
      $)
   else if (ct == IN) {
      call set(inval, val, argtyp, 0, 0, rmval-1)
      tival = inval
      $)
   else if (ct == RM)
      call set(rmval, val, argtyp, PAGEWIDTH, tival+1, HUGE)
   else if (ct == TI) {
      call brk
      call set(tival, val, argtyp, 0, 0, rmval)
      $)
   else if (ct == PL) {
      call set(plval, val, argtyp, PAGELEN,
         m1val+m2val+m3val+m4val+1, HUGE)
      bottom = plval - m3val - m4val
      $)
   return
   end
# comtyp - decode command type
   integer function comtyp(buf)
   character buf(MAXLINE)
   if (buf(2) == LETF & buf(3) == LETI)
      comtyp = FI
   else if (buf(2) == LETN & buf(3) == LETF)
      comtyp = NF
   else if (buf(2) == LETB & buf(3) == LETR)
      comtyp = BR
   else if (buf(2) == LETL & buf(3) == LETS)
      comtyp = LS
   else if (buf(2) == LETB & buf(3) == LETP)
      comtyp = BP
   else if (buf(2) == LETS & buf(3) == LETP)
      comtyp = SP
   else if (buf(2) == LETI & buf(3) == LETN)
      comtyp = IN
   else if (buf(2) == LETR & buf(3) == LETM)
      comtyp = RM
   else if (buf(2) == LETT & buf(3) == LETI)
      comtyp = TI
   else if (buf(2) == LETC & buf(3) == LETE)
      comtyp = CE
   else if (buf(2) == LETU & buf(3) == LETL)
      comtyp = UL
   else if (buf(2) == LETH & buf(3) == LETE)
      comtyp = HE
   else if (buf(2) == LETF & buf(3) == LETO)
      comtyp = FO
   else if (buf(2) == LETP & buf(3) == LETL)
      comtyp = PL
   else
      comtyp = UNKNOWN
   return
   end
# format - text formatter main program (final version)
   character inbuf(INSIZE)
   integer getlin
   include cpage
   call init
   while (getlin(inbuf, STDIN) ~= EOF)
      if (inbuf(1) == COMMAND)   # it's a command
         call comand(inbuf)
      else               # it's text
         call text(inbuf)
   if (lineno > 0)
      call space(HUGE)         # flush last output
   stop
   end
# gettl - 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) == SQUOTE | buf(i) == DQUOTE)   # strip quote if found
      i = i + 1
   call scopy(buf, i, ttl, 1)
   return
   end
# getval - evaluate optional numeric argument
   integer function getval(buf, argtyp)
   character buf(MAXLINE)
   integer ctoi
   integer argtyp, 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
   argtyp = buf(i)
   if (argtyp == PLUS | argtyp == MINUS)
      i = i + 1
   getval = ctoi(buf, i)
   return
   end
# getwrd - get non-blank word from in(i) into  out, increment i
   integer function getwrd(in, i, out)
   integer in(MAXLINE), out(MAXLINE)
   integer i, j
   while (in(i) == BLANK | in(i) == TAB)
      i = i + 1
   j = 1
   while (in(i)~=EOS & in(i)~=BLANK & in(i)~=TAB & in(i)~=NEWLINE) {
      out(j) = in(i)
      i = i + 1
      j = j + 1
      $)
   out(j) = EOS
   getwrd = j - 1
   return
   end
# init - set parameters to default values
   subroutine init
   include cparam
   include cpage
   include cout
   inval = 0
   rmval = PAGEWIDTH
   tival = 0
   lsval = 1
   fill = YES
   ceval = 0
   ulval = 0
   lineno = 0
   curpag = 0
   newpag = 1
   plval = PAGELEN
   m1val = 3; m2val = 2; m3val = 2; m4val = 3
   bottom = plval - m3val - m4val
   header(1) = NEWLINE; header(2) = EOS   # initial titles
   footer(1) = NEWLINE; footer(2) = EOS
   outp = 0
   outw = 0
   outwds = 0
   return
   end
# leadbl - delete leading blanks, set tival
   subroutine leadbl(buf)
   character buf(MAXLINE)
   integer max
   integer i, j
   include cparam
   call brk
   for (i = 1; buf(i) == BLANK; i = i + 1)   # find 1st non-blank
      ;
   if (buf(i) ~= NEWLINE)
      tival = i - 1
   for (j = 1; buf(i) ~= EOS; j = j + 1) {   # move line to left
      buf(j) = buf(i)
      i = i + 1
      $)
   buf(j) = EOS
   return
   end
# pfoot - put out page footer
   subroutine pfoot
   include cpage
   call skip(m3val)
   if (m4val > 0) {
      call puttl(footer, curpag)
      call skip(m4val-1)
      $)
   return
   end
# phead - put out page header
   subroutine phead
   include cpage
   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
# put - put out line with proper spacing and indenting
   subroutine put(buf)
   character buf(MAXLINE)
   integer min
   integer i
   include cpage
   include cparam
   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
# puttl - put out 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
# putwrd - put a word in outbuf; includes margin justification
   subroutine putwrd(wrdbuf)
   character wrdbuf(INSIZE)
   integer length, width
   integer last, llval, nextra, w
   include cout
   include cparam
   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
# set - set parameter and check range
   subroutine set(param, val, argtyp, defval, minval, maxval)
   integer max, min
   integer argtyp, defval, maxval, minval, param, val
   if (argtyp == NEWLINE)      # defaulted
      param = defval
   else if (argtyp == PLUS)      # relative +
      param = param + val
   else if (argtyp == MINUS)   # relative -
      param = param - val
   else               # absolute
      param = val
   param = min(param, maxval)
   param = max(param, minval)
   return
   end
# skip - output  n  blank lines
   subroutine skip(n)
   integer i, n
   for (i = 1; i <= n; i = i + 1) {
      call putc(PERIOD)
      call putc(NEWLINE)
      $)
   return
   end
# skipbl - skip blanks and tabs at lin(i)...
   subroutine skipbl(lin, i)
   character lin(ARB)
   integer i
   while (lin(i) == BLANK | lin(i) == TAB)
      i = i + 1
   return
   end
# space - space  n  lines or to bottom of page
   subroutine space(n)
   integer min
   integer n
   include cpage
   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
# spread - spread words to justify right margin
   subroutine spread(buf, outp, nextra, outwds)
   character buf(MAXOUT)
   integer min
   integer dir, i, j, nb, ne, nextra, nholes, outp, outwds
   data dir /0/
   if (nextra <= 0 | outwds <= 1)
      return
   dir = 1 - dir   # reverse previous direction
   ne = nextra
   nholes = outwds - 1
   i = outp - 1
   j = min(MAXOUT-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
# putwrd - put a word in outbuf
   subroutine putwrd(wrdbuf)
   character wrdbuf(INSIZE)
   integer length, width
   integer last, llval, w
   include cout
   include cparam
   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
      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
# text - process text lines (final version)
   subroutine text(inbuf)
   character inbuf(INSIZE), wrdbuf(INSIZE)
   integer getwrd
   integer i
   include cparam
   if (inbuf(1) == BLANK | inbuf(1) == NEWLINE)
      call leadbl(inbuf)   # 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)      # unfilled text
      call put(inbuf)
   else            # filled text
      for (i = 1; getwrd(inbuf, i, wrdbuf) > 0; )
         call putwrd(wrdbuf)
   return
   end
# text - process text lines (interim version 1)
   subroutine text(inbuf)
   character inbuf(INSIZE)
   call put(inbuf)
   return
   end
# text - process text lines (interim version 2)
   subroutine text(inbuf)
   character inbuf(INSIZE), wrdbuf(INSIZE)
   integer getwrd
   integer i
   include cparam
   if (inbuf(1) == BLANK | inbuf(1) == NEWLINE)
      call leadbl(inbuf)   # move left, set tival
   if (inbuf(1) == NEWLINE)   # all blank line
      call put(inbuf)
   else if (fill == NO)      # unfilled text
      call put(inbuf)
   else            # filled text
      for (i = 1; getwrd(inbuf, i, wrdbuf) > 0; )
         call putwrd(wrdbuf)
   return
   end
# underl - underline a line
   subroutine underl(buf, tbuf, size)
   integer i, j, size
   character buf(size), tbuf(size)
   j = 1      # expand into tbuf
   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) = BACKSPACE
         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
# width - compute width of character string
   integer function width(buf)
   character buf(MAXLINE)
   integer i
   width = 0
   for (i = 1; buf(i) ~= EOS; i = i + 1)
      if (buf(i) == BACKSPACE)
         width = width - 1
      else if (buf(i) ~= NEWLINE)
         width = width + 1
   return
   end