diff options
Diffstat (limited to 'sys/gio/gtickr.x')
| -rw-r--r-- | sys/gio/gtickr.x | 192 |
1 files changed, 192 insertions, 0 deletions
diff --git a/sys/gio/gtickr.x b/sys/gio/gtickr.x new file mode 100644 index 00000000..cd227363 --- /dev/null +++ b/sys/gio/gtickr.x @@ -0,0 +1,192 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + +# GTICK -- Determine the best number and placement of ticks for the interval +# [x1:x2]. If log scaling is in use we try to put the ticks at positions which +# are 1.0 times some power of ten, otherwise we divide the interval an integral +# number of times and place the ticks at the interval boundaries. The basic +# algorithm is simple, but implementation is tricky due to the quirks of +# floating point computations and the desire to have the algorithm work for all +# X, and all ranges of X. For example, we might want to plot a large range +# near zero, or a small range where both X1 and X2 have a very large exponent. +# +# N.B.: this is a generic source; it may be preprocessed with the IRAF "generic" +# preprocessor to produce either a single or double precision SPP source file. + +procedure gtickr (x1, x2, rough_nticks, logflag, x_tick1, step) + +real x1, x2 # range for which ticks are desired +int rough_nticks # approximate number of ticks desired +int logflag # nonzero if log scaling in use +real x_tick1 # x coord of first tick (output) +real step # tick spacing along X (output) + +real x, tol +int ndiv +int log +#int nticks +int expon +real gt_distance() + +begin + log = logflag + tol = EPSILONR * 10.0 + + # If log, decrease ndiv until an x of 1.0 is obtained. If an x of 1.0 + # cannot be produced, repeat the calculation once more with ndiv fixed. + + repeat { + ndiv = max (1, rough_nticks - 1) + + repeat { + if (log == YES) + x = 1.0 + else + x = abs ((x2 - x1) / ndiv) + + # Scale approximate tick spacing to the range [1-10). Select + # a logical tick spacing, given calculated and scaled spacing. + + call fp_normr (x, x, expon) + if (x < 1.5) + x = 1.0 + else if (x < 2.5) + x = 2.0 + else if (x < 4.0) + x = 2.5 + else if (x < 7.5) + x = 5.0 + else { + x = 1.0 + expon = expon + 1 + } + + # Calculate the first tick and the tick increment (step size). + if (log == YES) + step = 1.0 + else + step = x * (10.0 ** expon) + + if (gt_distance (x1, step, x_tick1) / step < tol) + # x_tick1 = x1 + else if (x1 < x2 && x_tick1 < x1) + x_tick1 = x_tick1 + step + else if (x1 > x2 && x_tick1 > x1) + x_tick1 = x_tick1 - step + + if (x1 > x2) + step = -step + ndiv = ndiv - 1 + + } until (abs(abs(x) - 1.0) < tol || log == NO || ndiv == 0) + + # Terminate if not in log mode, if the tick separation is a power + # of ten and there are ndivisions tick marks, or if the tick + # separation is one magnitude and there are at least two tick marks + # within the range x1:x2. + + # if (log == NO) { + # return + # } else if (step == 1.0 || x == 1.0) { + # if (step == 1.0) + # nticks = 1 + # else + # nticks = max (2, rough_nticks - 1) + + # if (x1 > x2 && x_tick1 + nticks * step >= x2) + # return + # else if (x1 < x2 && x_tick1 + nticks * step <= x2) + # return + # else + # log = NO + # } else + # log = NO + + return + } +end + + +# GT_NDIGITS -- Calculate the number of digits of precision needed to label +# ticks in the range x1 to x2 (i.e., if x1=100000 and x2=100001, 7 digits +# will be required, whereas in many cases 1 or 2 is enough). + +int procedure gt_ndigits (x1, x2, step) + +real x1, x2 # range covered by numbers +real step # tick separation +real ratio +int n + +begin + if (x1 == x2) + n = 2 + else { + ratio = abs ((x1+x2) / (x1-x2)) + n = log10 (max (1.0, ratio)) + 2.0 + } + + return (n) +end + + +# GT_LINEARITY -- The following function returns a large number if there is +# little difference between a log scale and a linear scale for the range X1 +# to X2. if the linearity of the interval is large, there is no point in +# using a logarithmic scale. + +real procedure gt_linearity (x1, x2) + +real x1, x2 +real linearity, difflog +real elogr() + +begin + if (x1 <= 0 || x2 <= 0) + difflog = abs (elogr(x1) - elogr(x2)) + else + difflog = abs (log10(x1) - log10(x2)) + + if (difflog == 0.0) + linearity = 1E10 + else + linearity = 1.0 / difflog + + return (linearity) +end + + +# GT_DISTANCE -- Compute the distance of X from the nearest integral multiple +# of "step". + +real procedure gt_distance (x, step, nearest_tick) + +real x # number to be tested +real step # tick separation +real nearest_tick # X coord of tick nearest X + +real ltick, rtick, absx +real fp_fixr() + +begin + absx = abs (x) + + ltick = fp_fixr (absx / step) * step + rtick = ltick + step + + if (abs(absx - ltick) < abs(rtick - absx)) { + if (x < 0) + nearest_tick = -ltick + else + nearest_tick = ltick + return (absx - ltick) + + } else { + if (x < 0) + nearest_tick = -rtick + else + nearest_tick = rtick + return (rtick - absx) + } +end |