home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / cug / softt-12.lbr / PRINTF.RQT / PRINTF.RAT
Text File  |  1984-07-05  |  6KB  |  197 lines
  1. #-h-  printf.r                   5671  local   01/05/81  22:36:40
  2. #-h-  printf                     3471  local   01/05/81  21:59:14
  3. ##printf--print arguments according to s
  4.   subroutine printf(fd,s,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9)
  5.   character s(ARB)
  6.   integer myllc, a(ARB), ctoi, length, rtoc, xtoc
  7.   integer arg(9)
  8.   integer fd, i, j, c, w, p, ap, len
  9.   integer buf(MAXCHARS)
  10.   character fmt(ARB)
  11.  
  12.   arg(1) = arg1
  13.   arg(2) = arg2
  14.   arg(3) = arg3
  15.   arg(4) = arg4
  16.   arg(5) = arg5
  17.   arg(6) = arg6
  18.   arg(7) = arg7
  19.   arg(8) = arg8
  20.   arg(9) = arg9
  21.   ap = 1
  22.   if (s(1) > 127 | s(1) < 0)  {
  23.      for (i = 1; myllc(fmt(i),s,i-1) != 0; i = i + 1)
  24.         ;
  25.      fmt(i) = EOS
  26.      }
  27.   else
  28.      call scopy(s, 1, fmt, 1)
  29.   for (i = 1; fmt(i) != EOS; i = i + 1) {
  30.      c = fmt(i)
  31.      if (c == BAR) {  # special character
  32.         i = i + 1
  33.         c = fmt(i)
  34.         if (c == DIG0)
  35.            return
  36.         else if (c == LETT | c == BIGT)
  37.            c = TAB
  38.         else if (c == LETN | c == BIGN)
  39.            c = NEWLINE
  40.         else if (c == LETB | c == BIGB)
  41.            c = BACKSPACE
  42.         call putch(c, fd)
  43.         }
  44.     else if (c != PERCENT)  #ordinary character
  45.         call putch(c, fd)
  46.     else {  #format code
  47.        i = i + 1
  48.        w = ctoi(fmt, i)
  49.        if (fmt(i) == PERIOD) {
  50.           i = i + 1
  51.           p = ctoi(fmt, i)
  52.           }
  53.      else
  54.           p = -1
  55.      c = fmt(i)
  56.      if (c == LETD | c == BIGD)
  57.     {
  58.        call remark('we think it is a decimal.')
  59.         call putint(arg(ap), w, fd)
  60.      }
  61.      else if (c == LETO | c == BIGO) { # %wo print octal integer
  62.         len = xtoc(arg(ap), buf, MAXCHARS, 8)
  63.         call putstr(buf, w, fd)
  64.         }
  65.      else if (c == LETX | c == BIGX) { # %w.bx print integer in base b
  66.         if (p < 2 | p > 36) # default is hex
  67.            p = 16
  68.         len = xtoc(arg(ap), buf, MAXCHARS, p)
  69.         call putstr(buf, w, fd)
  70.         }
  71.      else if (c == LETS | c == BIGS) { # %ws print string
  72.       call locarg(ap,argout,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9)
  73.       if (arg(ap) <= 127 & arg(ap) > 0)  # unpacked string
  74.            len = length(argout)
  75.         else     # packed string
  76.            for (len=0; myllc(c,argout,len) != 0; len = len+1)
  77.               if (c == BAR)
  78.                  if (myllc(c, argout, len+1) == DIG0)
  79.                     break
  80.       if (p > 0 & p < len)  # truncate if precision given
  81.           len = p
  82.       for ( ; w > len; w = w - 1)
  83.          call putch(BLANK, fd)
  84.       if (arg(ap) <= 127 & arg(ap) > 0)  # unpacked string
  85.          for (j = 0; j < len; j = j + 1)
  86.             call putch(argout,fd)
  87.       else  # packed string
  88.          for (j = 0; j < len; j = j + 1)
  89.              call putch(myllc(c, argout,j), fd)
  90.       for ( ; w < -len; w = w + 1)
  91.          call putch(BLANK, fd)
  92.       }
  93.    else if (c == LETF | c == BIGF) { # %w.df print real number
  94.       if (p == -1)        # default precision is 666
  95.           p = 6
  96.       len = rtoc(arg(ap), buf, p, MAXCHARS)
  97.       call putstr(buf, w, fd)
  98.       }
  99.    else if (c == LETE | c == BIGE) { # %w.de print real number
  100.       if (p == -1)
  101.           p = 6
  102.       len = rtoc(arg(ap), buf, -p, MAXCHARS) # force e format
  103.       call putstr(buf, w, fd)
  104.       }
  105.    else if (c == LETC | c == BIGC) { # %wc print character
  106.       for ( ; w > 1; w = w - 1)
  107.           call putch(BLANK, fd)
  108.       if (arg(ap) <= 127 & arg(ap) > 0)
  109.         call putch(arg(ap),fd)
  110.       else
  111.          call putch(myllc(c, arg(ap), 0), fd)
  112.       for ( ; w < -1; w = w + 1)
  113.           call putch(BLANK,fd)
  114.       }
  115.     else if (c == LETN | c == BIGN)   # %n change output file
  116.        fd = arg(ap)
  117.     else {   # funny code
  118.        call putch(c, fd)
  119.        next
  120.        }
  121.     ap = ap + 1
  122.     }
  123.   }
  124. return
  125. end
  126. #-t-  printf                     3471  local   01/05/81  21:59:14
  127. #-h-  xtoc                        716  local   01/05/81  21:59:15
  128. # xtoc - convert integer  int  to char string in  str in base b
  129.    integer function xtoc(int, str, size, b)
  130.    integer abs, mod
  131.    integer i, int, intval, j, k, size, b
  132.    character str(ARB)
  133.  
  134.    intval = abs(int)
  135.    str(1) = EOS
  136.    i = 1
  137.    repeat {            # generate digits
  138.       i = i + 1
  139.       str(i) = DIG0 + mod(intval, b)
  140.       if (b > 10)
  141.          str(i) = str(i) + LETA - DIG9 - 1
  142.       intval = intval / b
  143.       } until (intval == 0 | i >= size)
  144.    if (int < 0 & i < size) {      # then sign
  145.       i = i + 1
  146.       str(i) = MINUS
  147.       }
  148.    xtoc = i - 1
  149.    for (j = 1; j < i; j = j + 1) {   # then reverse
  150.       k = str(i)
  151.       str(i) = str(j)
  152.       str(j) = k
  153.       i = i - 1
  154.       }
  155.    return
  156.    end
  157. #-t-  xtoc                        716  local   01/05/81  21:59:15
  158. #-h-  myllc                       142  local   01/05/81  21:59:15
  159. ##myllc puts the ith character (base-0) of a into c
  160. integer function myllc(c,a,i)
  161.         character a(ARB), c
  162.         integer i
  163.  
  164.         c = a(i+1)
  165.         myllc = c
  166. end
  167. #-t-  myllc                       142  local   01/05/81  21:59:15
  168. #-h-  locarg                      388  local   01/05/81  21:59:16
  169. ##locarg--finds the ith argument writes it to argout
  170. subroutine locarg(ap,argout,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9)
  171. integer ap,argout(ARB),arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9
  172.  
  173. if (ap == 1)
  174.        call scopy(arg1,1,argout,1)
  175. else if(ap == 2)
  176.        call scopy(arg2,1,argout,1)
  177. else if(ap == 3)
  178.        call scopy(arg3,1,argout,1)
  179. else if(ap == 4)
  180.        call scopy(arg4,1,argout,1)
  181. else if (ap == 5)
  182.        call scopy(arg5,1,argout,1)
  183. else if (ap == 6)
  184.        call scopy(arg6,1,argout,1)
  185. else if (ap == 7)
  186.        call scopy(arg7,1,argout,1)
  187. else if (ap == 8)
  188.        call scopy(arg8,1,argout,1)
  189. else if (ap == 9)
  190.        call scopy(arg9,1,argout,1)
  191. else argout(1) = EOS
  192. return
  193. end
  194. #-t-  locarg                      388  local   01/05/81  21:59:16
  195. #-t-  printf.r                   5671  local   01/05/81  22:36:40
  196. #-t-  printf.lbl                 9621  local   01/05/81  22:41:16
  197.