$eject
/**************************************************************
*  MODULE NAME: TEXT09.SIM                                    *
*  PUBLIC PROCEDURES: PUTC, PRINTC, PUTDEC, PUTTL, SKIP,      *
*                     PHEAD, PFOOT, MIN, PUT, BRK             *
**************************************************************/
space2: do;
$nolist
$include (:f1:datax.sim)
$list
declare flength byte external;
declare footlen byte external;
  
write: procedure (aft,buffer,count,status) external;
  declare (aft,buffer,count,status) address;
  end write;

error: procedure (errnum) external;
  declare (errnum,status) address;
  end error;

print : procedure(a,b) external;
  declare (a,b) address; end print;

/*****************************************************************
*   PUTC - PUT THE CHARACTER INTO TEXTBUFFER AND FLUSH IT INTO   *
*          THE OUTPUT FILE, OR TO THE SPECIFIED DEVICE           *
*****************************************************************/
putc: procedure(c) public;
  declare c byte;
  textbuf(tbp) = c;
  if (tbp := tbp+1) >= buflen then
    do;
      call write(aft$out,.textbuf,buflen,.status);
      tbp=0;
    end;
  end putc;

$eject
/*************************************************************
*  PRINTC - TRANSFER THE STRING LINE INTO THE TEXTBUFFER     *
*************************************************************/

 printc: procedure(a) public;
  declare a address,buf based a (lsize) byte;
  declare (i,j,charpos) byte;
  i,charpos = 0;
  do while buf(i) <> newline;
    if buf(i) = tab then 
      do;
        j = 8 - (charpos mod 8);  /* number of spaces needed */
        do while j <> 0;
          call putc(blank);
          j = j - 1; charpos = charpos + 1;
        end;
       end;
    else   /* copy the character as it is */
      do;
      call putc(buf(i));
      charpos = charpos + 1;
      end;
    i = i + 1;
  end;
  end printc;

$eject
/*************************************************************
*   PUTDEC - PUT OUT THE DECIMAL NUMBER INTO SPECIFIED       *
*            LOCATION OF BUFFER                              *
*************************************************************/

 putdec: procedure (numb) public;
  declare numb byte;
  declare (char, temp, i) byte, decnum(5) byte;
  i = 0;
  do while numb > 0;
    char = numb mod 10;
    numb = (numb - char) / 10;
    decnum(i) = char + 48;
    i = i + 1;
  end;

  /* insert extra blank to make even */
  temp = 3 - i;
  do while (temp := temp - 1) <> 255;
    call putc(blank);
  end;

  do while (i := i - 1) <> 255;
    call putc(decnum(i));
  end;
  end putdec;

$eject
/***************************************************************
*  PUTTL - PUT OUT TITLE LINE WITH OPTIONAL PAGE NUMBER        *
***************************************************************/

 puttl: procedure (a,pageno) public;
  declare a address, outbuf based a (lsize) byte,
    (pageno, i) byte;
  i = 0;
  do while outbuf(i) <> eos;
    if outbuf(i) = pagenum then call putdec(pageno);
    else call putc(outbuf(i));
    i = i + 1;
  end;
  call putc(cr); call putc(lf);
  end puttl;

/***********************************************************
*         SKIP - SKIPPING N BLANK LINES                    *
***********************************************************/

 skip: procedure (n) public;
  declare (i,n) byte;
  if n > 0 then 
    do;
      do i = 1 to n;
        call putc(cr);
        call putc(lf);
      end;
    end;
  end skip;

$eject
/**************************************************************
*   PHEAD - PUT OUT THE HEADER INTO THE TEXTBUFFER            *
**************************************************************/
 phead: procedure public;
  cur$page = new$page;
  new$page = new$page + 1;
  if m1val > 0 then 
    do;

    if headflag then 
      do;
        call skip(m1val-1);    /* top margin */
        call puttl(.header,cur$page);  /* heading line */
      end;
    else call skip(m1val);
    end;
  call skip(m2val);      /* top space */
  lineno = m1val + m2val + 1;      /* next line */
  end phead;

/**************************************************************
*  PFOOT - PUT OUT THE FOOTER TITLE INTO TEXTBUFFER           *
**************************************************************/
 pfoot: procedure public;
  call skip(m3val);    /* bottom space */
  if m4val > 0 then 
    do;
      if footflag then 
        do;
          call puttl(.footer,cur$page);
          call skip(m4val-1);
        end;
      else call skip(m4val);
    end;
    end pfoot;

$eject
/***********************************************************
*  MIN - RETURN THE MINIMUM VALUE BETWEEN TWO NUMBERS      *
***********************************************************/
min: procedure (v1,v2) byte public;
  declare (v1,v2) byte;
  if v1 < v2 then return v1;
  else return v2;
  end min;

$eject
/************************************************************
*  PUT - PUT OUT A LINE WITH A PROPER SPACING AND           *
*        INDENTING, AND PRINT HEADER OR FOOTER IF           *
*        BEGIN PAGE OR ENCOUNTERS BOTTOM                    *
************************************************************/

put: procedure(a)  public;
  declare a address, buf based a (lsize) byte;
  if lineno = 0 or lineno > bottom
    then call phead;
  if tival > 0 then    /* set indentation */
    do;
      blankbuf(tival) = newline;
      call printc(.blankbuf);
      blankbuf(tival) = blank;
    end;
  tival = inval;
  if fill = no or ceval > 0    /* line buffer is lbuff */
    then lbuff(lblen-1) = newline;
  call printc(a);
  call putc(cr); call putc(lf);

  /* checking for footnote in this page,
     if necessary skip less than lsval,
     to make the footnote at the same page */

  if lsval > 1 and footlen > 1
    and bottom < (footlen + lineno + lsval) then
    do;
      call skip(bottom - lineno - footlen);
      lineno = bottom - footlen + 1;
    end;

  else
    do;
      call skip(min(lsval - 1, bottom - lineno));
      lineno = lineno + lsval;
    end;

  if lineno > bottom then call pfoot;
  end put;


 breakf: procedure external;
  end breakf;
    
$eject
/*************************************************************
*   BRK - END THE CURRENT FILLED LINE, EITHER IN OUTBUF      *
*         FOR TEXT LINE, OR IN FOUTBUF FOR FOOTNOTE          *
*************************************************************/
 brk: procedure  public;
  if flength > 0 then 
    do;
      call breakf;
      return;
    end;  
  if outp > 0 then 
    do;
      outbuf(outp-1) = newline;
      call put(.outbuf);
      outp = 0;
      outw, outwds = 0;
    end;
  end brk;

end space2;

eof