/************************************************************
*   module name: text02.sim                                 *
*   public procedures: set, index, ctoi, getval, gettl,     *
*                      comtyp, command.                     *
************************************************************/
cmmd2: do;
$nolist
declare footlen byte external;
$include (:f1:datax.sim)
$list 
/***********************************************************
*              EXTERNAL PROCEDURES                         *
***********************************************************/

print : procedure(a,b) external;
  declare (a,b) address; end print;
skip : procedure(n) external;
  declare n byte; end skip;
min : procedure(v1,v2) byte external;
  declare (v1,v2) byte; end min;
max : procedure (v1,v2) byte external;
  declare (v1,v2) byte; end max;
brk : procedure external; end brk;
space : procedure(n) external;
  declare n byte; end space;

$eject
/************************************************************
*     SET - SET PARAMETER AND CHECK THE RANGE               *
************************************************************/

set : procedure (param,val,deval,minval,maxval) byte public;
  declare (param,val,deval,minval,maxval) byte;
  
  if argtyp = eos then return deval;
  else 
    do;
      if argtyp = pluss then param = param + val;
      else 
        do;
          if argtyp = minuss then param = param - val;
          else param=val;
        end;
    end;
  param = min (param,maxval);
  param = max (param,minval);
  return param;
  end set;

/***********************************************************
*  INDEX - RETURN THE INTEGER VALUE OF NUMERIC CHARACTER   *
***********************************************************/

declare digits (10) byte init ('0123456789');

index : procedure(c) byte public;
  declare c byte;
  declare i byte;
  do i = 1 to 10;
    if digits(i-1) = c then return i;
  end;
  i = 0;
  return i;
  end index;

/**********************************************************
*    CTOI - CONVERT CHARACTER NUMBER TO INTEGER           *
**********************************************************/

ctoi: procedure(i) byte public;
  declare (i,d,inum) byte;

  inum = 0;
  do while lbuff(i) = blank or lbuff(i) = tab;
    i = i +1;
  end;
  do while lbuff(i) <> eos and lbuff(i) <> lf
    and lbuff(i) <> cr;
    d = index(lbuff(i));
    if d = 0 then return inum;
    inum = inum * 10 + d - 1;
    i = i + 1;
  end;
  return inum;
  end ctoi;

$eject
/******************************************************
*     GETVAL - GET THE PARAMETER ACTUAL VALUE         *
******************************************************/

getval : procedure byte public;
  declare (nvalue,i) byte;
  i = 0;
  do while lbuff(i) <> blank and lbuff(i) <> tab
    and lbuff(i) <> eos;
    i = i + 1;
  end;
    do while lbuff(i) = blank or lbuff(i) = tab;
        i = i + 1;
    end;
    argtyp = lbuff(i);
    if argtyp = pluss or argtyp = minuss
        then i = i + 1;
    if argtyp = eos then return unknown;
    nvalue = ctoi(i);
    return nvalue;
    end getval;

$eject
/************************************************************
*   GETTL - COPY TITLE FROM LINE BUFFER TO TTL              *
*           FORMAT TITLE INTO TRIPLE TITLE                  *
************************************************************/


gettl : procedure(choose) public;
  declare choose address, ttl based choose (lsize) byte;
  declare (i,j,l,temp,num) byte, delimeter byte;
      /* i is lbuff pointer, j is ttl pointer */
  declare extraspace byte;  /* extra space generated by '%' */

  i, j, extraspace = 0;
  do while lbuff(i) <> blank and lbuff(i) <> tab
    and lbuff(i) <> eos;
    i = i + 1;
  end;
  do while lbuff(i) = blank or lbuff(i) = tab;
    i = i + 1;
  end;
  if lbuff(i) > blank then delimeter = lbuff(i);
  else 
    do;
      errorflag = true;
      return;
    end;
  /* verify triple title */
  temp = i + 1;
  num = 1;
  l = 0;
  do while lbuff(temp) <> eos and num < 4;
    if lbuff(temp) = delimeter then num = num + 1;
    if lbuff(temp) = '%' and delimeter <> '%'
        then extraspace = extraspace + 2; /* page number converted into 3 characters */
    temp = temp + 1;
    if num = 2 then l = l + 1;    /* midle title length */
  end;
  temp = temp - 1;  /* position of rightmost delimeter in lbuff */
  l = l - 1;    /* minus delimeter */
  if num <> 4 then   /* title less then 3 parts */
    do;
      errorflag = true;
      return;
    end;
  if inval > 0 then   /* indentation */
    do;
    do while j < inval;
      ttl(j) = blank;
      j = j + 1;
    end;
    end;

  /* get left title */
  i = i + 1;
  do while lbuff(i) <> delimeter;
    ttl(j) = lbuff(i);
    i = i + 1; j = j + 1;
  end;
  
  /* get the midle title */
  num = max((rmval + inval - l)/2, j);
  do while num > j;  /* put blank between first and second title */
    ttl(j) = blank;
    j = j + 1;
  end;
  i = i + 1;    /* pointing to first position of midle title */
  if l > 0 then 
    do;
    do while lbuff(i) <> delimeter;
    ttl(j) = lbuff(i);
      i = i + 1;
      j = j + 1;
    end;
    end;  /* middle title */
    
