diff options
Diffstat (limited to 'pkg/dataio/imtext')
| -rw-r--r-- | pkg/dataio/imtext/imtext.h | 21 | ||||
| -rw-r--r-- | pkg/dataio/imtext/mkpkg | 19 | ||||
| -rw-r--r-- | pkg/dataio/imtext/putcplx.x | 88 | ||||
| -rw-r--r-- | pkg/dataio/imtext/putint.x | 160 | ||||
| -rw-r--r-- | pkg/dataio/imtext/putreal.x | 88 | ||||
| -rw-r--r-- | pkg/dataio/imtext/rt_cvtpix.x | 115 | ||||
| -rw-r--r-- | pkg/dataio/imtext/rt_rheader.x | 170 | ||||
| -rw-r--r-- | pkg/dataio/imtext/rt_rwpix.x | 271 | ||||
| -rw-r--r-- | pkg/dataio/imtext/t_rtextimage.x | 109 | ||||
| -rw-r--r-- | pkg/dataio/imtext/t_wtextimage.x | 261 | ||||
| -rw-r--r-- | pkg/dataio/imtext/wtextimage.semi | 91 | ||||
| -rw-r--r-- | pkg/dataio/imtext/wti_wheader.x | 152 |
12 files changed, 1545 insertions, 0 deletions
diff --git a/pkg/dataio/imtext/imtext.h b/pkg/dataio/imtext/imtext.h new file mode 100644 index 00000000..76506eda --- /dev/null +++ b/pkg/dataio/imtext/imtext.h @@ -0,0 +1,21 @@ +# Definitions used for conversions between text files and IRAF images. +# Both tasks rtextimage and wtextimage include this file. + +define LEN_WT (2+20+20) + +define IRAFTYPE Memc[P2C($1)] +define FORM Memc[P2C($1+20)] + +define UNSET 0 # Flag for unitialized header values +define INT_FORM 1 # Text file pixels written as integers +define FP_FORM 2 # Text file pixels written as floating point +define CPX_FORM 3 # Text file pixels written as complex + +define COL_VALUE 11 # Starting column for FITS keyword values +define LEN_CARD 80 +define SZ_STRING 20 +define MAX_LENTEXT (2*SZ_LINE) +define NFITS_LINES 10 +define NCARDS_FITS_BLK 36 +define LEN_STRING 18 +define LEN_KEYWORD 8 diff --git a/pkg/dataio/imtext/mkpkg b/pkg/dataio/imtext/mkpkg new file mode 100644 index 00000000..8cabe34c --- /dev/null +++ b/pkg/dataio/imtext/mkpkg @@ -0,0 +1,19 @@ +# The image to text file conversion program WTEXTIMAGE makes the following +# contributions to the dataio package library: + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + putcplx.x <imhdr.h> <mach.h> + putint.x <imhdr.h> <mach.h> <ctype.h> + putreal.x <imhdr.h> <mach.h> + wti_wheader.x imtext.h <imhdr.h> <mach.h> <imio.h> + t_wtextimage.x imtext.h <imhdr.h> <mach.h> <ctype.h> <fset.h> <error.h> + rt_rheader.x imtext.h <imhdr.h> <imio.h> + rt_cvtpix.x imtext.h <imhdr.h> + rt_rwpix.x imtext.h <imhdr.h> <ctype.h> + t_rtextimage.x imtext.h <imhdr.h> <error.h> + ; diff --git a/pkg/dataio/imtext/putcplx.x b/pkg/dataio/imtext/putcplx.x new file mode 100644 index 00000000..df498479 --- /dev/null +++ b/pkg/dataio/imtext/putcplx.x @@ -0,0 +1,88 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> + +# WTI_PUTCOMPLEX -- Output pixels to a text file in complex floating format. +# Pixels are output in storage order for images of any dimension (leftmost +# subscript varying fastest). We do not bother to implement a different +# datapath for each image pixel datatype because the execution time is +# entirely dominated by the binary to character conversion, and because we +# need type complex pixels for XTOC anyhow. + +procedure wti_putcomplex (im, tx, maxll, decpl, fmtchar, width) + +pointer im # pointer to image file +int tx # file descriptor of output text file +int maxll # maximum length of output text line +int decpl # number of decimal places of precision +int fmtchar # format character (efg) +int width # field width of each number (0=free format) + +char numbuf[MAX_DIGITS] +int npix, ip, j, ndigits, nspaces, maxch +pointer sp, obuf, op, pix, cp +long v[IM_MAXDIM] +int imgnlx(), xtoc() +errchk imgnlx, putline + +begin + call smark (sp) + call salloc (obuf, maxll+1, TY_CHAR) + + call amovkl (long(1), v, IM_MAXDIM) + npix = IM_LEN(im,1) + op = obuf + + while (imgnlx (im, pix, v) != EOF) { + do j = 1, npix { + # Encode the number. + if (width <= 0) + maxch = MAX_DIGITS + else + maxch = width + + ndigits = xtoc (Memx[pix+j-1], numbuf, MAX_DIGITS, + decpl, fmtchar, maxch) + + # Determine the number of spaces needed to right justify the + # field. If the field width is zero the output is free format + # and we always output a single space. + + if (width <= 0) + nspaces = 1 + else + nspaces = width - ndigits + + # Break the output line if insufficient space remains on the + # line. + + if (op-obuf + ndigits + nspaces > maxll) { + Memc[op] = '\n' + Memc[op+1] = EOS + call putline (tx, Memc[obuf]) + op = obuf + } + + # Append sufficient blanks to right justify the number in + # the given field. + do cp = op, op + nspaces - 1 + Memc[cp] = ' ' + op = op + nspaces + + # Append the number to the output line. + do ip = 1, ndigits + Memc[op+ip-1] = numbuf[ip] + op = op + ndigits + } + } + + # Break the last line if there is anything on it. + if (op > obuf) { + Memc[op] = '\n' + Memc[op+1] = EOS + call putline (tx, Memc[obuf]) + } + + call sfree (sp) +end diff --git a/pkg/dataio/imtext/putint.x b/pkg/dataio/imtext/putint.x new file mode 100644 index 00000000..a98d3fb5 --- /dev/null +++ b/pkg/dataio/imtext/putint.x @@ -0,0 +1,160 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include <ctype.h> + +# WTI_PUTINT -- Output pixels to a text file in integer format. Pixels are +# output in storage order for images of any dimension (leftmost subscript +# varying fastest). + +procedure wti_putint (im, tx, maxll, width) + +pointer im # pointer to image file +int tx # file descriptor of output text file +int maxll # maximum length of output text line +int width # field width of each number (0=free format) + +char numbuf[MAX_DIGITS] +int npix, ip, j, ndigits +pointer sp, obuf, op, pix +long v[IM_MAXDIM] +int imgnll(), ltoc() +errchk imgnll, putline + +begin + call smark (sp) + call salloc (obuf, maxll+1, TY_CHAR) + + call amovkl (long(1), v, IM_MAXDIM) + npix = IM_LEN(im,1) + op = obuf + + if (width <= 0) { + # If the encoding is free format call LTOC to encode the number, + # compute the number of spaces required to right justify the + # numeric string in the specified field width, then move the + # spaces and the number into the output line. + + while (imgnll (im, pix, v) != EOF) { + do j = 1, npix { + # Encode the number. + ndigits = ltoc (Meml[pix+j-1], numbuf, MAX_DIGITS) + + # Break output line if insufficient space remains. + if (op-obuf + ndigits + 1 > maxll) { + Memc[op] = '\n' + Memc[op+1] = EOS + call putline (tx, Memc[obuf]) + op = obuf + } + + # Append a blank and the number to the output line. + if (op > obuf) { + Memc[op] = ' ' + op = op + 1 + } + do ip = 1, ndigits + Memc[op+ip-1] = numbuf[ip] + op = op + ndigits + } + } + + } else { + # Fixed format. Encode the integer number from right to left + # in the given field, blank filling at the left. Note that + # fancy formats such as left justify or zero fill are not + # presently supported (and are probably not worth it here). + + while (imgnll (im, pix, v) != EOF) { + do j = 1, npix { + # Break output line if insufficient space remains. + if (op-obuf + width > maxll) { + Memc[op] = '\n' + Memc[op+1] = EOS + call putline (tx, Memc[obuf]) + op = obuf + } + + # Encode the number in the output field. + call wti_encode_l (Meml[pix+j-1], Memc[op], width) + op = op + width + } + } + } + + # Break the last line if there is anything on it. + if (op > obuf) { + Memc[op] = '\n' + Memc[op+1] = EOS + call putline (tx, Memc[obuf]) + } + + call sfree (sp) +end + + +# WTI_ENCODE_L -- Encode a long integer number as a decimal integer, right +# justified with blank fill in the indicated field. Since we know the field +# width in advance we can encode the number from right to left (least +# significant digits first), without having to reverse the digits and copy +# the string as is the case with LTOC. +procedure wti_encode_l (lval, out, w) + +long lval # number to be encoded +char out[w] # output field (NOT EOS DELIMITED) +int w # field width + +bool neg +int op, i +long val, quotient +define overflow_ 91 + +begin + if (IS_INDEFL (lval)) { + if (w < 5) + goto overflow_ + call amovc ("INDEF", out[w-4], 5) + op = w - 5 + + } else { + neg = (lval < 0) + if (neg) + val = -lval + else + val = lval + + # Output digits from right to left. + do i = w, 1, -1 { + quotient = val / 10 + out[i] = TO_DIGIT (val - quotient * 10) + val = quotient + if (val == 0) { + op = i - 1 + break + } + } + + # Add minus sign if negative. + if (neg) { + if (op > 0) + out[op] = '-' + op = op - 1 + } + + # Check for overflow. + if (op < 0 || val > 0) + goto overflow_ + } + + # Blank fill at left. + do i = op, 1, -1 + out[i] = ' ' + + return + +overflow_ + # Number was too large to fit in the given field width. + do i = 1, w + out[i] = '*' +end diff --git a/pkg/dataio/imtext/putreal.x b/pkg/dataio/imtext/putreal.x new file mode 100644 index 00000000..217a45aa --- /dev/null +++ b/pkg/dataio/imtext/putreal.x @@ -0,0 +1,88 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> + +# WTI_PUTREAL -- Output pixels to a text file in a floating point format. +# Pixels are output in storage order for images of any dimension (leftmost +# subscript varying fastest). We do not bother to implement a different +# datapath for each image pixel datatype because the execution time is +# entirely dominated by the binary to character conversion, and because we +# need type double pixels for DTOC anyhow. + +procedure wti_putreal (im, tx, maxll, decpl, fmtchar, width) + +pointer im # pointer to image file +int tx # file descriptor of output text file +int maxll # maximum length of output text line +int decpl # number of decimal places of precision +int fmtchar # type of encoding (efg) +int width # field width of each number (0=free format) + +char numbuf[MAX_DIGITS] +int npix, ip, j, ndigits, nspaces, maxch +pointer sp, obuf, op, pix, cp +long v[IM_MAXDIM] +int imgnld(), dtoc() +errchk imgnld, putline + +begin + call smark (sp) + call salloc (obuf, maxll+1, TY_CHAR) + + call amovkl (long(1), v, IM_MAXDIM) + npix = IM_LEN(im,1) + op = obuf + + while (imgnld (im, pix, v) != EOF) { + do j = 1, npix { + # Encode the number. + if (width <= 0) + maxch = MAX_DIGITS + else + maxch = width + + ndigits = dtoc (Memd[pix+j-1], numbuf, MAX_DIGITS, + decpl, fmtchar, maxch) + + # Determine the number of spaces needed to right justify the + # field. If the field width is zero the output is free format + # and we always output a single space. + + if (width <= 0) + nspaces = 1 + else + nspaces = width - ndigits + + # Break the output line if insufficient space remains on the + # line. + + if (op-obuf + ndigits + nspaces > maxll) { + Memc[op] = '\n' + Memc[op+1] = EOS + call putline (tx, Memc[obuf]) + op = obuf + } + + # Append sufficient blanks to right justify the number in + # the given field. + do cp = op, op + nspaces - 1 + Memc[cp] = ' ' + op = op + nspaces + + # Append the number to the output line. + do ip = 1, ndigits + Memc[op+ip-1] = numbuf[ip] + op = op + ndigits + } + } + + # Break the last line if there is anything on it. + if (op > obuf) { + Memc[op] = '\n' + Memc[op+1] = EOS + call putline (tx, Memc[obuf]) + } + + call sfree (sp) +end diff --git a/pkg/dataio/imtext/rt_cvtpix.x b/pkg/dataio/imtext/rt_cvtpix.x new file mode 100644 index 00000000..170a26d4 --- /dev/null +++ b/pkg/dataio/imtext/rt_cvtpix.x @@ -0,0 +1,115 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "imtext.h" + +# RT_CONVERT_PIXELS -- Called once for each text file to be converted. All +# pixels in the text file are converted to image pixels. + +procedure rt_convert_pixels (tf, im, format, pixels) + +int tf # File descriptor of input text file +pointer im # Pointer to image header +int format # Format of text pixels (integer/floating point) +int pixels # Get pixels from input text file? + +pointer bufptr, sp, word1, pattern +int stat, nlines, npix, i +long v[IM_MAXDIM], start +int impnll(), impnld(), impnlx() +int fscan(), stridxs(), patmatch(), patmake() +long note() + +errchk impnll, impnld, impnlx +errchk rt_get_lineptr, rt_output_line, fscan, seek, amovkl + +begin + # Determine if text file pixels were written with an integer, complex + # or floating point format. This information may have been already + # determined from the header. If not, the first pixel is read + # from text file. If it contains a decimal point, the character E, + # or a + or - sign not in the first position, it is a floating point + # number. Complex numbers are assumed to be written as "(r,i)". + + if (pixels == YES && format == UNSET) { + call smark (sp) + call salloc (word1, SZ_LINE, TY_CHAR) + call salloc (pattern, SZ_LINE, TY_CHAR) + + # Note position so we can return to it + start = note (tf) + + stat = fscan (tf) + call gargwrd (Memc[word1], SZ_LINE) + if (patmake ("[DdEe]", Memc[pattern], SZ_LINE) == ERR) + call error (7, "Error creating format pattern") + + if (stridxs ("(", Memc[word1]) > 0) + format = CPX_FORM + else if (stridxs (".", Memc[word1]) > 0) + format = FP_FORM + else if (patmatch (Memc[word1], Memc[pattern]) > 0) + format = FP_FORM + else if (stridxs ("+", Memc[word1]) > 1) + format = FP_FORM + else if (stridxs ("-", Memc[word1]) > 1) + format = FP_FORM + else + format = INT_FORM + + call sfree (sp) + call seek (tf, start) + } + + # Pixel type may not have been set by this point either... + if (IM_PIXTYPE(im) == UNSET) { + switch (format) { + case FP_FORM: + IM_PIXTYPE(im) = TY_REAL + case INT_FORM: + IM_PIXTYPE(im) = TY_INT + case CPX_FORM: + IM_PIXTYPE(im) = TY_COMPLEX + default: + call error (0, "Unrecognized format type") + } + } + + nlines = 1 + do i = 2, IM_NDIM(im) + nlines = nlines * IM_LEN (im, i) + call amovkl (long(1), v, IM_MAXDIM) + npix = IM_LEN (im, 1) + + # Initialize text buffer + call rt_rinit + + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_INT, TY_USHORT, TY_LONG: + do i = 1, nlines { + stat = impnll (im, bufptr, v) + if (pixels == YES) + call rt_output_linel (tf, format, bufptr, npix) + else + call aclrl (Meml[bufptr], npix) + } + case TY_REAL, TY_DOUBLE: + do i = 1, nlines { + stat = impnld (im, bufptr, v) + if (pixels == YES) + call rt_output_lined (tf, format, bufptr, npix) + else + call aclrd (Memd[bufptr], npix) + } + case TY_COMPLEX: + do i = 1, nlines { + stat = impnlx (im, bufptr, v) + if (pixels == YES) + call rt_output_linex (tf, format, bufptr, npix) + else + call aclrx (Memx[bufptr], npix) + } + default: + call error (0, "Image pixel type unset") + } +end diff --git a/pkg/dataio/imtext/rt_rheader.x b/pkg/dataio/imtext/rt_rheader.x new file mode 100644 index 00000000..9c4323bf --- /dev/null +++ b/pkg/dataio/imtext/rt_rheader.x @@ -0,0 +1,170 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imio.h> +include "imtext.h" + +# RT_RHEADER -- read FITS header, saving the image dimension information in +# the image header. The format (integer/floating point) is returned. + +procedure rt_rheader (tf, im, format) + +int tf # File descriptor for input text file +pointer im # Pointer to image header +int format # Format of text file pixels (integer/floating point) + +pointer sp, wt, card +bool streq() +int ncard, fd_user, max_lenuser +int getline(), rt_decode_card(), stridxs(), strlen(), stropen() +errchk getline, rt_decode_card + +begin + call smark (sp) + call salloc (wt, LEN_WT, TY_STRUCT) + call salloc (card, LEN_CARD+1, TY_CHAR) + + Memc[card+LEN_CARD] = '\n' + Memc[card+LEN_CARD+1] = EOS + + # Prepare user area string to be written + max_lenuser = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1 + fd_user = stropen (Memc[IM_USERAREA(im)], max_lenuser, NEW_FILE) + + ncard = 1 + repeat { + if (getline (tf, Memc[card]) == EOF) + call error (2, "RT_RHEADER: EOF encountered before END card") + + ncard = ncard + 1 + if (rt_decode_card (wt, im, fd_user, Memc[card]) == YES) + break + } + + # Encountered END card; examine a few header keyword values. From + # the FORMAT keyword, determine if the pixel values are written as + # integers, floating point numbers or complex numbers. + + if (strlen (FORM(wt)) > 0) { + if (stridxs ("I", FORM(wt)) > 0) + format = INT_FORM + else if (stridxs ("(", FORM(wt)) > 0) + format = CPX_FORM + else + format = FP_FORM + } else + format = UNSET + + # The image pixel type is set by the IRAFTYPE keyword value. + + if (streq (IRAFTYPE(wt), "SHORT INTEGER")) + IM_PIXTYPE (im) = TY_SHORT + else if (streq (IRAFTYPE(wt), "UNSIGNED SHORT INT")) + IM_PIXTYPE (im) = TY_USHORT + else if (streq (IRAFTYPE(wt), "INTEGER")) + IM_PIXTYPE (im) = TY_INT + else if (streq (IRAFTYPE(wt), "LONG INTEGER")) + IM_PIXTYPE (im) = TY_LONG + else if (streq (IRAFTYPE(wt), "REAL FLOATING")) + IM_PIXTYPE (im) = TY_REAL + else if (streq (IRAFTYPE(wt), "DOUBLE FLOATING")) + IM_PIXTYPE (im) = TY_DOUBLE + else if (streq (IRAFTYPE(wt), "COMPLEX")) + IM_PIXTYPE (im) = TY_COMPLEX + + call close (fd_user) + call sfree (sp) +end + + +# RT_DECODE_CARD -- Decode a FITS format card and return YES when the END +# card is encountered. The decoded value is stored in the image header, +# or in the user area if there is no other place for it. The END card is +# tested only to the first three characters; strictly speaking the END +# card begins with the 8 characters "END ". + +int procedure rt_decode_card (wt, im, fd, card) + +pointer wt # Pointer to wtextimage keyword structure +pointer im # Pointer to image header being written +int fd # File descriptor of user area +char card[ARB] # Card image read from FITS header + +int nchar, ival, i, j, k, ndim + +int strmatch(), ctoi() +errchk rt_get_fits_string, putline, putline + +begin + + i = COL_VALUE + if (strmatch (card, "^END") > 0) + return (YES) + + else if (strmatch (card, "^NAXIS ") > 0) { + nchar = ctoi (card, i, ndim) + if (ndim > 0) + IM_NDIM(im) = ndim + + } else if (strmatch (card, "^NAXIS") > 0) { + k = strmatch (card, "^NAXIS") + nchar = ctoi (card, k, j) + nchar = ctoi (card, i, IM_LEN(im,j)) + + } else if (strmatch (card, "^NDIM ") > 0) + nchar = ctoi (card, i, IM_NDIM(im)) + + else if (strmatch (card, "^LEN") > 0) { + k = strmatch (card, "^LEN") + nchar = ctoi (card, k, j) + nchar = ctoi (card, i, IM_LEN(im,j)) + + } else if (strmatch (card, "^BITPIX ") > 0) { + nchar = ctoi (card, i, ival) + if (ival != 8) + call error (6, "Not 8-bit ASCII characters") + + } else if (strmatch (card, "^FORMAT ") > 0) { + call rt_get_fits_string (card, FORM(wt), SZ_STRING) + } else if (strmatch (card, "^IRAFTYPE") > 0) { + call rt_get_fits_string (card, IRAFTYPE(wt), SZ_STRING) + } else if (strmatch (card, "^OBJECT ") > 0) { + call rt_get_fits_string (card, IM_TITLE(im), SZ_IMTITLE) + } else { + # Putline returns an error if there is no room in the user area + iferr (call putline (fd, card)) { + call eprintf ("Space in user area has been exceeded\n") + return (YES) + } + } + + return (NO) +end + + +# RT_GET_FITS_STRING -- Extract a string from a FITS card and trim trailing +# blanks. The EOS is marked by either ', /, or the end of the card. +# There may be an optional opening ' (FITS standard). + +procedure rt_get_fits_string (card, str, maxchar) + +char card[ARB] # Input card image containing keyword and value +char str[maxchar] # Output string +int maxchar # Maximum number of characters output +int j, istart, nchar + +begin + # Check for opening quote + if (card[COL_VALUE] == '\'') + istart = COL_VALUE + 1 + else + istart = COL_VALUE + + for (j=istart; (j < LEN_CARD) && (card[j] != '\''); j=j+1) + ; + for (j=j-1; (j >= istart) && (card[j] == ' '); j=j-1) + ; + + nchar = min (maxchar, j - istart + 1) + call strcpy (card[istart], str, nchar) +end diff --git a/pkg/dataio/imtext/rt_rwpix.x b/pkg/dataio/imtext/rt_rwpix.x new file mode 100644 index 00000000..a3ba26bf --- /dev/null +++ b/pkg/dataio/imtext/rt_rwpix.x @@ -0,0 +1,271 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <ctype.h> +include "imtext.h" + +# RT_RINIT -- Initialize buffer and buffer pointer for reading text. + +procedure rt_rinit () + +int ip +char text_buf[SZ_LINE] +common /rpix_init/ ip, text_buf + +begin + ip = 1 + text_buf[1] = EOS +end + + +# RT_OUTPUT_LINEL -- Put line of long pixels to image from text file. + +procedure rt_output_linel (tf, format, bufptr, npix) + +int tf # File descriptor for input text file +int format # Format of pixels in text file (integer/ floating) +pointer bufptr # Pointer to image line to be filled +int npix # Number of pixels per image line + +pointer sp, dbl_buf, cplx_buf +errchk rt_ripixels, rt_rfpixels, rt_rcpixels + +begin + call smark (sp) + + switch (format) { + case INT_FORM: + call salloc (dbl_buf, npix, TY_DOUBLE) + call rt_ripixels (tf, Memd[dbl_buf], npix) + call achtdl (Memd[dbl_buf], Meml[bufptr], npix) + case FP_FORM: + call salloc (dbl_buf, npix, TY_DOUBLE) + call rt_rfpixels (tf, Memd[dbl_buf], npix) + call achtdl (Memd[dbl_buf], Meml[bufptr], npix) + case CPX_FORM: + call salloc (cplx_buf, npix, TY_COMPLEX) + call rt_rcpixels (tf, Memx[cplx_buf], npix) + call achtxl (Memx[cplx_buf], Meml[bufptr], npix) + } + + call sfree (sp) +end + + +# RT_OUTPUT_LINED -- Put line of double pixels to image from text file. + +procedure rt_output_lined (tf, format, bufptr, npix) + +int tf # File descriptor for input text file +int format # Format of pixels in text file (integer/ floating) +pointer bufptr # Pointer to image line to be filled +int npix # Number of pixels per image line + +pointer sp, cplx_buf +errchk rt_ripixels, rt_rfpixels, rt_rcpixels + +begin + call smark (sp) + + switch (format) { + case INT_FORM: + call rt_ripixels (tf, Memd[bufptr], npix) + case FP_FORM: + call rt_rfpixels (tf, Memd[bufptr], npix) + case CPX_FORM: + call salloc (cplx_buf, npix, TY_COMPLEX) + call rt_rcpixels (tf, Memx[cplx_buf], npix) + call achtxd (Memx[cplx_buf], Memd[bufptr], npix) + } + + call sfree (sp) +end + + +# RT_OUTPUT_LINEX -- Put line of complex pixels to image from text file. + +procedure rt_output_linex (tf, format, bufptr, npix) + +int tf # File descriptor for input text file +int format # Format of pixels in text file (integer/ floating) +pointer bufptr # Pointer to image line to be filled +int npix # Number of pixels per image line + +pointer sp, dbl_buf +errchk rt_ripixels, rt_rfpixels, rt_rcpixels + +begin + call smark (sp) + + switch (format) { + case INT_FORM: + call salloc (dbl_buf, npix, TY_DOUBLE) + call rt_ripixels (tf, Memd[dbl_buf], npix) + call achtdx (Memd[dbl_buf], Memx[bufptr], npix) + case FP_FORM: + call salloc (dbl_buf, npix, TY_DOUBLE) + call rt_rfpixels (tf, Memd[dbl_buf], npix) + call achtdx (Memd[dbl_buf], Memx[bufptr], npix) + case CPX_FORM: + call rt_rcpixels (tf, Memx[bufptr], npix) + } + + call sfree (sp) +end + + +# RT_RIPIXELS -- read integer pixels free format from text file into a +# type double real buffer. + +procedure rt_ripixels (tf, dbl_out, npix) + +int tf # File descriptor for input text file +double dbl_out[ARB] # Output pixel array +int npix # Number of pixels to output + +bool neg +int i, sum, ip_start, ip +char text_buf[SZ_LINE] +common /rpix_init/ ip, text_buf +int getline() +errchk getline + +begin + # Read values until satisfied + for (i=0; i < npix; ) { + sum = 0 + + # Position to first non white space character + while (IS_WHITE (text_buf[ip])) + ip = ip + 1 + ip_start = ip + + neg = (text_buf[ip] == '-') + if (neg) + ip = ip + 1 + + while (IS_DIGIT (text_buf[ip])) { + sum = sum * 10 + TO_INTEG (text_buf[ip]) + ip = ip + 1 + } + + if (ip == ip_start) { + if (getline (tf, text_buf) == EOF) { + call eprintf ("Premature EOF seen by rt_ripixels\n") + break + } + ip = 1 + + } else { + i = i + 1 + if (neg) + dbl_out[i] = double (-sum) + else + dbl_out[i] = double ( sum) + } + } +end + + +# RT_RFPIXELS -- read floating point pixels free format from text file into a +# double floating point buffer. + +procedure rt_rfpixels (tf, dbl_out, npix) + +int tf # File descriptor for text file +double dbl_out[npix] # Output pixel buffer +int npix # Number of pixels to output + +int i, nchars +double dval +int gctod(), getline() + +int ip +char text_buf[SZ_LINE] +common /rpix_init/ ip, text_buf +errchk gctod, getline + +begin + # Read values until satisfied + for (i=0; i < npix; ) { + nchars = gctod (text_buf, ip, dval) + + if (nchars == 0) { + if (getline (tf, text_buf) == EOF) { + call eprintf ("Premature EOF seen in rt_rfpixels\n") + break + } + ip = 1 + + } else { + i = i + 1 + dbl_out[i] = dval + } + } +end + + +# RT_RCPIXELS -- read complex pixels free format from text file into a +# complex floating point buffer. + +procedure rt_rcpixels (tf, cplx_out, npix) + +int tf # File descriptor for text file +complex cplx_out[npix] # Output pixel buffer +int npix # Number of pixels to output + +int i, nchars +complex xval +int gctox(), getline() + +int ip +char text_buf[SZ_LINE] +common /rpix_init/ ip, text_buf +errchk gctox, getline + +begin + # Read values until satisfied + for (i=0; i < npix; ) { + nchars = gctox (text_buf, ip, xval) + + if (nchars == 0) { + if (getline (tf, text_buf) == EOF) { + call eprintf ("Premature EOF seen in rt_rcpixels\n") + break + } + ip = 1 + + } else { + i = i + 1 + cplx_out[i] = xval + } + } +end + + +# RT_SKIP_LINES -- Skip lines of text file. + +int procedure rt_skip_lines (tf, nskip) + +int tf # File descriptor of text file +int nskip # Number of lines to skip + +pointer sp, buffer +int i +int fscan() + +begin + call smark (sp) + call salloc (buffer, SZ_LINE, TY_CHAR) + + for (i = 1; i <= nskip; i = i + 1) { + if (fscan (tf) == EOF) { + call sfree (sp) + return (EOF) + } else + call gargstr (Memc[buffer], SZ_LINE) + } + + call sfree (sp) + return (OK) +end diff --git a/pkg/dataio/imtext/t_rtextimage.x b/pkg/dataio/imtext/t_rtextimage.x new file mode 100644 index 00000000..603e9134 --- /dev/null +++ b/pkg/dataio/imtext/t_rtextimage.x @@ -0,0 +1,109 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> +include "imtext.h" + +# T_RTEXTIMAGE -- Read text files into IRAF images. Information +# about the dimensionality of the image (the number of dimensions and the +# length of each dimension) must either be read from a FITS header or supplied +# by the user. + +procedure t_rtextimage () + +char output[SZ_FNAME], text_file[SZ_FNAME], temp[SZ_FNAME] +char out_fname[SZ_FNAME] +pointer im +int header, pixels, nskip, nfiles, ntext, format, data_type, tf, i, input +int fd_dim, junk, ndim, ip + +bool clgetb() +#char clgetc() +pointer immap() +int btoi(), clgeti(), clpopni(), clplen(), clgfil(), get_data_type() +int open(), rt_skip_lines(), clpopnu(), ctoi() + +begin + # Determine the input and output file names + input = clpopni ("input") + call clgstr ("output", output, SZ_FNAME) + + # Get hidden parameters from cl. + # data_type = get_data_type (clgetc ("otype")) + call clgstr ("otype", out_fname, SZ_FNAME) + data_type = get_data_type (out_fname[1]) + header = btoi (clgetb ("header")) + pixels = btoi (clgetb ("pixels")) + if (header == NO) + nskip = clgeti ("nskip") + + # Loop over the input files, generating an output name and processing. + nfiles = clplen (input) + do ntext = 1, nfiles { + if (clgfil (input, text_file, SZ_FNAME) == EOF) + return + tf = open (text_file, READ_ONLY, TEXT_FILE) + if (nfiles > 1) { + call sprintf (out_fname, SZ_FNAME, "%s.%03d") + call pargstr (output) + call pargi (ntext) + } else + call strcpy (output, out_fname, SZ_FNAME) + + im = immap (out_fname, NEW_IMAGE, 0) + + # Initialize those values that could be read from the header. + format = UNSET + IM_NDIM(im) = UNSET + IM_PIXTYPE(im) = UNSET + + if (header == YES) { + iferr (call rt_rheader (tf, im, format)) + call erract (EA_FATAL) + } else if (nskip > 0) { + if (rt_skip_lines (tf, nskip) == EOF) + call error (1, "Unexpected EOF when skipping lines") + } + + # Get data_type of output image. If supplied by user, use parameter + # value over anything read from FITS header. + + if (IM_PIXTYPE(im) == UNSET) { + # Not read from header, use parameter value if supplied. + # Otherwise, wait until pixels are read to set pixel type. + if (data_type == ERR) + IM_PIXTYPE(im) = UNSET + else + IM_PIXTYPE(im) = data_type + } else if (data_type != ERR) + # Available in header, but user has specified value to be used + IM_PIXTYPE(im) = data_type + + # If image dimension information wasn't read from header, the user + # must supply it. + + if (IM_NDIM(im) == UNSET) { + fd_dim = clpopnu ("dim") + ndim = clplen (fd_dim) + do i = 1, ndim { + junk = clgfil (fd_dim, temp, SZ_FNAME) + ip = 1 + junk = ctoi (temp, ip, IM_LEN (im, i)) + } + IM_NDIM(im) = ndim + call clpcls (fd_dim) + } + + # Convert text pixels to image pixels, posting only a warning + # message if an error occurs. Processing continues to the next + # file in the input list. + + iferr (call rt_convert_pixels (tf, im, format, pixels)) + call erract (EA_WARN) + + call imunmap (im) + call close (tf) + } + + call clpcls (input) +end diff --git a/pkg/dataio/imtext/t_wtextimage.x b/pkg/dataio/imtext/t_wtextimage.x new file mode 100644 index 00000000..8860f3d6 --- /dev/null +++ b/pkg/dataio/imtext/t_wtextimage.x @@ -0,0 +1,261 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <fset.h> +include <error.h> +include <mach.h> +include <imhdr.h> +include "imtext.h" + +define SZ_FORMAT 20 + + +# WTEXTIMAGE -- Write a text file from an IRAF image. Image header information +# is written in the "keyword = value / comment" format of FITS. Pixel values +# follow the header. The resulting text file can be read as a FITS image. The +# header cards include "NAXIS = 0", indicating no binary data matrix is written. +# The encoded pixel values can be read as special records following the null +# data matrix. + +procedure t_wtextimage () + +bool header +bool pixels +pointer im +char output[SZ_FNAME], format[SZ_FORMAT], imlist[SZ_LINE] +char image[SZ_FNAME], out_fname[SZ_FNAME] +int maxll, file_num, out, input, nfiles + +pointer immap() +bool clgetb(), strne() +int clgeti(), imtgetim(), open(), imtopen(), fstati(), imtlen() + +begin + # Open template of input image filenames. + call clgstr ("input", imlist, SZ_LINE) + input = imtopen (imlist) + nfiles = imtlen (input) + + # See if STDOUT has been redirected and get output filename. + if (fstati (STDOUT, F_REDIR) == YES) { + # Output has been redirected, set output filename to STDOUT + call strcpy ("STDOUT", output, SZ_FNAME) + } else { + # Get output filename from cl + call clgstr ("output", output, SZ_FNAME) + } + + # Get other parameters from cl. + header = clgetb ("header") + pixels = clgetb ("pixels") + maxll = min (MAX_LENTEXT, clgeti ("maxlinelen")) + if (maxll <= 0) + call error (1, "Illegal maximum line length: must be > 0") + + call clgstr ("format", format, SZ_FORMAT) + call strlwr (format) + + file_num = 0 + + while (imtgetim (input, image, SZ_FNAME) != EOF) { + file_num = file_num + 1 + + # Open image. + iferr (im = immap (image, READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + + if (nfiles > 1 && strne (output, "STDOUT")) { + # Generate unique output file name + call sprintf (out_fname, SZ_FNAME, "%s.%03d") + call pargstr (output) + call pargi (file_num) + } else + call strcpy (output, out_fname, SZ_FNAME) + + # Open output file. + iferr (out = open (out_fname, APPEND, TEXT_FILE)) { + call imunmap (im) + call erract (EA_WARN) + next + } + + iferr (call wti_convert_image (im,image,out,header,pixels, + maxll,format)) + call erract (EA_WARN) + + call imunmap (im) + call close (out) + } + + call imtclose (input) +end + + +# WTI_CONVERT_IMAGE -- called once for each image to be converted. This +# procedure determines the output pixel format and then directs the processing +# depending on user request. + +procedure wti_convert_image (im, image, out, header, pixels, maxll, user_format) + +pointer im # input image +char image[ARB] # image name +int out # output text file descriptor +bool header # convert header information (y/n)? +bool pixels # convert pixels (y/n)? +int maxll # maximum line length of text file +char user_format[ARB] # output format for single pixel entered by user + +int width, decpl, fmtchar +pointer sp, out_format, ftn_format, spp_format, ep +errchk wti_determine_fmt, wti_write_header +errchk wti_putint, wti_putreal, wti_putcomplex + +begin + call smark (sp) + call salloc (out_format, SZ_FORMAT, TY_CHAR) + call salloc (spp_format, SZ_FORMAT, TY_CHAR) + call salloc (ftn_format, SZ_FORMAT, TY_CHAR) + call salloc (ep, SZ_LINE, TY_CHAR) + + # Clear the format variables. + call aclrc (Memc[out_format], SZ_FORMAT) + call aclrc (Memc[spp_format], SZ_FORMAT) + call aclrc (Memc[ftn_format], SZ_FORMAT) + call aclrc (Memc[ep], SZ_LINE) + fmtchar = ' ' + + # Determine the output format. + + if (user_format[1] == EOS) { + # Format has not been set by user. Set appropriate defaults. + switch (IM_PIXTYPE(im)) { + case TY_USHORT: + call strcpy ("6d", Memc[spp_format], SZ_FORMAT) + case TY_SHORT: + call strcpy ("7d", Memc[spp_format], SZ_FORMAT) + case TY_INT: + call strcpy ("12d", Memc[spp_format], SZ_FORMAT) + case TY_LONG: + call strcpy ("12d", Memc[spp_format], SZ_FORMAT) + case TY_REAL: + call strcpy ("14.7g", Memc[spp_format], SZ_FORMAT) + case TY_DOUBLE: + call strcpy ("22.15g", Memc[spp_format], SZ_FORMAT) + case TY_COMPLEX: + call strcpy ("21.7z", Memc[spp_format], SZ_FORMAT) + } + } else + call strcpy (user_format, Memc[spp_format], SZ_FORMAT) + + call wti_determine_fmt (Memc[spp_format], Memc[ftn_format], + decpl, fmtchar, width) + + # Write the header. + if (header) { + if (width > 0) { + if ((maxll / width) < 1) { + call sprintf (Memc[ep], SZ_LINE, + "%s: output maxlinelen=%d is too short for format %s") + call pargstr (image) + call pargi (maxll) + call pargstr (Memc[ftn_format]) + call error (2, Memc[ep]) + } + + call sprintf (Memc[out_format], SZ_FORMAT, "%d%s") + call pargi (maxll / width) + call pargstr (Memc[ftn_format]) + } else + call strcpy ("*", Memc[out_format], SZ_FORMAT) + + call wti_write_header (im, image, out, Memc[out_format]) + } + + # Write out the pixels in text form. + if (pixels) { + switch (fmtchar) { + case 'd': + call wti_putint (im, out, maxll, width) + case 'e', 'f', 'g': + call wti_putreal (im, out, maxll, decpl, fmtchar, width) + case 'z': + call wti_putcomplex (im, out, maxll, decpl, 'e', width) + } + } + + call sfree (sp) +end + + +# WTI_DETERMINE_FMT -- Extract field width from input format string and +# generate a fortran format equivalent to the input spp format. The input +# format may be either a Fortran sytle format or an SPP format. + +procedure wti_determine_fmt (spp_format, ftn_format, decpl, fmtchar, width) + +char spp_format[ARB] # SPP format of each pixel +char ftn_format[ARB] # equivalent Fortran format (output) +int decpl # number of decimal places of precision (output) +int fmtchar # format character (output) +int width # field width (output) + +int ip +bool fortran_format +int ctoi() + +begin + # Parse either an SPP format "W.Dc" or a Fortran format "cW.D" to + # determine the field width, number of decimal places or precision, + # and the format char. If the field width is missing or zero we set + # width=0 to flag that free format output is desired. + + for (ip=1; IS_WHITE (spp_format[ip]); ip=ip+1) + ; + fortran_format = IS_ALPHA (spp_format[ip]) + if (fortran_format) { + if (spp_format[ip] == 'i') + fmtchar = 'd' + ip = ip + 1 + } + + # Extract W and D fields. + if (ctoi (spp_format, ip, width) == 0) + width = 0 + if (spp_format[ip] == '.') { + ip = ip + 1 + if (ctoi (spp_format, ip, decpl) == 0) + decpl = 0 + } else + decpl = 0 + + if (!fortran_format && spp_format[ip] != EOS) { + fmtchar = spp_format[ip] + ip = ip + 1 + } + + if (spp_format[ip] != EOS) + call error (3, "unacceptable numeric format") + + # Construct the FTN version of the spp_format. This will be + # output in the header. + + switch (fmtchar) { + case 'd': + call sprintf (ftn_format, SZ_FORMAT, "I%d") + call pargi (width) + case 'e', 'f', 'g': + call sprintf (ftn_format, SZ_FORMAT, "%c%d.%d") + call pargi (TO_UPPER (fmtchar)) + call pargi (width) + call pargi (decpl) + case 'z': + # Tell Fortran to use a list directed read to read complex data. + call strcpy ("*", ftn_format, SZ_FORMAT) + width = 0 + + default: + call error (4, "Improper format. Must be chosen from [defgz].") + } +end diff --git a/pkg/dataio/imtext/wtextimage.semi b/pkg/dataio/imtext/wtextimage.semi new file mode 100644 index 00000000..4574722a --- /dev/null +++ b/pkg/dataio/imtext/wtextimage.semi @@ -0,0 +1,91 @@ +# Semicode for the IRAF image to text file converter. + +procedure t_wtextimage (input, output) + +begin + input = expand template of input image file names + if (output hasn't been redirected) + get name of output file from cl + + # Get hidden parameters from cl + header = is header to be written? + maxlinelen = max number of characters per line of text + if (format not user specified) + format = NOT_SET + + for (each file name in input) { + im = open image file + generate output file name + text = open text file + call convert_image (im, text, header, maxlinelen, format) + close image file + close text file + } +end + + +# CONVERT_IMAGE -- called once for each image to be converted. Directs +# the processing depending on user request. + +procedure convert_image (im, text, header, maxlinelen, format) + +begin + if (format = NOT_SET) + format = appropriate value for data type of image + + # Calculate number of pixels per line of text + npix_line = maxlinelen / (field width of pixel output format) + output_format = "npix_line.pixel_format" + + if (header is to be written) + call write_header (im, text, output_format, maxlinelen) + + call convert_pixels (im, text, output_format) +end + + +# WRITE_HEADER -- write information from IRAF image header in +# "keyword = value" format, one keyword per line of text. + +procedure convert_header (image, text, output_format, maxlinelen) + +begin + # Write header information to text file + SIMPLE = T + BITPIX = 8 + NAXIS = 0 + ORIGIN = NOAO + IRAF-MAX= IM_MAX + IRAF-MIN= IM_MIN + IRAF-B/P= + IRAFTYPE= + OBJECT = IM_TITLE + NDIM = IM_NDIM + LEN1 = IM_LEN(1) + FILENAME= IM_HDRFILE + FORMAT = output_format + + # Write any information stored in image user area + if (user area contains information) { + COMMENT = "Copying user area" + KEYWORD = copy user area to text file + } + + # Final header line is END + END = last line of header + + Pad with blank lines until multiple of 36 lines is output +end + + +# CONVERT_IMAGE -- write pixel values from IRAF image into text file. The +# pixels are output in "leftmost subscript varying most rapidly" order. + +procedure convert_image (image, text, format) + +begin + get next line of image + for each pixel in line + convert pixel to character + put out line to text file according to format +end diff --git a/pkg/dataio/imtext/wti_wheader.x b/pkg/dataio/imtext/wti_wheader.x new file mode 100644 index 00000000..2cad585d --- /dev/null +++ b/pkg/dataio/imtext/wti_wheader.x @@ -0,0 +1,152 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imio.h> +include <mach.h> +include "imtext.h" + +define NBITS_ASCII 8 +define NDEC_PLACES 7 + + +# WTI_WRITE_HEADER -- write information from IRAF image header to text file in +# FITS "keyword = value / comment" format. One keyword is written per line +# of text. + +procedure wti_write_header (im, image, tx, out_format) + +pointer im # Pointer to image file +char image[ARB] # Image filename +int tx # File descriptor of text file +char out_format[ARB] # Output format for pixel conversion + +int i, nlines, user, op, max_lenuser +pointer sp, root, line, comment +bool streq() +int strlen(), sizeof(), getline(), stropen(), gstrcpy(), stridx() + +errchk addcard_b, addcard_i, addcard_r, addcard_st +errchk wti_iraf_type, streq, strupr, stropen, strclose, getline + +begin + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (comment, SZ_LINE, TY_CHAR) + + call addcard_i (tx, "BITPIX", NBITS_ASCII, "8-bit ASCII characters") + call addcard_i (tx, "NAXIS", IM_NDIM(im), "Number of Image Dimensions") + + nlines = NFITS_LINES + + # Construct and output an NAXISn card for each axis + do i = 1, IM_NDIM(im) { + op = gstrcpy ("NAXIS", Memc[root], LEN_KEYWORD) + call sprintf (Memc[root+op], LEN_KEYWORD-op, "%d") + call pargi (i) + call addcard_i (tx, Memc[root], IM_LEN(im,i), "Length of axis") + nlines = nlines + 1 + } + + call addcard_st (tx, "ORIGIN", "NOAO-IRAF: WTEXTIMAGE", "", + strlen("NOAO-IRAF: WTEXTIMAGE")) + + # Add the image MIN and MAX header cards + call strcpy ("Max image pixel", Memc[comment], SZ_LINE) + if (IM_MTIME(im) > IM_LIMTIME(im)) + call strcat (" (out of date)", Memc[comment], SZ_LINE) + call addcard_r (tx, "IRAF-MAX", IM_MAX(im), Memc[comment], + NDEC_PLACES) + + call strcpy ("Min image pixel", Memc[comment], SZ_LINE) + if (IM_MTIME(im) > IM_LIMTIME(im)) + call strcat (" (out of date)", Memc[comment], SZ_LINE) + call addcard_r (tx, "IRAF-MIN", IM_MIN(im), Memc[comment], + NDEC_PLACES) + + # The number of bits per pixel is calculated and output + call addcard_i (tx, "IRAF-B/P", sizeof (IM_PIXTYPE(im)) * + SZB_CHAR * NBITS_BYTE, "Image bits per pixel") + + call wti_iraf_type (IM_PIXTYPE(im), Memc[root]) + call addcard_st (tx, "IRAFTYPE", Memc[root], "Image datatype", + strlen(Memc[root])) + + call strupr (IM_TITLE(im)) + call addcard_st (tx, "OBJECT" , IM_TITLE(im), "", + strlen (IM_TITLE(im))) + + call strupr (image) + call addcard_st (tx, "FILENAME", image, "IRAF filename", + strlen (image)) + nlines = nlines + 1 + + call strcpy ("Text line format", Memc[comment], SZ_LINE) + if (streq (out_format, "*")) + call strcat (" (* = list directed)", Memc[comment], SZ_LINE) + call addcard_st (tx, "FORMAT", out_format, Memc[comment], + LEN_STRING) + nlines = nlines + 1 + + # Write any information stored in image user area + if ((IM_HDRLEN(im) - LEN_IMHDR) > 0) { + max_lenuser = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1 + user = stropen (Memc[IM_USERAREA(im)], max_lenuser, READ_ONLY) + + while (getline (user, Memc[line]) != EOF) { + call putline (tx, Memc[line]) + nlines = nlines + 1 + } + + # Make sure last line written out included a newline. It won't if + # the user area was truncated when it was read. + if (stridx ("\n", Memc[line]) == 0) + call putline (tx, "\n") + + call close (user) + } + + # Final header line is END (FITS keywords are 8 characters long) + call fprintf (tx, "END%77w\n") + nlines = nlines + 1 + + # Pad output file with blank lines until header block occupies + # a multiple of 36 lines. + + if (nlines != NCARDS_FITS_BLK) { + do i = 1, NCARDS_FITS_BLK - mod(nlines, NCARDS_FITS_BLK) + call fprintf (tx, "%80w\n") + } + + call sfree (sp) +end + + +# WTI_IRAF_TYPE -- Procedure to set the iraf datatype keyword. Permitted strings +# are INTEGER, FLOATING or COMPLEX. + +procedure wti_iraf_type (datatype, type_str) + +int datatype # the IRAF data type +char type_str[ARB] # the output IRAF type string + +begin + switch (datatype) { + case TY_SHORT: + call strcpy ("SHORT INTEGER", type_str, LEN_STRING) + case TY_USHORT: + call strcpy ("UNSIGNED SHORT INT", type_str, LEN_STRING) + case TY_INT: + call strcpy ("INTEGER", type_str, LEN_STRING) + case TY_LONG: + call strcpy ("LONG INTEGER", type_str, LEN_STRING) + case TY_REAL: + call strcpy ("REAL FLOATING", type_str, LEN_STRING) + case TY_DOUBLE: + call strcpy ("DOUBLE FLOATING", type_str, LEN_STRING) + case TY_COMPLEX: + call strcpy ("COMPLEX", type_str, LEN_STRING) + default: + call error (4, "IRAF_TYPE: Unknown IRAF image type.") + } +end |