Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!cis.ohio-state.edu!tut.cis.ohio-state.edu!ucbvax!netcom.com!pbewig
From: pbewig@netcom.com (Phil Bewig)
Newsgroups: comp.lang.icon
Subject: (none)
Message-ID: <m0jd2Wx-000CPgC@netcom.netcom.com>
Date: 14 May 91 17:15:00 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: inet
Organization: The Internet
Lines: 385

Shown below is a superset of the c language printf family of functions
for icon.  I am new enough to icon that most of the procedures can
doubtless be rewritten; see float2str for a particularly bad example. 


############################################################################
#
#       Name:   printf.icn
#
#       Title:  print formatted output
#
#       Author: Philip L. Bewig
#
#       Date:   May 13, 1991
#
############################################################################
#
#  The printf procedures provide general formatted output.  They share a
#  common syntax, differing only in the place where output is sent:
#
#      printf(fmt, expr, expr ...)      - send output to stdout
#      sprintf(fmt, expr, expr ...)     - return output as value of function
#      fprintf(fd, fmt, expr, expr ...) - send output to file fd
#
#  Essentially, the printf functions work by copying the format string to
#  the output.  Regular characters are copied unchanged.  Escape sequences
#  are converted to their corresponding string values; the same escape
#  sequences recognized by the icon language are recognized by printf.  The
#  only real processing performed is to interpret conversion specifications
#  which begin with the "%" character; each conversion specification trans-
#  forms the next expression in the procedure call to the desired form.
#
#  Conversion specifications have the form
#
#      %[-|=][w][.p]c
#
#  where
#
#      -   left justifies the field
#      =   centers the field
#      w   is the minimum field width
#      p   is the precision
#      c   is the conversion character
#
#  By default, the field is right justified in a field of width w, which
#  has a default value of zero; the "-" and "=" specifiers override the
#  default.  In a string, the precision is the maximum number of characters
#  to be printed; in a floating point number, the precision is the number
#  of digits to be printed to the right of the decimal point and has a
#  default value of six.  If "w" or "p" is "*" (star), the minimum field
#  width or precision will be the value of the next expr in the function
#  call.  For a numeric field, if "w" begins with zero the field will be
#  padded to the left with zeros instead of blank spaces; this implemen-
#  tation faithfully reproduces a bug in many printf functions which causes 
#  sprintf("%05d", -2) to produce the string "000-2".
#
#  The conversion character c is one of the following:
#
#      a   positive integer, using letters as digits; the integers
#              1 through 256 are counted a, b, ..., z, aa, ab, ...
#              az, ba, bb, ..., iv (same as Lotus 1-2-3 columns)
#      A   same as a, but print upper-case letters
#      b   unsigned binary integer
#      c   single character of an integer value
#      d   decimal integer
#      e   floating point (scientific notation)
#      E   same as e, but print upper-case "E"
#      f   floating point
#      g   the shorter of e and f (suppresses non-significant zeros)
#      G   same as g, but print upper-case "E"
#      o   unsigned octal integer
#      r   integer in range 1 to 3999, converted to roman numerals
#      R   same as r, but print upper-case letters
#      s   string
#      S   string, with all letters converted to upper-case
#      u   unsigned decimal integer
#      w   integer with absolute value less than one billion, converted
#              to english words
#      W   same as x, but print letters as upper-case
#      x   unsigned hexadecimal integer
#      X   same as x, but print hex digit letters as upper-case
#      $   similar to f, but with a "$" prepended to the output;
#              negative numbers are parenthesized, and an extra
#              print position is allowed to the right of positive
#              numbers
#      %   literal percent sign; no expr is consumed
#
#  There may be any number of expressions following the format string;
#  extra expressions are ignored, but missing expressions cause a run-time
#  error.
#
#  This printf function is a strict superset of the features provided by
#  the standard c or awk printf function; any format specification which
#  they provide is provided identically here.
#
#  There are several local functions which provide a single type of con-
#  version which may be more useful than a general-purpose formatter in
#  some situations.  They are float2str(num, prec), float2sci(num, prec), 
#  float2dollar(num, prec), int2alpha(num), int2roman(num), int2words(num),
#  unsigned2hex(num), unsigned2dec(num), unsigned2oct(num), and
#  unsigned2bin(num).  All of these functions return lower-case letters
#  where appropriate which may be converted to upper-case by the function
#  map(...,&lcase,&ucase).
#
############################################################################
#
#  test driver
#  procedure main()
#      repeat {
#          writes("enter a format specification (null to quit):  ")
#          fmt := read()
#          if *fmt = 0 then break
#          exprlist := []
#          repeat {
#              writes("enter an expression (null to print):  ")
#              temp := read()
#              if *temp = 0 then break
#              put(exprlist, temp)
#          }
#          write("the output is |" || sprintf(fmt, exprlist) || "|")
#          write()
#      }
#  end
#
############################################################################

