Initial commit

1 files changed, 375 insertions, 0 deletions

diff --git a/noao/digiphot/ptools/pconvert/ptdeftable.x b/noao/digiphot/ptools/pconvert/ptdeftable.x
new file mode 100644
index 00000000..86fb2c35
--- /dev/null
+++ b/noao/digiphot/ptools/pconvert/ptdeftable.x
@@ -0,0 +1,375 @@
+#include <ctype.h>
+include <tbset.h>
+include "../../lib/ptkeysdef.h"
+
+# PT_DEFTABLE -- Set up and create the table for the conversion of
+# the APPHOT text file.
+
+int procedure pt_deftable (td, key, fields, columns)
+
+pointer	td			# output table descriptor
+pointer	key			# key structure
+char	fields[ARB]		# fields to be output to the table
+int	columns[ARB] 		# pointer to array of column pointers
+
+int	ncols
+int	pt_defcols()
+
+begin
+	# Define the table columns.
+	ncols  = pt_defcols (td, key, fields, columns)
+	if (ncols <= 0)
+	    return (0)
+
+	# Define the table header.
+	call pt_defheader (td, key)
+
+	return (ncols)
+end
+
+
+# PT_DEFHEADER -- Define the header structure.
+
+procedure pt_defheader (td, key)
+
+pointer	td				# table descriptor
+pointer	key				# pointer to the keys structure
+
+int	i, index, type, len, ival, ip
+pointer	sp, kname, value, ptr
+real    rval
+bool	streq()
+int	pt_strwrd(), pt_kstati(), ctoi(), ctor()
+
+begin
+	call smark (sp)
+	call salloc (kname, SZ_KEYWORD, TY_CHAR)
+	call salloc (value, KY_SZPAR, TY_CHAR)
+
+	# Define the columns determining datatype from the format string.
+	do i = 1, KY_NPKEYS(key) {
+
+	    index = pt_strwrd (i, Memc[kname], SZ_KEYWORD, Memc[KY_WORDS(key)])
+	    if (index <= 0)
+		next
+
+	    ptr = Memi[KY_PTRS(key)+index-1] 
+	    len = pt_kstati (key, Memc[kname], KY_LENGTH)
+	    call strcpy (Memc[ptr], Memc[value], len)
+	    type = pt_kstati (key, Memc[kname], KY_DATATYPE)
+
+	    switch (type) {
+	    case TY_INT:
+		ip = 1
+		if (ctoi (Memc[value], ip, ival) <= 0)
+		    call tbhadi (td, Memc[kname], INDEFI)
+		else
+		    call tbhadi (td, Memc[kname], ival)
+	    case TY_REAL:
+		ip = 1
+		if (ctor (Memc[value], ip, rval) <= 0)
+		    call tbhadr (td, Memc[kname], INDEFR)
+		else
+		    call tbhadr (td, Memc[kname], rval)
+	    case TY_BOOL:
+		if (streq ("yes", Memc[value]))
+		    call tbhadb (td, Memc[kname], true)
+		else
+		    call tbhadb (td, Memc[kname], false)
+	    default:
+		call tbhadt (td, Memc[kname], Memc[value])
+	    }
+	}
+
+	call sfree (sp)
+end
+	
+
+# PT_DEFCOLS -- Define the data columns to be output.
+
+int procedure pt_defcols (td, key, fields, columns)
+
+pointer	td			# table Descriptor
+pointer key			# key structure
+char 	fields[ARB]		# fields selected
+pointer columns[ARB]		# array of pointers for columns
+
+int	max_nkeys, index, ncols, element, nelems, type, len
+pointer	sp, kname, aranges, ranges, rangeset, colname, colunits, colformat
+pointer	list
+
+int	pt_gnfn(), strdic(), pt_ranges(), get_next_number()
+int	decode_ranges(), pt_kstati()
+pointer	pt_ofnl()
+real	asumi()
+errchk	tbcdef()
+
+begin
+	# Allocate working space.
+
+	call smark (sp)
+	call salloc (kname, KY_SZPAR, TY_CHAR)
+	call salloc (aranges, SZ_FNAME, TY_CHAR)
+	call salloc (ranges, SZ_FNAME, TY_CHAR)
+	call salloc (rangeset, 3 * KY_MAXNRANGES, TY_INT)
+
+	call salloc (colname, SZ_COLNAME, TY_CHAR)
+	call salloc (colunits, SZ_COLUNITS, TY_CHAR)
+	call salloc (colformat, SZ_COLFMT, TY_CHAR)
+
+	# Initialize the select buffers. The select keyword, format
+	# and units string buffers are not necessary in this application.
+
+	max_nkeys = nint (asumi (Memi[KY_NELEMS(key)], KY_NKEYS(key)))
+	if (KY_SELECT(key) != NULL)
+	    call mfree (KY_SELECT(key), TY_INT)
+	call malloc (KY_SELECT(key), max_nkeys, TY_INT)
+	if (KY_ELEM_SELECT(key) != NULL)
+	    call mfree (KY_ELEM_SELECT(key), TY_INT)
+	call malloc (KY_ELEM_SELECT(key), max_nkeys, TY_INT)
+	if (KY_LEN_SELECT(key) != NULL)
+	    call mfree (KY_LEN_SELECT(key), TY_INT)
+	call malloc (KY_LEN_SELECT(key), max_nkeys, TY_INT)
+
+	# Initialize the number of columns.
+	ncols = 0
+
+	# Open the list of fields.
+	list = pt_ofnl (key, fields)
+
+	# Loop over the fields.
+	while (pt_gnfn (list, Memc[kname], Memc[aranges], KY_SZPAR) != EOF) {
+
+	    # Find location of the field in the keyword dictionary and 
+	    # expand the ranges string if it is defined.
+	    index = strdic (Memc[kname], Memc[kname], KY_SZPAR, 
+		Memc[KY_WORDS(key)])
+	    if (pt_ranges (Memc[aranges], Memc[ranges], element, SZ_LINE) ==
+	        ERR)
+		call error (0, "Cannot decode DAOPHOT range string")
+
+	    # The field was not found.
+	    if (index == 0) {
+		next
+
+	    # Reject keyword fields.
+	    } else if (index <= KY_NPKEYS (key)) {
+ 		next
+
+	    # The field is single valued.
+	    } else if (Memi[KY_NELEMS(key)+index-1] == 1) {
+
+		# Enter the pointers into the select buffer.
+	        Memi[KY_SELECT(key)+ncols] = index
+	        Memi[KY_ELEM_SELECT(key)+ncols] = 1
+		len = pt_kstati (key, Memc[kname], KY_LENGTH)
+		Memi[KY_LEN_SELECT(key)+ncols] = len
+		ncols = ncols + 1
+
+		# Get the column name, the units and the formats.
+		call strcpy (Memc[kname], Memc[colname], SZ_COLNAME)
+		call pt_kstats (key, Memc[kname], KY_UNITSTR, Memc[colunits],
+		    SZ_COLUNITS)
+		call pt_kstats (key, Memc[kname], KY_FMTSTR, Memc[colformat],
+		    SZ_COLFMT)
+
+	        # Create the column  determining the datatype from the
+		# format string.
+		type = pt_kstati (key, Memc[kname], KY_DATATYPE)
+		if (type != TY_CHAR)
+		    call tbcdef (td, columns[ncols], Memc[colname], 
+		        Memc[colunits], Memc[colformat], type, 1, 1)
+		else
+		    call tbcdef (td, columns[ncols], Memc[colname], 
+		        Memc[colunits], Memc[colformat], -len, 1, 1)
+
+	    # The field is multi-valued.
+	    } else {
+
+		if (Memc[ranges] == EOS) {
+		    call sprintf (Memc[ranges], SZ_FNAME, "1-%d")
+			call pargi (Memi[KY_NELEMS(key)+index-1])
+		}
+		if (decode_ranges (Memc[ranges], Memi[rangeset], KY_MAXNRANGES,
+		    nelems) == ERR)
+		    call error (0, "Cannot decode ranges string")
+
+		nelems = 0
+		while (get_next_number (Memi[rangeset], nelems) != EOF) {
+		    if (nelems < 1 || nelems > Memi[KY_NELEMS(key)+index-1])
+			break
+
+		    len = pt_kstati (key, Memc[kname], KY_LENGTH)
+		    Memi[KY_SELECT(key)+ncols] = index
+		    Memi[KY_ELEM_SELECT(key)+ncols] = nelems
+		    Memi[KY_LEN_SELECT(key)+ncols] = len
+		    ncols = ncols + 1
+
+		    # Get the column name, units and format.
+		    call sprintf (Memc[colname], SZ_COLNAME, "%s[%d]")
+			call pargstr (Memc[kname])
+			call pargi (nelems)
+		    call pt_kstats (key, Memc[kname], KY_UNITSTR,
+		        Memc[colunits], SZ_COLUNITS)
+		    call pt_kstats (key, Memc[kname], KY_FMTSTR,
+		        Memc[colformat], SZ_COLFMT)
+
+	    	    # Create the column determining the datatype from the
+		    # format string.
+		    type = pt_kstati (key, Memc[kname], KY_DATATYPE)
+		    if (type != TY_CHAR)
+		        call tbcdef (td, columns[ncols], Memc[colname], 
+		            Memc[colunits], Memc[colformat], type, 1, 1)
+		    else
+		        call tbcdef (td, columns[ncols], Memc[colname], 
+		             Memc[colunits], Memc[colformat], -len, 1, 1)
+		}
+	    }
+	}
+
+	# Create the table.
+	call tbpset (td, TBL_MAXPAR, KY_NPKEYS(key))
+	call tbtcre (td)
+
+	# Free the space
+	call pt_cfnl (list)
+	call sfree (sp)
+
+	# Reallocate select buffer space
+	KY_NSELECT(key) = ncols
+	call realloc (KY_SELECT(key), KY_NSELECT(key), TY_INT)
+	call realloc (KY_ELEM_SELECT(key), KY_NSELECT(key), TY_INT)
+	call realloc (KY_LEN_SELECT(key), KY_NSELECT(key), TY_INT)
+
+	return (ncols)
+end
+
+
+# PT_APPTABLE -- Find the array of column pointers for appending to an
+# existing ST table.
+
+int procedure pt_apptable (td, key, fields, columns)
+
+pointer	td			# the table descriptor
+pointer	key			# key structure
+char	fields[ARB]		# string containing fields to include in table
+pointer columns[ARB]		# Array of pointers for columns
+
+int	max_nkeys, index, ncols, element, nelems
+pointer	list, sp, kname, aranges, ranges, rangeset, colname
+int	pt_gnfn(), strdic(), pt_ranges(), get_next_number(), decode_ranges()
+int     pt_kstati()
+pointer	pt_ofnl()
+real	asumi()
+
+begin
+	# Allocate buffer space.
+	call smark (sp)
+	call salloc (kname, KY_SZPAR, TY_CHAR)
+	call salloc (aranges, SZ_FNAME, TY_CHAR)
+	call salloc (ranges, SZ_FNAME, TY_CHAR)
+	call salloc (rangeset, 3 * KY_MAXNRANGES, TY_INT)
+	call salloc (colname, SZ_COLNAME, TY_CHAR)
+
+	# Initialize the select buffers. The select keyword, format
+	# and units string buffers are not necessary in this application.
+
+	max_nkeys = nint (asumi (Memi[KY_NELEMS(key)], KY_NKEYS(key)))
+	max_nkeys = nint (asumi (Memi[KY_NELEMS(key)], KY_NKEYS(key)))
+	if (KY_SELECT(key) != NULL)
+	    call mfree (KY_SELECT(key), TY_INT)
+	call malloc (KY_SELECT(key), max_nkeys, TY_INT)
+	if (KY_ELEM_SELECT(key) != NULL)
+	    call mfree (KY_ELEM_SELECT(key), TY_INT)
+	call malloc (KY_ELEM_SELECT(key), max_nkeys, TY_INT)
+	if (KY_LEN_SELECT(key) != NULL)
+	    call mfree (KY_LEN_SELECT(key), TY_INT)
+	call malloc (KY_LEN_SELECT(key), max_nkeys, TY_INT)
+
+	# Initialize the number of columns.
+	ncols = 0
+
+	# Initialize the list of fields.
+	ncols = 0
+	list = pt_ofnl (key, fields)
+
+	# Loop over the fields.
+	while (pt_gnfn (list, Memc[kname], Memc[aranges], KY_SZPAR) != EOF) {
+
+	    # Find the column.
+	    index = strdic (Memc[kname], Memc[kname], KY_SZPAR, 
+		Memc[KY_WORDS(key)])
+	    if (pt_ranges (Memc[aranges], Memc[ranges], element,
+	        SZ_LINE) == ERR)
+		call error (0, "Cannot decode DAOPHOT range string")
+
+	    # Skip if the column does exist in the text database.
+	    if (index == 0)
+		next
+
+	    # Skip the header keywords.
+	    else if (index <= KY_NPKEYS (key))
+ 		next
+
+	    # Convert single-valued elements.
+	    else if (Memi[KY_NELEMS(key)+index-1] == 1) {
+
+		call strcpy (Memc[kname], Memc[colname], SZ_COLNAME)
+		call tbcfnd (td, Memc[colname], columns[ncols+1], 1)
+		if (columns[ncols+1] == NULL) {
+		    call eprintf ("Column %s not found\n")
+			call pargstr (Memc[colname])
+		} else {
+		    Memi[KY_SELECT(key)+ncols] = index
+		    Memi[KY_ELEM_SELECT(key)+ncols] = 1
+		    Memi[KY_LEN_SELECT(key)+ncols] = pt_kstati (key,
+		        Memc[kname], KY_LENGTH)
+	            ncols = ncols + 1
+		}
+	    
+	    # Convert multivalued elements.
+	    } else {
+
+		if (Memc[ranges] == EOS) {
+		    call sprintf (Memc[ranges], SZ_FNAME, "1-%d")
+			call pargi (Memi[KY_NELEMS(key)+index-1])
+		}
+		if (decode_ranges (Memc[ranges], Memi[rangeset], KY_MAXNRANGES,
+		    nelems) == ERR)
+		    call error (0, "Cannot decode ranges string")
+
+		nelems = 0
+		while (get_next_number (Memi[rangeset], nelems) != EOF) {
+		    if (nelems < 1 || nelems > Memi[KY_NELEMS(key)+index-1])
+			break
+		    call sprintf (Memc[colname], SZ_COLNAME, "%s[%d]")
+			call pargstr (Memc[kname])
+			call pargi (nelems)
+		    call tbcfnd (td, Memc[colname], columns[ncols+1], 1)
+		    if (columns[ncols+1] == NULL) {
+			call eprintf ("Column %s not found\n")
+			    call pargstr (Memc[colname])
+		    } else {
+		        Memi[KY_SELECT(key)+ncols] = index
+		        Memi[KY_ELEM_SELECT(key)+ncols] = nelems
+		        Memi[KY_LEN_SELECT(key)+ncols] = pt_kstati (key,
+		            Memc[kname], KY_LENGTH)
+		        ncols = ncols + 1
+		    }
+
+		}
+	    }
+	}
+
+	# Free the space
+	call pt_cfnl (list)
+	call sfree (sp)
+
+	# Reallocate select buffer space
+	KY_NSELECT(key) = ncols
+	call realloc (KY_SELECT(key), KY_NSELECT(key), TY_INT)
+	call realloc (KY_ELEM_SELECT(key), KY_NSELECT(key), TY_INT)
+	call realloc (KY_LEN_SELECT(key), KY_NSELECT(key), TY_INT)
+
+	return (ncols)
+end