$eject
/****************************************************************
*  MODULE NAME: TEXT06.SIM                                      *
*  PUBLIC PROCEDURES: MAX, LEADBLANK, UNDERL, CENTER, GETWORD,  *
*                     PUTWORD, FOOTNOTE, FOOTFLUSH, SPACE, TEXT *
****************************************************************/

text2: do;
$nolist
$include (:f1:datax.sim)
$list
declare fpage byte public initial (false);   /* flag for page with footnote */
declare tabflag byte external;	             /* table mode flag */
tab$handler: procedure external; end;
print$msg : procedure(a) external;
  declare a address; end print$msg;
brk : procedure external; end brk;
put : procedure (a) external;
  declare a address; end put;
putc : procedure(c) external;
  declare c byte; end putc;
pfoot : procedure external; end pfoot;
putword : procedure(bufptr,p,wt,ds) external;
  declare (bufptr,p,wt,ds) address;
  end putword;
width : procedure(abuff) byte external;
  declare abuff address; end width;
scopy : procedure(a1,i,a2,j) external;
  declare (a1,a2) address, (i,j) byte; end scopy;
skip : procedure (n) external; 
  declare n byte; end;
phead : procedure external; end;
min : procedure(v1,v2) byte external;
  declare (v1,v2) byte; end;

$eject
/**************************************************************
*    MAX - RETURN THE MAXIMUM VALUE BETWEEN TWO NUMBER        *
**************************************************************/
max : procedure (v1,v2) byte public;
  declare (v1,v2) byte;
  if v1 < v2 then return v2;
  else return v1;
  end max;

/***************************************************************
*  LEAD$BLANK - HANDLE THE INPUT TEXT WITH LEADING BLANK       *
*               IN FILL MODE BREAK IS FORCED                   *
***************************************************************/
lead$blank : procedure public;
  declare (i,j) byte;
  call brk;
  i,j = 0;
  do while lbuff(i) = blank;
    i = i + 1;
  end;
  if lbuff(i) = eos then 
    do;
      tival=0;
      lblen=1;
      lbuff(0)=newline;
      return;
    end;
  tival = tival + i;
  do while lbuff(i) <> eos;
    lbuff(j)  =  lbuff(i);
    i = i + 1;
    j = j + 1;
  end;
  lbuff(j) = eos;
  lblen = j + 1;
  end lead$blank;


$eject
/***************************************************************
*  UNDERL - UNDERLINES THE WORDS IN THE LINE BUFFER            *
***************************************************************/
underl : procedure(ab,ad,size) public;
  declare (ab,ad) address, size byte;
  declare (buf based ab, tbuf based ad) (lsize) byte;
  declare (i,j) byte;
  i,j = 0;
  do while buf(i) <> eos and j < size - 1;
    tbuf(j) = buf(i);
    j = j + 1;
    if buf(i) <> blank and buf(i) <> tab
      and buf(i) <> backspace then
      do;
        tbuf(j) = backspace;
        tbuf(j + 1) =  underline;
        j = j + 2;
      end;
    i = i + 1;
  end;
  lblen = j + 1;
  tbuf(j) = eos;
  call scopy(ab,0,ad,0);
  end underl;

/****************************************************************
*                                                               *
*  CENTER - CENTER A LINE BY SETTING TEMPORARY INDENT VALUE     *
*                                                               *
****************************************************************/
center : procedure (abuf) public;
  declare abuf address, (i,j) byte;
  tival = max((rmval + tival - width(abuf)) / 2, 0);
  end center;

$eject
/*****************************************************************
*  GETWORD - TAKE ONE WORD AT A TIME FROM LBUFF TO WORDBUF       *
*****************************************************************/

getword : procedure byte public;
  declare j byte;
  j = 0;
  do while lbuff(wordp) = blank or lbuff(wordp) = tab;
    wordp = wordp + 1;
  end;
  do while lbuff(wordp) <> eos and lbuff(wordp) <> blank
    and lbuff(wordp) <> tab;
    wrdbuf(j) = lbuff(wordp);
    wordp = wordp + 1;
    j = j + 1;
  end;
  wrdbuf(j) = eos;
  return j;
  end getword;