# sprintf - return formatted string
procedure sprintf(fmt, exprlist)
    local out, just, wid, prec, conv, pad, val, v1, v2, i, s
    out := ""
    fmt ? repeat {
        (out ||:= tab(upto('%\\'))) | (out ||:= tab(0) & break)
        case move(1) of {
        "%": { # format specification
            # initialize
            just := right
            wid := prec := conv := pad := val := &null
            # parse the format specification
            tab(match("-")) & just := left
            tab(match("=")) & just := center
            wid := (tab(many(&digits)) | tab(match("*")))
            (\wid)[1] == "*" & wid := get(exprlist)
            tab(match(".")) & (prec := (tab(many(&digits)) | tab(match("*"))))
            (\prec)[1] == "*" & prec := get(exprlist)
            conv := move(1)
            # perform the specified conversion
            val := get(exprlist)
            case map(conv) of {
            "a": { if not(val := int2alpha(val)) then val := &null }
            "b": { (\wid)[1] == "0" & pad := "0"
                    if not(val := unsigned2bin(val)) then val := &null }
            "c": { val := char(val) }
            "d": { (\wid)[1] == "0" & pad := "0"; val := integer(val) }
            "e": { (\wid)[1] == "0" & pad := "0"; val := float2sci(val, prec) }
            "f": { (\wid)[1] == "0" & pad := "0"; val := float2str(val, prec) }
            "g": { (\wid)[1] == "0" & pad := "0"
                    v1 := float2sci(val, prec)
                    v2 := float2str(val, prec)
                    val := (if *v1 < *v2 then v1 else v2) }
            "o": { (\wid)[1] == "0" & pad := "0"
                    if not(val := unsigned2oct(val)) then val := &null }
            "r": { if not(val := int2roman(val)) then val := &null }
            "s": { if \prec then val := left(val, prec) }
            "u": { (\wid)[1] == "0" & pad := "0"
                    if not(val := unsigned2dec(val)) then val := &null }
            "w": { if not(val := int2words(val)) then val := &null }
            "x": { (\wid)[1] == "0" & pad := "0"
                    if not(val := unsigned2hex(val)) then val := &null }
            "$": { (\wid)[1] == "0" & pad := "0"
                    val := float2dollar(val, prec) }
            "%": { push(exprlist, val); val := "%" }
            default: { out := &null; break }
            }
            if conv ~== map(conv) then val := map(val, &lcase, &ucase)
            if \wid & *val < wid then val := just(val, wid, pad)
            out ||:= val
        }
        "\\": { # escape sequence
            # escape handler derived from an ipl proc by William H. Mitchell
            out ||:= case c := map(move(1)) of {
            "b": "\b"
            "d": "\d"
            "e": "\e"
            "f": "\f"
            "l": "\l"
            "n": "\n"
            "r": "\r"
            "t": "\t"
            "v": "\v"
            "'": "'"
            "\"": "\""
            "x": {
                move(i := 2 | 1) ? s := tab(upto(~'0123456789ABCDEFabcdef') | 0)
                move(*s - i)
                char("16r" || s)
            }
            "^": char(iand(ord(move(1)), 16r1f))
            !"01234567": {
                move(-1)
                move(i := 3 | 2 | 1) ? s := tab(upto(~'01234567') | 0)
                move(*s - i)
                if s > 377 then {
                    s := s[1:3]
                    move(-1)
                }
                char("8r" || s)
            }
            default: c
            }
        }
        }
    }
    return out
end

# printf - print formatted string
procedure printf(fmt, exprlist)
    writes(sprintf(fmt, exprlist))
    return
end

# fprintf - write formatted string to file
procedure fprintf(fd, fmt, exprlist)
    writes(fd, sprintf(fmt, exprlist))
    return
end

# float2str - convert floating point number to string format
# this procedure looks more like pascal than icon
procedure float2str(num, ndigs)
    local out, nbefore, i, digit
    nbefore := 1; /ndigs := 6 # initialize, set default
    if num < 0 then { out := "-"; num *:= -1 } else { out := "" }
    num +:= 0.5 / 10.0 ^ ndigs # round to desired precision
    while num >= 10.0 do { num /:= 10.0; nbefore +:= 1 } # normalize
    every i := 1 to (nbefore + ndigs) do {
        if i = nbefore + 1 then out ||:= "."
        digit := integer(num)
        out ||:= char(digit + 48)
        num := 10.0 * (num - digit)
    }
    return out
end

