Initial commit

4 files changed, 443 insertions, 0 deletions

diff --git a/pkg/dataio/lib/addcards.x b/pkg/dataio/lib/addcards.x
new file mode 100644
index 00000000..42699380
--- /dev/null
+++ b/pkg/dataio/lib/addcards.x
@@ -0,0 +1,140 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	MAXLEN_STRVAL	65
+define	LEN_KEYWORD	8
+define	LEN_STRING	18
+
+# ADDCARD_R -- Format and append a FITS header card with a real
+# keyword value to the input string buffer.  
+
+procedure addcard_r (fd, keyword, value, comment, precision)
+
+int	fd			# File descriptor of input string buffer
+char	keyword[LEN_KEYWORD]	# FITS keyword
+real	value			# Value of FITS keyword
+char	comment[ARB]		# Comment string
+int	precision		# Number of decimal places output
+
+
+begin
+	call fprintf (fd, "%-8.8s= %20.*g  /  %-45.45s\n")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargr (value)
+	    call pargstr (comment)
+end
+
+
+# ADDCARD_I -- Format and append a FITS header card with an integer
+# keyword value to the input string buffer.
+
+procedure addcard_i (fd, keyword, value, comment)
+
+int	fd			# File descriptor of input string buffer
+char	keyword[LEN_KEYWORD]	# FITS keyword
+int	value			# Value of FITS keyword
+char	comment[ARB]		# Comment string
+
+begin
+	call fprintf (fd, "%-8.8s= %20d  /  %-45.45s\n")
+	    call pargstr (keyword)
+	    call pargi (value)
+	    call pargstr (comment)
+end
+
+
+# ADDCARD_TIME -- Format and append a FITS header card to the input
+# file descriptor.  The value is input as a real number; it is output
+# in HH:MM:SS.S format with %h.  The procedure can be used for RA, DEC
+# and ST, UT and HA.
+
+procedure addcard_time (fd, keyword, value, comment)
+
+int	fd			# File descriptor
+char	keyword[LEN_KEYWORD]	# FITS keyword
+real	value			# Value of FITS keyword to be encoded
+char	comment[ARB]			# Comment string
+
+
+begin
+	call fprintf (fd, "%-8.8s= '%-18.1h'  /  %-45s\n")
+	    call pargstr (keyword)
+	    call pargr (value)
+	    call pargstr (comment)
+end
+
+
+# ADDCARD_ST -- Format and output a FITS header card to the input
+# file descriptor.  The value is output as a string with the given keyword.
+# If the string value is longer than 18 characters, it is output without
+# a comment.
+
+procedure addcard_st (fd, keyword, value, comment, length)
+
+int	fd			# File descriptor
+char	keyword[LEN_KEYWORD]	# FITS keyword
+char	value[SZ_LINE]		# String value of FITS keyword to be encoded
+char	comment[ARB]		# Comment string
+int	length			# Length of string value
+
+begin	
+	if (length <= LEN_STRING) {
+	    call fprintf (fd, "%-8.8s= '%-18.18s'  /  %-44s\n")
+	        call pargstr (keyword)
+	        call pargstr (value)
+	        call pargstr (comment)
+	} else  {
+	    length = min (length, MAXLEN_STRVAL)
+	    call fprintf (fd, "%-8.8s= '%*.*s'  /\n")
+		call pargstr (keyword)
+		call pargi (-length)
+		call pargi (length)
+		call pargstr (value)
+	}
+end
+
+
+# ADDCARD_B -- Format and output a FITS header card to the input file
+# descriptor.  The value is output as a boolean with the given keyword.
+# Unlike string parameters, booleans are not enclosed in quotes.
+
+procedure addcard_b (fd, keyword, value, comment)
+
+int	fd			# File descriptor
+char	keyword[LEN_KEYWORD]	# FITS keyword
+bool	value			# Boolean parameter (T/F)
+char	comment[ARB]		# Comment string
+char	truth
+
+begin
+	if (value)
+	    truth = 'T'
+	else
+	    truth = 'F'
+
+	call fprintf (fd, "%-8.8s= %20c  /  %-45.45s\n")
+	    call pargstr (keyword)
+	    call pargc (truth)
+	    call pargstr (comment)
+end
+
+
+# ADDCARD_D -- Format and append a FITS header card with a double
+# keyword value to the input string buffer.  
+
+procedure addcard_d (fd, keyword, value, comment, precision)
+
+int	fd			# File descriptor of input string buffer
+char	keyword[LEN_KEYWORD]	# FITS keyword
+double	value			# Value of FITS keyword
+char	comment[ARB]		# Comment string
+int	precision		# Number of decimal places output
+
+
+begin
+	call fprintf (fd, "%-8.8s= %20.*f  /  %-45.45s\n")
+	    call pargstr (keyword)
+	    call pargi (precision)
+	    call pargd (value)
+	    call pargstr (comment)
+end
diff --git a/pkg/dataio/lib/getdatatype.x b/pkg/dataio/lib/getdatatype.x
new file mode 100644
index 00000000..9502e82f
--- /dev/null
+++ b/pkg/dataio/lib/getdatatype.x
@@ -0,0 +1,57 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+define	NTYPES		9
+
+# GETDATATYPE -- Convert a character to an IRAF data type
+
+int procedure getdatatype (ch)
+
+char	ch
+int	i, type_code[NTYPES]
+int	stridx()
+
+string	types "bcusilrdx"		# Supported data types
+data	type_code /TY_UBYTE, TY_CHAR, TY_USHORT, TY_SHORT, TY_INT, TY_LONG,
+	TY_REAL, TY_DOUBLE, TY_COMPLEX/
+
+begin
+	i = stridx (ch, types)
+	if (i == 0)
+	   return (ERR)
+	else
+	    return (type_code[stridx(ch,types)])
+end
+
+
+# DTSTRING -- Convert a datatype to a string
+
+procedure dtstring (datatype, str, maxchar)
+
+int	datatype			# IRAF datatype
+char	str[maxchar]			# Output string
+int	maxchar				# Maximum characters in string
+
+begin
+	switch (datatype) {
+	case TY_UBYTE:
+	    call strcpy ("unsigned byte", str, maxchar)
+	case TY_CHAR:
+	    call strcpy ("character", str, maxchar)
+	case TY_USHORT:
+	    call strcpy ("unsigned short", str, maxchar)
+	case TY_SHORT:
+	    call strcpy ("short", str, maxchar)
+	case TY_INT:
+	    call strcpy ("integer", str, maxchar)
+	case TY_LONG:
+	    call strcpy ("long", str, maxchar)
+	case TY_REAL:
+	    call strcpy ("real", str, maxchar)
+	case TY_DOUBLE:
+	    call strcpy ("double", str, maxchar)
+	case TY_COMPLEX:
+	    call strcpy ("complex", str, maxchar)
+	default:
+	    call strcpy ("unknown", str, maxchar)
+	}
+end
diff --git a/pkg/dataio/lib/mkpkg b/pkg/dataio/lib/mkpkg
new file mode 100644
index 00000000..698997dd
--- /dev/null
+++ b/pkg/dataio/lib/mkpkg
@@ -0,0 +1,12 @@
+# These routines are used by more than one task in the dataio package:
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	addcards.x	
+	#getdatatype.x	
+	#ranges.x	<ctype.h> <mach.h>
+	;
diff --git a/pkg/dataio/lib/ranges.x b/pkg/dataio/lib/ranges.x
new file mode 100644
index 00000000..b3812cd1
--- /dev/null
+++ b/pkg/dataio/lib/ranges.x
@@ -0,0 +1,234 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+include	<ctype.h>
+
+define	FIRST	1		# Default starting range
+define	LAST	MAX_INT		# Default ending range
+define	STEP	1		# Default step
+
+# DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by a single NULL.
+
+int procedure decode_ranges (range_string, ranges, max_ranges, nvalues)
+
+char	range_string[ARB]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	nvalues			# The number of values in the ranges
+
+int	ip, nrange, first, last, step, ctoi()
+
+begin
+	ip = 1
+	nvalues = 0
+
+	do nrange = 1, max_ranges - 1 {
+	    # Defaults to all positive integers
+	    first = FIRST
+	    last = LAST
+	    step = STEP
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    # Null string defaults
+		    ranges[1, 1] = first
+		    ranges[2, 1] = last
+		    ranges[3, 1] = step
+		    ranges[1, 2] = NULL
+	    	    nvalues = nvalues + abs (last-first) / step + 1
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = NULL
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, first) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', or 'x' otherwise last = first.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (range_string[ip] == '-') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, last) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		last = first
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		} else if (range_string[ip] == '-')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last-first) / step + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# GET_NEXT_NUMBER -- Given a list of ranges and the current file number,
+# find and return the next file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically increasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure get_next_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number+1 is anywhere in the list, that is the next number,
+	# otherwise the next number is the smallest number in the list which
+	# is greater than number+1.
+
+	number = number + 1
+	next_number = MAX_INT
+
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder + step <= last)
+		    next_number = number - remainder + step
+	    } else if (first > number)
+		next_number = min (next_number, first)
+	}
+
+	if (next_number == MAX_INT)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# GET_PREVIOUS_NUMBER -- Given a list of ranges and the current file number,
+# find and return the previous file number.  Selection is done in such a way
+# that list numbers are always returned in monotonically decreasing order,
+# regardless of the order in which the ranges are given.  Duplicate entries
+# are ignored.  EOF is returned at the end of the list.
+
+int procedure get_previous_number (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Both input and output parameter
+
+int	ip, first, last, step, next_number, remainder
+
+begin
+	# If number-1 is anywhere in the list, that is the previous number,
+	# otherwise the previous number is the largest number in the list which
+	# is less than number-1.
+
+	number = number - 1
+	next_number = 0
+
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last) {
+		remainder = mod (number - first, step)
+		if (remainder == 0)
+		    return (number)
+		if (number - remainder >= first)
+		    next_number = number - remainder
+	    } else if (last < number) {
+		remainder = mod (last - first, step)
+		if (remainder == 0)
+		    next_number = max (next_number, last)
+		else if (last - remainder >= first)
+		    next_number = max (next_number, last - remainder)
+	    }
+	}
+
+	if (next_number == 0)
+	    return (EOF)
+	else {
+	    number = next_number
+	    return (number)
+	}
+end
+
+
+# IS_IN_RANGE -- Test number to see if it is in range.
+
+bool procedure is_in_range (ranges, number)
+
+int	ranges[ARB]		# Range array
+int	number			# Number to be tested against ranges
+
+int	ip, first, last, step
+
+begin
+	for (ip=1;  ranges[ip] != NULL;  ip=ip+3) {
+	    first = min (ranges[ip], ranges[ip+1])
+	    last = max (ranges[ip], ranges[ip+1])
+	    step = ranges[ip+2]
+	    if (number >= first && number <= last)
+		if (mod (number - first, step) == 0)
+		    return (true)
+	}
+
+	return (false)
+end