aboutsummaryrefslogtreecommitdiff
path: root/sys/fmtio/dtoc3.x
diff options
context:
space:
mode:
Diffstat (limited to 'sys/fmtio/dtoc3.x')
-rw-r--r--sys/fmtio/dtoc3.x285
1 files changed, 285 insertions, 0 deletions
diff --git a/sys/fmtio/dtoc3.x b/sys/fmtio/dtoc3.x
new file mode 100644
index 00000000..76101dd1
--- /dev/null
+++ b/sys/fmtio/dtoc3.x
@@ -0,0 +1,285 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include <ctype.h>
+include <printf.h>
+
+.help dtoc3
+.nf ___________________________________________________________________________
+This routine is based on the TOOLS routine of the same name by J. Chong.
+The major changes are translation to the IRAF pp language, implementation
+of the "G" format, and some restructuring to avoid duplicated code.
+This procedure is called by the more general routine DTOC, which adds the
+additional format type "H" (sexageximal, or hms format).
+
+Formats: f Fixed format. D == number of decimal places. If D
+ is -1 (or less), the "." will not be printed. If the
+ number being printed is too large to fit in F format,
+ "E" format will be used instead. Nonsignificant
+ digits are returned as zeros.
+
+ e Exponential format. D == number of significant digits.
+
+ g General format. D == number of significant digits.
+ The actual format used may be either F or E, depending
+ on which is smaller. If D is negative, the "." will
+ be omitted if possible (abs(D) remains the precision).
+
+If the field width is too small to convert the number, the field will be
+filled with asterisks instead. If the number being converted is INDEF, the
+string "INDEF" will be returned. The number is rounded to the desired precision
+before being printed.
+.endhelp ______________________________________________________________________
+
+# DTOC3 --- Convert double precision real to string.
+
+int procedure dtoc3 (val, out, maxch, decpl, a_fmt, width)
+
+double val # value to be encoded
+char out[ARB] # output string
+int maxch # max chars out
+int decpl # precision
+int a_fmt # type of encoding ('f', 'e', etc.)
+int width # field width
+
+double v
+char digits[MAX_DIGITS]
+bool neg, small, exp_format, squeeze
+int i, w, d, e, j, len, no_digits, max_size, e_size, f_size, fmt
+int itoc(), gstrcpy()
+
+begin
+ # Set flags indicating whether the number is greater or less that zero,
+ # and whether its absolute value is greater or less than 1.
+
+ v = abs (val)
+ w = abs (width)
+
+ fmt = a_fmt
+ if (IS_UPPER(a_fmt))
+ fmt = TO_LOWER(a_fmt)
+ squeeze = (fmt == FMT_GENERAL)
+ neg = (val < 0.0)
+ small = (v < 0.1)
+
+ if (squeeze)
+ d = abs (decpl)
+ else
+ d = max (0, decpl)
+
+ if (IS_INDEFD (val)) # INDEF is a special case
+ return (gstrcpy ("INDEF", out, w))
+
+ # Scale number to 0.1 <= v < 1.0
+ call dtcscl (v, e, 1)
+
+ # Start tally for the maximum size of the number to determine if an
+ # error should be returned.
+ if (neg) # 1 for neg, plus 1 for .
+ max_size = 2
+ else
+ max_size = 1
+ no_digits = min (MAX_DIGITS, d)
+
+
+ # Determine exact format for printing.
+
+ len = abs (e) # base size of E format
+ e_size = 1
+ for (i=10; i <= 10000; i=i*10) {
+ if (len < i)
+ break
+ e_size = e_size + 1
+ }
+ e_size = e_size + max_size + 1
+ if (e < 0)
+ e_size = e_size + 1 # allow space for leading '0'
+
+ if (squeeze) { # G-format: find best format
+ e_size = e_size + d
+ if (e > 0)
+ f_size = max (d, e + 1)
+ else
+ f_size = d - e
+ f_size = f_size + max_size
+ } else if (fmt == FMT_FIXED)
+ f_size = max (e, 1) + max_size + d
+
+
+ if (squeeze) { # 'G' format
+ if (f_size <= e_size) {
+ exp_format = false
+ if (e > 0)
+ no_digits = f_size - max_size
+ max_size = f_size
+ } else {
+ exp_format = true
+ max_size = e_size
+ }
+ d = w # deactivate dec-places count
+
+ } else if (fmt == FMT_FIXED) { # Fortran 'F' format
+ exp_format = f_size > w
+
+ if (exp_format) { # is there too little space?
+ no_digits = max (1, w - e_size)
+ max_size = no_digits + e_size
+ } else {
+ no_digits = e + d + 1 # negative e is OK here
+ max_size = f_size
+ }
+
+ } else { # Fortran 'E' format
+ exp_format = true
+ max_size = e_size + d
+ d = w
+ }
+
+ # Round the number at digit (no_digits + 1).
+ if (no_digits >= 0)
+ v = v + 0.5 * 10. ** (-no_digits)
+
+ # Be sure the number of digits is in range.
+ no_digits = max(1, min(MAX_DIGITS, no_digits))
+
+ # Handle the unusual situation of rounding from .999.. up to 1.000.
+ if (v >= 1.0) {
+ v = v / 10.0
+ e = e + 1
+ if (!exp_format) {
+ max_size = max_size + 1
+ no_digits = min (MAX_DIGITS, no_digits + 1)
+ }
+ }
+
+ # See if the number will fit in 'w' characters
+ if (max_size > w) {
+ for (i=1; i <= w; i=i+1)
+ out[i] = OVFL_CHAR
+ out[i] = EOS
+ return (w)
+ }
+
+ # Extract the first <no_digits> digits. At the start V is normalized
+ # to a value less than 1.0. The algorithm is to multiply by ten and
+ # take the integer part to get each digit.
+
+ do i = 1, no_digits {
+ v = v * 10.0d0
+ j = int (v + EPSILOND) # truncate to integer
+ v = v - j # lop off the integral part
+
+ # Make sure the next iteration will produce a decimal J in the
+ # range 1-9. On some systems, due to precision problems J=int(V)
+ # can be off by one compared to V-J and this will result in a J
+ # of 10 in the next iteration. The expression below attempts to
+ # look ahead for J>=10 and adjusts the J for the current iteration
+ # up by one if this will occur.
+
+ if (int (v * 10.0d0 + EPSILOND) >= 10) {
+ j = j + 1
+ v = v - 1
+ if (v < 0)
+ v = 0
+ }
+
+ digits[i] = TO_DIGIT(j)
+ }
+
+ # Take digit string and exponent and arrange into desired format.
+ len = 1
+ if (neg) {
+ out[1] = '-'
+ len = len + 1
+ }
+
+ if (exp_format) { # set up exponential format
+ out[len] = digits[1]
+ out[len+1] = '.'
+ len = len + 2
+ for (i=2; i <= no_digits; i=i+1) {
+ out[len] = digits[i]
+ len = len + 1
+ }
+ out[len] = 'E'
+ len = len + 1
+ if (e < 0) {
+ out[len] = '-'
+ len = len + 1
+ e = -e
+ }
+ len = len + itoc (e, out[len], w - len + 1)
+
+ } else if (e >= no_digits) {
+ # Handle numbers >= 1 with dp after figures.
+ for (i=1; i <= no_digits; i=i+1) {
+ out[len] = digits[i]
+ len = len + 1
+ }
+ for (i=no_digits; i <= e; i=i+1) {
+ out[len] = '0'
+ len = len + 1
+ }
+ if (decpl > 0) {
+ out[len] = '.'
+ len = len + 1
+ if (!squeeze) {
+ for (i=1; i <= d; i=i+1) {
+ out[len] = '0'
+ len = len + 1
+ }
+ }
+ }
+
+ } else {
+ if (e < 0) {
+ # Handle fixed numbers < 1.
+ if (d == 0 && e == -1 && digits[1] >= '5')
+ out[len] = '1'
+ else
+ out[len] = '0'
+ out[len + 1] = '.'
+ len = len + 2
+ for (i=1; i < -e && d > 0; i=i+1) {
+ out[len] = '0'
+ len = len + 1
+ d = d - 1
+ }
+ i = 1
+ } else {
+ # Handle numbers > 1 with dp inside figures.
+ e = e + 2 # one more zero below
+ for (i=1; i < e; i=i+1) {
+ out[len] = digits[i]
+ len = len + 1
+ }
+ if (decpl > 0) {
+ out[len] = '.'
+ len = len + 1
+ }
+ }
+
+ for (j=1; i <= no_digits && j <= d; j=j+1) {
+ out[len] = digits[i]
+ i = i + 1
+ len = len + 1
+ }
+ if (squeeze) {
+ while (len > 2) { # skip trailing zeroes
+ len = len - 1
+ if (out[len] != '0') {
+ len = len + 1 # non-digit -- keep it
+ break
+ }
+ }
+ } else {
+ for (i=1; i < d+e-no_digits && i <= d; i=i+1) {
+ out[len] = '0'
+ len = len + 1
+ }
+ }
+ }
+
+ out[len] = EOS
+ return (len - 1)
+end
generated by cgit (git 2.34.1) at 2025-09-20 12:49:21 -0400