# float2sci - convert floating point number to string in scientific format
procedure float2sci(num, ndigs)
    local frac, expo
    frac := num; expo := 0
    if abs(frac) >= 10.0 then {
        until abs(frac) < 10.0 do {
            frac /:= 10.0; expo +:= 1
        }
    } else if abs(frac) < 1.0 & frac ~= 0.0 then {
        until abs(frac) > 1.0 do {
            frac *:= 10.0; expo -:= 1
        }
    }
    return float2str(frac, ndigs) || "e" || string(expo)
end

# float2dollar - convert floating point number to string, prepend dollar sign
procedure float2dollar(num, prec)
    if num >= 0 then
        return "$" || float2str(num, prec) || " "
    else
        return "($" || float2str(-num, prec) || ")"
end

# unsigned2hex - convert unsigned int to hex string
procedure unsigned2hex(num)
    local out, nonzero, digit
    static hexdigit
    initial { hexdigit := "0123456789abcdef" }
    if num ~= integer(num) then fail
    if num > 2147483647 then fail
    if num < -2147483648 then fail
    out := ""; nonzero := &null
    every i := 28 to 0 by -4 do {
        digit := hexdigit[iand(ishift(num,-i),15)+1]
        if digit == "0" & /nonzero then next
        nonzero := ""; out ||:= digit
    }
    return out
end

# unsigned2oct - convert unsigned int to octal string
procedure unsigned2oct(num)
    local out, nonzero, digit
    if num ~= integer(num) then fail
    if num > 2147483647 then fail
    if num < -2147483648 then fail
    out := ""; nonzero := &null
    every i := 30 to 0 by -3 do {
        digit := string(iand(ishift(num,-i),7))
        if digit == "0" & /nonzero then next
        nonzero := ""; out ||:= digit
    }
    return out
end

# unsigned2bin - convert unsigned int to binary string
procedure unsigned2bin(num)
    local out, nonzero, digit
    if num ~= integer(num) then fail
    if num > 2147483647 then fail
    if num < -2147483648 then fail
    out := ""; nonzero := &null
    every i := 31 to 0 by -1 do {
        digit := string(iand(ishift(num,-i),1))
        if digit == "0" & /nonzero then next
        nonzero := ""; out ||:= digit
    }
    return out
end

# unsigned2dec - convert unsigned int to decimal string
procedure unsigned2dec(num)
    if num ~= integer(num) then fail
    else if num > 2147483647 then fail
    else if num < -2147483648 then fail
    else if num >= 0 then return string(num)
    else return string(4294967296 - -num)
end

# int2alpha - convert integer to alpha string
procedure int2alpha(num)
    local out
    static alpha
    initial alpha := string(&lcase)
    if num ~= integer(num) then fail
    if num <= 0 then fail
    num -:= 1
    out := alpha[num % 26 + 1]
    while (num := num / 26 - 1) >= 0 do
        out ||:= alpha[num % 26 + 1]
    return reverse(out)
end

# int2roman - convert integer to roman numerals
# this procedure derived from a program by Ralph E. Griswold
procedure int2roman(num)
    local arabic, result
    static equiv
    initial equiv := ["","i","ii","iii","iv","v","vi","vii","viii","ix"]
    integer(num) > 0 | fail
    result := ""
    every arabic := !num do
        result := map(result,"ivxlcdm","xlcdm**") || equiv[arabic+1]
    if find("*",result) then fail else return result
end

# int2words - convert integer to english words
procedure int2words(num)
    local out
    static tens, nums
    initial {
        nums := ["one", "two", "three", "four", "five", "six", "seven",
                "eight", "nine", "ten", "eleven", "twelve", "thirteen",
                "fourteen", "fifteen", "sixteen", "seventeen",
                "eighteen", "nineteen"]
        tens := ["ten", "twenty", "thirty", "forty", "fifty", "sixty",
                "seventy", "eighty", "ninety"]
    }
    if num ~= integer(num) then fail
    if num < 0 then
        return "negative " || int2words(-num)
    if num >= 1000000000 then {
        fail
    } else if num >= 1000000 then {
        out := int2words(num/1000000) || " million"
        if num%1000000 ~= 0 then out ||:= " " || int2words(num%1000000)
    } else if num >= 1000 then {
        out := int2words(num/1000) || " thousand"
        if num%1000 ~= 0 then out ||:= " " || int2words(num%1000)
    } else if num >= 100 then {
        out := int2words(num/100) || " hundred"
        if num%100 ~= 0 then out ||:= " " || int2words(num%100)
    } else if num >= 20 then {
        out := tens[integer(num/10)]
        if num%10 ~= 0 then out ||:= " " || int2words(num%10)
    } else if num > 0 then {
        out := nums[num]
    } else out := "zero"
    return out
end