$eject
/*************************************************************
*  MODULE NAME: TEXT08.SIM                                   *
*  PUBLIC PROCEDURES: WIDTH, LENGTHS, SCOPY, SPREAD, PUTWORD *
*************************************************************/

ptwd2: do;
$nolist
$include (:f1:datax.sim)
declare flength byte external;
$list
brk: procedure external; end brk;
min: procedure(v1,v2) byte external;
  declare (v1,v2) byte; end min;
printmsg: procedure(a) external;
  declare a address; end printmsg;

/*************************************************************
*   WIDTH - COMPUTE THE WIDTH OF CHARACTER STRINGS           *
*           BACKSPACE IS SPECIAL CASE - HAS NEGATIVE LENGTH  *
*************************************************************/

 width: procedure(abuff) byte  public;
  declare abuff address, buff based abuff (lsize) byte;
  declare (i,w) byte;
  i, w = 0;
  do while buff(i) <> eos;
    if buff(i) = backspace
      then w = w - 1;
    else w = w + 1;
    i = i + 1;
  end;
  return w;
  end width;

$eject
/*****************************************************************
*   LENGTHS - COMPUTE THE LINE LENGTH, EACH CHARACTER HAS        *
*             THE SAME LENGTH (ONE)                              *
*****************************************************************/
    
lengths : procedure(a) byte public;
  declare a address, buf based a (lsize) byte;
  declare i byte;
  i = 0;
  do while buf(i) <> eos;
    i = i + 1;
  end;
  return i;
  end lengths;

/***************************************************************
*   COPY - COPIES THE CONTENT OF BUF2 INTO BUF1 START FROM     *
*          THE POINTERS SPECIFIED, UNTIL EOS IS ENCOUNTERED    *
***************************************************************/

scopy : procedure(a1,i,a2,j) public;
  declare (a1,a2) address, (i,j) byte;
  declare (buf1 based a1, buf2 based a2) (lsize) byte;
  do while buf2(j) <> eos;
    buf1(i) = buf2(j);
    i = i + 1;
    j = j + 1;
  end;
  buf1(i) = eos;
  end scopy;

declare dir byte init (0);


$eject
/**************************************************************
*  SPREAD - INSERT THE EXTRA BLANKS BETWEEN SUBSEQUENT        *
*           WORDS AND ARANGES IT SO THAT THE EXTRA SPACES     *
*           ARE WELL DISTRIBUTED                              *
**************************************************************/

spread : procedure(nextra,bufptr,p,ds) public;
  declare (bufptr,p,ds) address,
    outbuf based bufptr (maxout) byte;
  declare (outp based p,
    outwds based ds) byte;
  declare (nextra,i,j,nb,ne,nhole) byte;
  

  /* check the number of words and extra space */


  if nextra <= 0 or outwds <= 1 then return;
  dir = 1 - dir;
  ne = nextra;
  nhole = outwds - 1;
  i = outp - 2;
  j = min(maxout,i+ne);

  do while i < j;
    outbuf(j) = outbuf(i);
    if outbuf(i) = blank then 
      do;
        do;
          if dir = 0 then nb = (ne - 1) / nhole + 1;
          else nb = ne/nhole;
        end;
        ne = ne - nb;
        nhole = nhole - 1;
        do while nb > 0;
          j = j - 1;
          outbuf(j) = blank;
          nb = nb - 1;
        end;
      end;
    j = j - 1;
    i = i - 1;
  end;
  end spread;

$eject
/**************************************************************
*  PUTWORD - PUT A WORD IN OUTBUF, INCLUDE RIGHT MARGIN       *
*            JUSTIFICATION IF SPECIFIED BY CALLING            *
*            SPREAD ROUTINE                                   *
**************************************************************/

putword : procedure(bufptr,p,wt,ds) public;
  declare (bufptr,p,wt,ds) address,
    outbuf based bufptr (maxout) byte,
    (outp based p,
    outw based wt, outwds based ds) byte;
  declare (lasts,llval,nextra,w) byte;
    w = width(.wrdbuf);
  lasts = lengths(.wrdbuf) + outp + 1;
  llval = rmval - tival;
    
    /************************************************************
    * CHECK THE BUFFER CONTENTS - FOR BUFFER OVERFLOW           *
    ************************************************************/

  if outp > 0 and ((outw+w) > llval or lasts >= maxout) then
    do;
  
      lasts = lasts-outp;
      nextra = llval-outw+1;

   /*  check if need to spread the line */
      
      if rm$just or flength > 0 then
        do;
          if nextra > 0 and outwds > 1 then
            do;
              call spread(nextra, bufptr, p, ds);
              outp = outp + nextra;
            end;
        end;
      call brk;
    end;

  call scopy(.outbuf, outp, .wrdbuf, 0);
  outp = lasts;
  outbuf(outp - 1) = blank;
  outw = outw + w + 1;
  outwds = outwds + 1;
  end putword;

end ptwd2;

eof