/************************************************************  
*     GET THE RIGHT PART OF TITLE                           *
*         TEMP IS THE RIGHTMOST POSITION OF DELIMETER       *
************************************************************/

  l = rmval - 1 - extraspace; /* l is pointer for ttl, start from right side */
  ttl(l+1) = eos;    /* end title */
  do while temp > i + 1;  /* i+1 is pointing to leftmost of right title */
    temp = temp - 1;
    ttl(l) = lbuff(temp);
    l = l - 1;
  end;
  do while l >= j;  /* put spaces as required */
    ttl(l) = blank;
    l = l - 1;
  end;
  end gettl;

declare comtab (52) byte init ('finfbrls', 'bpspinrm', 'ticeulhe', 'fopladno',
    'nepptmts','bsbmfn','tadlpn');

$include (:f1:tcount.sim)


$eject
/*************************************************************
*    COMTYP - DEFINE THE COMMAND TYPE AND RETURN            *
*        THE VALUE OF THAT COMMAND.                         *
*************************************************************/

comtyp : procedure byte public;
  declare i byte;
  do i = 1 to 51;
    if (lbuff(1) = comtab(i-1) and lbuff(2) = comtab(i))
    or (lbuff(1) = (comtab(i-1)-20h) and lbuff(2) = (comtab(i)-20h))
      then return ((i + 1)/2);
    i = i + 1;
  end;
  return unknown;
  end comtyp;

$eject
/**************************************************************
*                                                             *
*     COMMAND - INTERPRET THE COMMAND TEXT CONTROL            *
*             AND PERFORM IT.                                 *
**************************************************************/


error$command : procedure external;
    end error$command;

declare (fpage,flength) byte external;


command : procedure public;
  declare (ct,val,mv) byte;
  ct=comtyp;
  if ct = unknown then    /* skip the invalid command */
    do;
      call error$command;
      return;
    end;
    if tabflag and ct <> 3 then
        return;            /* skip command except break
                       in tabulation mode */
    val = getval;
    do case ct;

      /*****   u n k n o w n   *****/
       ;

      /*****   f i l l    *****/
      do;
        call brk;
        fill = yes;
      end;

      /**==  n o   f i l l  ==**/
       do;
         call brk;
         fill = no;
       end;

      /*****    b r e a k    *****/
       do;
          tab$flag=false;     /* reset table mode */
          call brk;
       end;

      /*****    line spacing    *****/
       lsval = set(lsval,val,1,1,huge);

      /*****     b e g i n   p a g e    *****/
        do;
        if lineno > (m1val + m2val) then call space (huge);
        curpage = set(curpage, val, curpage + 1, 0, huge);
        new$page = cur$page;
       end;

      /******   s p a c e   *****/
      do;
        spval=set(spval,val,1,0,huge);
        call space(spval);
      end;

      /*****    i n d e n t    *****/
      do;
        inval=set(inval,val,0,0,rmval-1);
        tival=inval;
      end;

      /*****    right margin   *****/
      rmval = set(rmval, val, pagewidth, tival + 1, huge);

      /*****    temporary indent    *****/
      do;
        call brk;
        tival = set(tival, val, 0, 0, rmval);
      end;

      /*****    c e n t e r    *****/
      do;
        call brk;
        ceval = set(ceval, val, 1, 0, huge);
      end;

      /*****    u n d e r l i n e    *****/
       ulval = set(ulval, val, 1, 1, huge);

      /*****  h e a d e r  ******/
      do;
        call gettl(.header);
        if errorflag then
          do;
            call errorcommand;
            headflag = false;
          end;
        else headflag = true;
      end;

     /*****  f o o t e r  *****/
      do;
        call gettl(.footer);
        if errorflag then
          do;
            call errorcommand;
            footflag = false;
          end;
        else footflag = true;
      end;

      /*****  set page length  *****/
      do;
        mv = m1val + m2val + m3val + m4val + 1;
        plval = set(plval, val, pagelen, mv, huge);
        bottom = plval - m3val - m4val;
      end;


      /***   adjust right margin   ***/
      rmjust = true;

      /****   n o   a d j u s t   ****/
      rmjust = false;

     /*****  need lines  *****/
      if (bottom - lineno) < val then call space(huge);

      /*****  new paragraph  ******/
      do;
        call brk;
          if (lineno + 4) > (bottom + footlen -1) then 
                call space(huge);
          else call skip(1);
          tival = inval + 4;
      end;

      /*****  top margin  *****/
      do;
        argtyp = 0;
        m1val = set(m1val, val, 4, 0, (bottom - m2val - 1));
      end;

      /*****  top space  *****/
      do;
        argtyp = 0;
        m2val = set(m2val, val, 2, 0, (bottom - m1val - 2));
      end;

      /*****  bottom space  *****/
      do;
        argtyp = 0;
        m3val = set(m3val, val, 2, 0, (plval - m1val - m2val - m4val - 2));
        bottom = plval - m3val - m4val;
      end;

      /*****  bottom margin  *****/
      do;
        argtyp = 0;
        m4val = set(m4val, val, 4, 0, (plval - m1val - m2val - m3val - 2));
        bottom = plval - m3val - m4val;
      end;

      /*****  f o o t n o t e  *****/
      do;
        argtyp = 0;
        flength = set(flength, val, 1, 1, 10);
        fpage,fnot$flag = true;
      end;

      /*****  t a b l e  *****/
      do;
        call brk;
        tabflag = true;
        call count$table;
      end;

      /*****  get delimeter  *****/
      call get$delimeter;

      /***** set page number  *****/
      newpage = set(newpage, val, newpage + 1, 0, 255);
  end;
  end command;

end cmmd2;

eof