diff options
Diffstat (limited to 'pkg/images/tv/tvmark/mkgmarks.x')
| -rw-r--r-- | pkg/images/tv/tvmark/mkgmarks.x | 214 |
1 files changed, 214 insertions, 0 deletions
diff --git a/pkg/images/tv/tvmark/mkgmarks.x b/pkg/images/tv/tvmark/mkgmarks.x new file mode 100644 index 00000000..46e9bf05 --- /dev/null +++ b/pkg/images/tv/tvmark/mkgmarks.x @@ -0,0 +1,214 @@ +include <lexnum.h> +include <ctype.h> + +# MK_GMARKS -- Procedure to extract mark values from a string + +int procedure mk_gmarks (str, marks, max_nmarks) + +char str[ARB] # string +real marks[ARB] # number of marks +int max_nmarks # maximum number of marks + +int fd, nmarks +int open(), mk_rdmarks(), mk_decmarks() +errchk open(), close() + +begin + nmarks = 0 + + iferr { + fd = open (str, READ_ONLY, TEXT_FILE) + nmarks = mk_rdmarks (fd, marks, max_nmarks) + call close (fd) + } then { + nmarks = mk_decmarks (str, marks, max_nmarks) + } + + return (nmarks) +end + + +# MK_RDMARKS -- Procedure to read out the marks listed one per line +# from a file. + +int procedure mk_rdmarks (fd, marks, max_nmarks) + +int fd # aperture list file descriptor +real marks[ARB] # list of marks +int max_nmarks # maximum number of apertures + +int nmarks +pointer sp, line +int getline(), mk_decmarks() + +begin + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + nmarks = 0 + while (getline (fd, Memc[line]) != EOF && nmarks < max_nmarks) { + nmarks = nmarks + mk_decmarks (Memc[line], marks[1+nmarks], + max_nmarks - nmarks) + } + + call sfree (sp) + + return (nmarks) +end + + +# MK_DECAPERTS -- Procedure to decode the mark string. + +int procedure mk_decmarks (str, marks, max_nmarks) + +char str[ARB] # aperture string +real marks[ARB] # aperture array +int max_nmarks # maximum number of apertures + +char outstr[SZ_LINE] +int nmarks, ip, op, ndecode, nmk +real mkstart, mkend, mkstep +bool fp_equalr() +int gctor() + +begin + nmarks = 0 + + for (ip = 1; str[ip] != EOS && nmarks < max_nmarks;) { + + mkstart = 0.0 + mkend = 0.0 + mkstep = 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, mkstart) > 0) { + mkend = mkstart + ndecode = 1 + } else + mkstart = 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, mkend) > 0) { + ndecode = 2 + mkstep = mkend - mkstart + } + } + + # 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, mkstep) > 0) { + if (fp_equalr (mkstep, 0.0)) + mkstep = mkend - mkstart + else + ndecode = (mkend - mkstart) / mkstep + 1 + if (ndecode < 0) { + ndecode = -ndecode + mkstep = - mkstep + } + } + } + + # Negative apertures are not permitted. + if (mkstart <= 0.0 || mkend <= 0.0) + break + + # Fill in the apertures. + if (ndecode == 0) { + ; + } else if (ndecode == 1) { + nmarks = nmarks + 1 + marks[nmarks] = mkstart + } else if (ndecode == 2) { + nmarks = nmarks + 1 + marks[nmarks] = mkstart + if (nmarks >= max_nmarks) + break + nmarks = nmarks + 1 + marks[nmarks] = mkend + } else { + for (nmk = 1; nmk <= ndecode && nmarks < max_nmarks; + nmk = nmk + 1) { + nmarks = nmarks + 1 + marks[nmarks] = mkstart + (nmk - 1) * mkstep + } + } + } + + return (nmarks) +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 |