home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sharew / exoten / icon / printf.icn < prev    next >
Encoding:
Text File  |  1990-03-05  |  3.9 KB  |  181 lines
  1. ############################################################################
  2. #
  3. #    Name:    printf.icn
  4. #
  5. #    Title:    Printf-style formatting
  6. #
  7. #    Author:    William H. Mitchell
  8. #
  9. #    Date:    June 10, 1988
  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, a, b, c, d, e, f, g, h)
  37.    local args
  38.  
  39.     args := [a,b,c,d,e,f,g,h]
  40.     return _doprnt(format, args)
  41. end
  42.  
  43. procedure fprintf(file, format, a, b, c, d, e, f, g, h)
  44.    local args
  45.  
  46.     args := [a,b,c,d,e,f,g,h]
  47.     writes(file, _doprnt(format, args))
  48.     return
  49. end
  50.  
  51. procedure printf(format, a, b, c, d, e, f, g, h)
  52.    local args
  53.  
  54.     args := [a,b,c,d,e,f,g,h]
  55.     writes(&output, _doprnt(format, args))
  56.     return
  57. end
  58.  
  59. procedure _doprnt(format, args)
  60.    local out, v, just, width, conv, prec, pad
  61.  
  62.     out := ""
  63.     format ? repeat {
  64.         (out ||:= tab(upto('%'))) | (out ||:= tab(0) & break)
  65.         v := get(args)
  66.         move(1)
  67.         just := right
  68.         width := conv := prec := pad := &null
  69.         ="-" & just := left
  70.         width := tab(many(&digits))
  71.         (\width)[1] == "0" & pad := "0"
  72.         ="." & prec := tab(many(&digits))
  73.         conv := move(1)
  74.         #write("just: ",image(just),", width: ", width, ", prec: ",
  75.         # prec, ", conv: ", conv)
  76.         case conv of {
  77.             "d": {
  78.                 v := string(v)
  79.             }
  80.             "s": {
  81.                 v := string(v[1:(\prec+1)|0])
  82.             }
  83.             "x": v := hexstr(v)
  84.             "o": v := octstr(v)
  85.             "i": v := image(v)
  86.             "r": v := fixnum(v,prec)
  87.             default: {
  88.                 push(args, v)
  89.                 v := conv
  90.             }
  91.             }
  92.         if \width & *v < width then {
  93.             v := just(v, width, pad)
  94.             }
  95.         out ||:= v
  96.         }
  97.  
  98.     return out
  99. end
  100.  
  101. procedure hexstr(n)
  102.    local h, neg
  103.    static BigNeg, hexdigs, hexfix
  104.  
  105.     initial {
  106.         BigNeg := -2147483647-1
  107.         hexdigs := "0123456789abcdef"
  108.         hexfix := "89abcdef"
  109.         }
  110.  
  111.     n := integer(n)
  112.     if n = BigNeg then
  113.         return "80000000"
  114.     h := ""
  115.     if n < 0 then {
  116.         n := -(BigNeg - n)
  117.         neg := 1
  118.         }
  119.     repeat {
  120.         h := hexdigs[n%16+1]||h
  121.         if (n /:= 16) = 0 then
  122.             break
  123.         }
  124.     if \neg then {
  125.         h := right(h,8,"0")
  126.         h[1] := hexfix[h[1]+1]
  127.         }
  128.     return h
  129. end
  130. procedure octstr(n)
  131.    local h, neg
  132.    static BigNeg, octdigs, octfix
  133.  
  134.     initial {
  135.         BigNeg := -2147483647-1
  136.         octdigs := "01234567"
  137.         octfix := "23"
  138.         }
  139.  
  140.     n := integer(n)
  141.     if n = BigNeg then
  142.         return "20000000000"
  143.     h := ""
  144.     if n < 0 then {
  145.         n := -(BigNeg - n)
  146.         neg := 1
  147.         }
  148.     repeat {
  149.         h := octdigs[n%8+1]||h
  150.         if (n /:= 8) = 0 then
  151.             break
  152.         }
  153.     if \neg then {
  154.         h := right(h,11,"0")
  155.         h[1] := octfix[h[1]+1]
  156.         }
  157.     return h
  158. end
  159.  
  160. procedure fixnum(x, prec)
  161.    local int, frac, f1, f2, p10
  162.  
  163.     /prec := 6
  164.     int := integer(x) | return image(x)
  165.     frac := image(x - int)
  166.     if find("e", frac) then {
  167.         frac ?:= {
  168.             f1 := tab(upto('.')) &
  169.             move(1) &
  170.             f2 := tab(upto('e')) &
  171.             move(1) &
  172.             p10 := -integer(tab(0)) &
  173.             repl("0",p10-1) || f1 || f2
  174.             }
  175.         }
  176.     else
  177.         frac ?:= (tab(upto('.')) & move(1) & tab(0))
  178.     frac := left(frac, prec, "0")
  179.     return int || "." || frac
  180. end
  181.