1 files changed, 386 insertions, 0 deletions
diff --git a/noao/mtlocal/cyber/t_ridsout.x b/noao/mtlocal/cyber/t_ridsout.x
new file mode 100644
index 00000000..473d120f
--- /dev/null
+++ b/noao/mtlocal/cyber/t_ridsout.x
@@ -0,0 +1,386 @@
+include	<mach.h>
+include	<ctype.h>
+include	<imhdr.h>
+include	<fset.h>
+include	<error.h>
+include	"cyber.h"
+
+define	MAX_WIDTH	10	# Maximum format width for pixel data
+
+# T_RIDSOUT --  the IDSOUT format reader, which reads a text file of IDS
+# records in IDSOUT format.  Each IDS record contains 133 card images: 4
+# cards of header information followed by 128 cards of pixel values and
+# one blank card.  The IDSOUT reader will read the text file and optionally
+# convert the data to a sequence of one dimensional IRAF images.  The
+# header information can be printed in long or short form; the pixel values
+# can also be listed.
+
+procedure t_ridsout ()
+
+pointer	sp, cp
+int	fd
+char	in_fname[SZ_FNAME]
+int	get_data_type(), clpopni(), clgfil(), btoi()
+bool	clgetb()
+char	clgetc()
+errchk	clpopni
+
+begin
+	# Allocate space for the control parameter descriptor structure
+	call smark (sp)
+	call salloc (cp, LEN_CP, TY_STRUCT)
+
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Get parameters from the cl and fill control parameter structure
+	fd = clpopni ("idsout_file")
+
+	LONG_HEADER(cp) = btoi (clgetb ("long_header"))
+	PRINT_PIXELS(cp) = btoi (clgetb ("print_pixels"))
+	call clgstr ("record_numbers", REC_NUMBERS(cp), SZ_LINE)
+
+	# If an output image is to be written, get root output file name 
+	# and output data type.
+
+	MAKE_IMAGE(cp) = btoi (clgetb ("make_image"))
+	if (MAKE_IMAGE(cp) == YES) {
+	    call clgstr ("iraf_file", IRAF_FILE(cp), SZ_FNAME)
+	    DATA_TYPE(cp) = get_data_type (clgetc ("data_type"))
+	    if (DATA_TYPE(cp) == ERR)
+		DATA_TYPE(cp) = TY_REAL
+	}
+
+	while (clgfil (fd, in_fname, SZ_FNAME) != EOF)  {
+	    call read_idsout (in_fname, cp)
+	}
+
+	call clpcls (fd)
+	call sfree (sp)
+end
+
+
+# READ_IDSOUT -- open IDSOUT text file and direct processing depending on 
+# user's request.
+
+procedure read_idsout (in_fname, cp)
+
+char	in_fname[SZ_FNAME]	# Input file name
+pointer	cp			# Pointer to control parameter structure
+
+pointer	sp, ids
+char	out_fname[SZ_FNAME]
+int	in, records[3, MAX_RANGES], nrecs, nrecs_read, stat
+bool	is_in_range()
+int	open(), decode_ranges(), idso_read_header(), strlen()
+errchk	open, read, idso_read_header, decode_ranges, idso_write_image
+errchk	copy_pixels
+
+begin
+	# Open text file and allocate space for descriptor structure ids
+	in = open (in_fname, READ_ONLY, TEXT_FILE)
+	call smark (sp)
+	call salloc (ids, LEN_IDS, TY_STRUCT)
+
+	if (decode_ranges (REC_NUMBERS(cp), records, MAX_RANGES, nrecs) == ERR)
+	    call error (1, "Error in record_numbers specification")
+
+	nrecs_read = 0
+	repeat {
+	    iferr {
+	        stat = idso_read_header (in, ids)
+	    } then {
+		call erract (EA_WARN)
+		call eprintf ("Bad header, attempting to skip pixels\n")
+		call copy_pixels (in, NULL)
+		next
+	    }
+
+	    if (stat == EOF) {
+		call printf ("\nIDSOUT file \"%s\" at EOF\n")
+		    call pargstr (in_fname)
+		call close (in)
+		call sfree (sp)
+		return 
+	    }
+
+	    if (is_in_range (records, RECORD_NUMBER(ids))) {
+		nrecs_read = nrecs_read + 1
+		call print_header (ids, LONG_HEADER(cp))
+		
+		if (MAKE_IMAGE(cp) == YES) {
+		    call strcpy (IRAF_FILE(cp), out_fname, SZ_FNAME)
+		    call sprintf (out_fname[strlen(out_fname)+1], SZ_FNAME,
+			".%04d")
+			call pargi (RECORD_NUMBER(ids))
+		    iferr {
+	    	        call idso_write_image (in, DATA_TYPE(cp), 
+			    PRINT_PIXELS(cp), out_fname, ids)
+		    } then  {
+			call erract (EA_WARN)
+			if (PRINT_PIXELS(cp) == YES)
+			    call copy_pixels (in, STDOUT)
+			else
+			    call copy_pixels (in, NULL)
+			next
+		    }
+
+		} else if (PRINT_PIXELS(cp) == YES)
+	    	    # Simply copy card image data to standard output
+	    	    call copy_pixels (in, STDOUT)
+
+		if (PRINT_PIXELS(cp) == NO && MAKE_IMAGE(cp) == NO)
+		    call copy_pixels (in, NULL)
+	    } else
+	        call copy_pixels (in, NULL)
+
+	} until (nrecs_read == nrecs)
+
+	call sfree (sp)
+	call close (in)
+end
+
+
+# IDSO_READ_HEADER -- decode header parameter from IDSOUT header cards.  The
+# IDSO prefix implies IDSOUT format; IDSF is used for IDSFILE format.  The
+# first four cards of each record in the IDSOUT file are the header.
+
+int procedure idso_read_header (in, ids)
+
+int	in		# File descriptor of input text file
+pointer	ids		# Pointer to program data structure
+
+pointer	sp, temp
+int	record, tape, junk, ip
+int	fscan(), nscan(), strlen(), getline()
+errchk	fscan
+
+begin
+	# Allocate space on stack for temporary char storage
+	call smark (sp)
+	call salloc (temp, SZ_LINE, TY_CHAR)
+
+	# Skip any blank lines that may preceede the first header card.
+	# Break out of repeat when first non-blank line is encountered.
+
+	repeat {
+	    if (getline (in, Memc[temp]) == EOF) {
+	        call sfree (sp)
+	        return (EOF)
+	    } else {
+		for (ip = temp; IS_WHITE (Memc[ip]); ip = ip + 1) 
+		    ;
+		if (Memc[ip] == '\n' || Memc[ip] == EOS)
+		    # Blank line
+		    ;
+		else
+		    break
+	    }
+	}
+
+	call sscan (Memc[temp]) {
+	    # Values to be read from first card of file:
+	    call gargi (record)
+	    call gargi (ITM(ids))
+	    call gargd (LAMBDA0(ids))
+	    call gargd (DELTA_LAMBDA(ids))
+	    call gargi (NP1(ids))
+	    call gargi (NP2(ids))
+	    call gargi (BEAM_NUMBER(ids))
+	    call gargi (junk)
+	    call gargi (junk)
+	    call gargi (SMODE(ids))
+	    call gargi (UT(ids))
+	    if (nscan() < 11) 
+	        call error (2, "First header card incomplete")
+        }
+
+	if (fscan (in) == EOF) {
+	    call sfree (sp)
+	    return (EOF)
+	} else {
+	    # Values to be read from second card of file
+	    call gargi (ST(ids))
+	    call gargd (RA(ids))
+	    call gargd (DEC(ids))
+	    call gargi (tape)
+	    if (tape > 0)
+	        RECORD_NUMBER(ids) = tape * 1000 + record
+	    else
+		RECORD_NUMBER(ids) = record
+	    call gargi (DF_FLAG(ids))
+	    call gargi (SM_FLAG(ids))
+	    call gargi (QF_FLAG(ids))
+	    call gargi (DC_FLAG(ids))
+	    call gargi (QD_FLAG(ids))
+	    call gargi (EX_FLAG(ids))
+	    call gargi (BS_FLAG(ids))
+	    if (nscan() < 11)
+	        call error (3, "Second header card incomplete")
+	}
+
+	if (fscan (in) == EOF)  {
+	    call sfree (sp)
+	    return (EOF)
+	} else {
+	    # Values to be read from third card of file
+	    call gargi (CA_FLAG(ids))
+	    call gargi (CO_FLAG(ids))
+	    call gargwrd (ALPHA_ID(ids), 3)
+	    call gargi (OFLAG(ids))
+	    call gargd (HA(ids))
+	    call gargd (AIRMASS(ids))
+	    if (nscan() < 6) {
+	        call error (4, "Third header card incomplete")
+	    }
+	}
+
+	if (fscan (in) == EOF) {
+	    call sfree (sp)
+	    return (EOF)
+	} else {
+	    call gargstr (Memc[temp], SZ_LINE)
+
+	    # Count number of characters in id string by skipping trailing
+	    # white space.  'END' are always the last 3 characters of the
+	    # line of text containing the ID; they are also skipped.
+
+	    for (ip = strlen(Memc[temp]) - 3; IS_WHITE (Memc[temp+ip-1]) && 
+		ip > 0 ; ip = ip - 1)
+		    ;
+	    Memc[temp+ip] = EOS
+	    call strcpy (Memc[temp], LABEL(ids), SZ_LINE)
+	}
+
+	# Since this is IDSOUT format data, initialize COEFF(ids) to integer 0.
+	COEFF(ids) = 0
+
+	# Determine companion record number if appropriate
+	if (SMODE(ids) != 0) {
+	    if (BEAM_NUMBER(ids) == 1)
+		COMPANION_RECORD(ids) = RECORD_NUMBER(ids) - 1
+	    else
+		COMPANION_RECORD(IDS) = RECORD_NUMBER(IDS) + 1
+	}
+
+	call sfree (sp)
+	return (OK)
+
+end
+
+
+# COPY_PIXELS -- copy pixel values from input to output file.  A blank line
+# terminates each IDS record.
+
+procedure copy_pixels (in, out)
+
+int	in	# File descriptor of input text file
+int	out	# File descriptor of output file
+
+pointer	sp, line_buffer
+bool	leading_blank
+int	ip
+int	getline()
+
+begin
+	# Allocate space on stack for line_buffer
+	call smark (sp)
+	call salloc (line_buffer, SZ_LINE, TY_CHAR)
+
+	# Ignore blank lines until first non_blank line encountered
+	leading_blank = true
+
+	repeat {
+	    if (getline (in, Memc[line_buffer]) == EOF) 
+		call error (5, "Unexpected EOF when copying pixels")
+
+	    # Find first non-whitespace character
+	    for (ip = line_buffer; IS_WHITE (Memc[ip]); ip = ip + 1)
+		;
+
+	    if (Memc[ip] == '\n' || Memc[ip] == EOS) {
+	        # Blank line
+	        if (leading_blank)
+	            ;
+	        else
+	            break
+	    } else {
+	        leading_blank = false
+	        if (out != NULL)
+	    	    call putline (out, Memc[line_buffer])
+	    }
+	} 
+
+	call sfree (sp)
+end
+
+
+# IDSO_WRITE_IMAGE -- convert card image data values to reals and write
+# 1-d IRAF image.  
+
+procedure idso_write_image (in, data_type, print_pixels, out_fname, ids)
+
+int	in			# File descriptor of input text file
+int	data_type		# Data type of image pixels to be written
+int	print_pixels		# Are pixel values to be listed (YES/NO)?
+char	out_fname[SZ_FNAME]	# Name of output image
+pointer	ids			# Pointer to program data structure
+
+pointer	im, pixels, op
+char	line[SZ_LINE], temp[MAX_WIDTH]
+int	i, j, ip, iip, nchars
+pointer	immap(), impl1r()
+int	fscan(), nscan(), strlen(), ctowrd(), ctor()
+errchk	immap, imunmap, fscan, impl1r, unpk_30, cy_store_keywords
+
+begin
+	im = immap (out_fname, NEW_IMAGE, LEN_USER_AREA)
+	IM_NDIM(im) = 1
+	IM_LEN(im, 1) = NPIX_IDS_RECORD
+	call strcpy (LABEL(ids), IM_TITLE(im), SZ_IMTITLE)
+	IM_PIXTYPE(im) = data_type
+	pixels = impl1r(im)
+	op = pixels
+
+	# Position to first non_blank line.
+	repeat {
+	    if (fscan (in) == EOF) {
+		call imunmap (im)
+		return
+	    } else 
+		call gargstr (line, SZ_LINE)
+	} until (strlen (line) > 1)
+	call reset_scan()
+
+
+	# Scan and convert pixel values to image pixels.  A blank line
+	# terminates the IDS record.
+
+	do i = 1, NLINES_PIXELS {
+	    ip = 1
+	    # Extract 8 pixel values from each line of text
+	    do j = 1, NPIX_LINE {
+		iip = 1
+		call gargstr (line, SZ_LINE)
+		nchars = ctowrd (line, ip, temp, MAX_WIDTH)
+		nchars = ctor (temp, iip, Memr[op])
+	        # call gargr (Memr[op])
+	        op = op + 1
+	    }
+
+	    if (nscan () <= 1)
+		# Premature blank line encountered
+		break
+
+	    # Get next line of pixels
+	    if (fscan (in) == EOF)
+		break
+	}
+
+	if (print_pixels == YES)
+	    call list_values (Memr[pixels])
+	
+	# Write ids specific header words to iraf image header
+	call cy_store_keywords (ids, im)
+
+	call imunmap (im)
+end