home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / PRINTF.ICN < prev    next >
Text File  |  1991-07-13  |  4KB  |  172 lines
  1. ############################################################################
  2. #
  3. #    Name:    printf.icn
  4. #
  5. #    Title:    Printf-style formatting
  6. #
  7. #    Author: William H. Mitchell, modified by Cheyenne Wills
  8. #
  9. #    Date:    may 21, 1990
  10. #
  11. ############################################################################
  12. #
  13. #     This procedure behaves somewhat like the standard printf.
  14. #  Supports d, s, o, and x formats like printf.  An "r" format
  15. #  prints real numbers in a manner similar to that of printf's "f",
  16. #  but will produce a result in an exponential format if the number
  17. #  is larger than the largest integer plus one.
  18. #
  19. #     Left or right justification and field width control are pro-
  20. #  vided as in printf.    %s and %r handle precision specifications.
  21. #
  22. #     The %r format is quite a bit of a hack, but it meets the
  23. #  author's requirements for accuracy and speed.  Code contributions
  24. #  for %f, %e, and %g formats that work like printf are welcome.
  25. #
  26. #     Possible new formats:
  27. #
  28. #       %t -- print a real number as a time in hh:mm
  29. #       %R -- roman numerals
  30. #       %w -- integers in english
  31. #       %b -- binary
  32. #
  33. #
  34. ############################################################################
  35.  
  36. procedure sprintf(format, args[])
  37.     return _doprnt(format, args)
  38. end
  39.  
  40. procedure fprintf(file, format, args[])
  41.     writes(file, _doprnt(format, args))
  42.     return
  43. end
  44.  
  45. procedure printf(format, args[])
  46.     writes(&output, _doprnt(format, args))
  47.     return
  48. end
  49.  
  50. procedure _doprnt(format, args)
  51.    local out, v, just, width, conv, prec, pad
  52.  
  53.     out := ""
  54.     format ? repeat {
  55.         (out ||:= tab(upto('%'))) | (out ||:= tab(0) & break)
  56.         v := get(args)
  57.         move(1)
  58.         just := right
  59.         width := conv := prec := pad := &null
  60.         ="-" & just := left
  61.         width := tab(many(&digits))
  62.         (\width)[1] == "0" & pad := "0"
  63.         ="." & prec := tab(many(&digits))
  64.         conv := move(1)
  65.         #write("just: ",image(just),", width: ", width, ", prec: ",
  66.         # prec, ", conv: ", conv)
  67.         case conv of {
  68.             "d": {
  69.             v := string(v)
  70.             }
  71.             "s": {
  72.             v := string(v[1:(\prec+1)|0])
  73.             }
  74.             "x": v := hexstr(v)
  75.             "o": v := octstr(v)
  76.             "i": v := image(v)
  77.             "r": v := fixnum(v,prec)
  78.             default: {
  79.             push(args, v)
  80.             v := conv
  81.             }
  82.             }
  83.         if \width & *v < width then {
  84.             v := just(v, width, pad)
  85.             }
  86.         out ||:= v
  87.         }
  88.  
  89.     return out
  90. end
  91.  
  92. procedure hexstr(n)
  93.    local h, neg
  94.    static BigNeg, hexdigs, hexfix
  95.  
  96.     initial {
  97.         BigNeg := -2147483647-1
  98.         hexdigs := "0123456789abcdef"
  99.         hexfix := "89abcdef"
  100.         }
  101.  
  102.     n := integer(n)
  103.     if n = BigNeg then
  104.         return "80000000"
  105.     h := ""
  106.     if n < 0 then {
  107.         n := -(BigNeg - n)
  108.         neg := 1
  109.         }
  110.     repeat {
  111.         h := hexdigs[n%16+1]||h
  112.         if (n /:= 16) = 0 then
  113.             break
  114.         }
  115.     if \neg then {
  116.         h := right(h,8,"0")
  117.         h[1] := hexfix[h[1]+1]
  118.         }
  119.     return h
  120. end
  121. procedure octstr(n)
  122.    local h, neg
  123.    static BigNeg, octdigs, octfix
  124.  
  125.     initial {
  126.         BigNeg := -2147483647-1
  127.         octdigs := "01234567"
  128.         octfix := "23"
  129.         }
  130.  
  131.     n := integer(n)
  132.     if n = BigNeg then
  133.         return "20000000000"
  134.     h := ""
  135.     if n < 0 then {
  136.         n := -(BigNeg - n)
  137.         neg := 1
  138.         }
  139.     repeat {
  140.         h := octdigs[n%8+1]||h
  141.         if (n /:= 8) = 0 then
  142.             break
  143.         }
  144.     if \neg then {
  145.         h := right(h,11,"0")
  146.         h[1] := octfix[h[1]+1]
  147.         }
  148.     return h
  149. end
  150.  
  151. procedure fixnum(x, prec)
  152.    local int, frac, f1, f2, p10
  153.  
  154.     /prec := 6
  155.     int := integer(x) | return image(x)
  156.     frac := image(x - int)
  157.     if find("e", frac) then {
  158.         frac ?:= {
  159.             f1 := tab(upto('.')) &
  160.             move(1) &
  161.             f2 := tab(upto('e')) &
  162.             move(1) &
  163.             p10 := -integer(tab(0)) &
  164.             repl("0",p10-1) || f1 || f2
  165.             }
  166.         }
  167.     else
  168.         frac ?:= (tab(upto('.')) & move(1) & tab(0))
  169.     frac := left(frac, prec, "0")
  170.     return int || "." || frac
  171. end
  172.