diff options
Diffstat (limited to 'noao/digiphot/apphot/aplib/apgaperts.x')
| -rw-r--r-- | noao/digiphot/apphot/aplib/apgaperts.x | 214 |
1 files changed, 214 insertions, 0 deletions
diff --git a/noao/digiphot/apphot/aplib/apgaperts.x b/noao/digiphot/apphot/aplib/apgaperts.x new file mode 100644 index 00000000..05558cc1 --- /dev/null +++ b/noao/digiphot/apphot/aplib/apgaperts.x @@ -0,0 +1,214 @@ +include <lexnum.h> +include <ctype.h> + +# AP_GETAPERTS -- Procedure to extract real aperture values from a string + +int procedure ap_getaperts (str, aperts, max_naperts) + +char str[ARB] # string +real aperts[ARB] # number of apertures +int max_naperts # maximum number of apertures + +int fd, naperts +int open(), ap_rdaperts(), ap_decaperts() +errchk open(), close() + +begin + naperts = 0 + + iferr { + fd = open (str, READ_ONLY, TEXT_FILE) + naperts = ap_rdaperts (fd, aperts, max_naperts) + call close (fd) + } then { + naperts = ap_decaperts (str, aperts, max_naperts) + } + + return (naperts) +end + + +# AP_RDAPERTS -- Procedure to read out the apertures listed one per line +# from a file. + +int procedure ap_rdaperts (fd, aperts, max_naperts) + +int fd # aperture list file descriptor +real aperts[ARB] # list of apertures +int max_naperts # maximum number of apertures + +int naperts +pointer sp, line +int getline(), ap_decaperts() + +begin + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + naperts = 0 + while (getline (fd, Memc[line]) != EOF && naperts < max_naperts) { + naperts = naperts + ap_decaperts (Memc[line], aperts[1+naperts], + max_naperts - naperts) + } + + call sfree (sp) + + return (naperts) +end + + +# AP_DECAPERTS -- Procedure to decode the aperture string. + +int procedure ap_decaperts (str, aperts, max_naperts) + +char str[ARB] # aperture string +real aperts[ARB] # aperture array +int max_naperts # maximum number of apertures + +char outstr[SZ_LINE] +int naperts, ip, op, ndecode, nap +real apstart, apend, apstep +bool fp_equalr() +int gctor() + +begin + naperts = 0 + + for (ip = 1; str[ip] != EOS && naperts < max_naperts;) { + + apstart = 0.0 + apend = 0.0 + apstep = 0.0 + ndecode = 0 + + # Skip past white space and commas. + while (IS_WHITE(str[ip])) + ip = ip + 1 + if (str[ip] == ',') + ip = ip + 1 + + # Get the number. + op = 1 + while (IS_DIGIT(str[ip]) || str[ip] == '.') { + outstr[op] = str[ip] + ip = ip + 1 + op = op + 1 + } + outstr[op] = EOS + + # Decode the starting aperture. + op = 1 + if (gctor (outstr, op, apstart) > 0) { + apend = apstart + ndecode = 1 + } else + apstart = 0.0 + + # Skip past white space and commas. + while (IS_WHITE(str[ip])) + ip = ip + 1 + if (str[ip] == ',') + ip = ip + 1 + + # Get the ending aperture + if (str[ip] == ':') { + ip = ip + 1 + + # Get the ending aperture. + op = 1 + while (IS_DIGIT(str[ip]) || str[ip] == '.') { + outstr[op] = str[ip] + ip = ip + 1 + op = op + 1 + } + outstr[op] = EOS + + # Decode the ending aperture. + op = 1 + if (gctor (outstr, op, apend) > 0) { + ndecode = 2 + apstep = apend - apstart + } + } + + # Skip past white space and commas. + while (IS_WHITE(str[ip])) + ip = ip + 1 + if (str[ip] == ',') + ip = ip + 1 + + # Get the step size. + if (str[ip] == ':') { + ip = ip + 1 + + # Get the step size. + op = 1 + while (IS_DIGIT(str[ip]) || str[ip] == '.') { + outstr[op] = str[ip] + ip = ip + 1 + op = op + 1 + } + outstr[op] = EOS + + # Decode the step size. + op = 1 + if (gctor (outstr, op, apstep) > 0) { + if (fp_equalr (apstep, 0.0)) + apstep = apend - apstart + else + ndecode = (apend - apstart) / apstep + 1 + if (ndecode < 0) { + ndecode = -ndecode + apstep = - apstep + } + } + } + + # Negative apertures are not permitted. + if (apstart <= 0.0 || apend <= 0.0) + break + + # Fill in the apertures. + if (ndecode == 0) { + ; + } else if (ndecode == 1) { + naperts = naperts + 1 + aperts[naperts] = apstart + } else if (ndecode == 2) { + naperts = naperts + 1 + aperts[naperts] = apstart + if (naperts >= max_naperts) + break + naperts = naperts + 1 + aperts[naperts] = apend + } else { + for (nap = 1; nap <= ndecode && naperts < max_naperts; + nap = nap + 1) { + naperts = naperts + 1 + aperts[naperts] = apstart + (nap - 1) * apstep + } + } + } + + return (naperts) +end + + +# GCTOR -- Procedure to convert a character variable to a real number. +# This routine is just an interface routine to the IRAF procedure gctod. + +int procedure gctor (str, ip, rval) + +char str[ARB] # string to be converted +int ip # pointer to the string +real rval # real value + +double dval +int nchars +int gctod() + +begin + nchars = gctod (str, ip, dval) + rval = dval + return (nchars) +end |