$eject
$include (:f1:fnt2.sim)

$eject
/************************************************************
* FOOTFLUSH - PRINT OUT THE FOOTNOTE AT THE PROPER PLACE    *
************************************************************/

footflush : procedure public;
  declare temp$lsval byte;     /* to save lsval */
  temp$lsval = lsval;
  lsval = 1;  /* single space for footnote */
  call put(.topfn);    /* put top of footnote */
  do while lineno <=  bottom   /* put will increment lineno */
    and firstptr < lastptr;

    call put(.footbuf(ptr$list(first$ptr)));  /* transfer footnote
                line by line */
    first$ptr = first$ptr + 1;
  end;
  lsval = templsval;  /* restore lsval */
  if first$ptr  =  last$ptr then 
    do;
      first$ptr,last$ptr = 0;
      footptr = 1;
      footlen = 1;
      fpage = false;
      return;
    end;
  footlen = last$ptr - first$ptr + 1;
  end footflush;
 
$eject
/************************************************************
*  SPACE - SKIP N LINES WITHIN THE SAME PAGE                *
************************************************************/

space : procedure (n) public;
  declare n byte;;    /* number of space */
  call brk;
  if lineno > bottom then return;
  if lineno = 0 then call phead;
  do;
    if footlen > 1 and (lineno + n) > (bottom - footlen)
     and bottom > lineno
      then 
        do;
          call skip(bottom - lineno - footlen + 1);
          lineno = bottom - footlen + 1;
          call footflush;
          return;
        end;
    else 
      do;
        call skip(min(n, bottom + 1 - lineno));
        lineno = lineno + n;
      end;
    if lineno > bottom then call pfoot;
  end;
  end space;

$eject
/***************************************************************
*  TEXT - HANDLES  THE INPUT TEXT FROM INPUT FILE WITH         *
*         REGARD OF THE CURRENT CONTROL                        *
***************************************************************/
text : procedure public;

  /*   print footnotes if any, at the proper place   */

  if footlen > 1 and (footlen + lineno) > bottom
    and bottom > lineno then call footflush;

  if tabflag then   /* tabulation mode */
    do;
      call tabhandler;
      return;
    end;

  /* if footnote, handle it separately until finish */

  if fnot$flag then 
    do;
      call footnote;
      fnot$flag = false;
      return;
    end;
  if lbuff(0) = blank or lbuff(0) = eos
    then call lead$blank;
  do;
    if ulval > 0 then
      do;
        call underl(.lbuff,.wrdbuf,lsize);
        ulval=ulval-1;
      end;
  end;
  if ceval > 0 then
    do;
      call center(.lbuff);
      call put(.lbuff);
      ceval=ceval-1;
    end;
  else 
    do;
      if lbuff(0) = newline then
        do;
          call brk;
          call put(.lbuff);
          return;
        end;
      if fill = no
        then call put(.lbuff);
      else 
        do;
          do while getword > 0;
             call putword(.outbuf,.outp,.outw,.outwds);
          end;
         end;
    end;
  end text;

end text2;

eof
- HANDLING THE INPUT TEXT FROM INPUT FILE WITH         *
*         REGARD OF THE CURRENT CONTROL                        *
*                                                              *
***************************************************************/


text : procedure public;

    if tabflag then do;    /* tabulation mode */
        call tabhandler;
        return;
    end;

/* if footnote, handle it separately until finish "/

    if fNot$flag then 
        do;
            call footnote;
            fnot$flag = false;
            return;
        end;
    if lbuff(0) = blank or lbuff(0) = eos
        then call lead$blank;
    do;
        if ulval > 0 then
            do;
                call underl(.lbuff,.wrdbuf,lsize);
                ulval=ulval-1;
            end;
    end;
    if ceval > 0 then
        do;
            call center(.lbuff);
            call put(.lbuff);
            ceval=ceval-1;
        end;
    else 
        do;
            if foo