include <tbset.h>
include "cf_obj.h"

# Memory management.
define	Col_name		Memc[col_name]
define	Null			Memb[null]
define	Par_name		Memc[par_name]
define	SZ_TMPSTRING		SZ_COMMAND
define	Sx			Memc[sx]
define	Sy			Memc[sy]
define	DEFAULT_GROW		2000

#---------------------------------------------------------------------------
.help cf_obj Apr94 source
.ih
NAME
cf_obj -- Definition of the centerflux object.
.endhelp
#---------------------------------------------------------------------------
pointer	procedure cf_alloc ()

pointer	obj			# The centerflux results object.
int	i			# Generic.

begin
	# Allocate the memory structure.
	call malloc (obj, CF_SIZE, TY_STRUCT)
	call malloc (CF_GRATING_PTR(obj), CF_SZ_GRATING, TY_CHAR)
	call malloc (CF_APERTURE_PTR(obj), CF_SZ_APERTURE, TY_CHAR)
	call malloc (CF_UNITS_PTR(obj), CF_SZ_UNITS, TY_CHAR)
	call malloc (CF_WUNITS_PTR(obj), CF_SZ_WUNITS, TY_CHAR)
	call malloc (CF_DATA_ARRAY_PTR(obj), CF_N_COLUMNS, TY_POINTER)
	call malloc (CF_EXIST_PTR(obj), CF_N_COLUMNS, TY_INT)
	
        # Set default values.
        call strcpy ("", CF_GRATING(obj), CF_SZ_GRATING)
        call strcpy ("", CF_APERTURE(obj), CF_SZ_APERTURE)
        call strcpy ("", CF_UNITS(obj), CF_SZ_UNITS)
        call strcpy ("", CF_WUNITS(obj), CF_SZ_WUNITS)
        CF_GROW(obj) = DEFAULT_GROW
        CF_N(obj) = 0
        CF_MAX_DATA(obj) = 0
        do i = 1, CF_N_COLUMNS {
            CF_DATA_ARRAY(obj,i) = NULL
	    CF_EXIST(obj,i) = NO
        }

        # That's all folks.
        return (obj)
end
#---------------------------------------------------------------------------
# end of cf_alloc
#---------------------------------------------------------------------------
procedure cf_free (obj)

pointer	obj			# IO: CF cf object, NULL on return.

int	i			# Generic.

begin
	# Free the memory.
	do i = 1, CF_N_COLUMNS
	    switch (i) {
	    case CF_CARPOS, CF_ORDER, CF_NPTS:
		call mfree (CF_DATA_ARRAY(obj,i), TY_INT)
	    default:
		call mfree (CF_DATA_ARRAY(obj,i), TY_DOUBLE)
	    }	

	call mfree (CF_EXIST_PTR(obj), TY_INT)
	call mfree (CF_DATA_ARRAY_PTR(obj), TY_POINTER)
	call mfree (CF_WUNITS_PTR(obj), TY_CHAR)
	call mfree (CF_UNITS_PTR(obj), TY_CHAR)
	call mfree (CF_APERTURE_PTR(obj), TY_CHAR)
	call mfree (CF_GRATING_PTR(obj), TY_CHAR)
	call mfree (obj, TY_STRUCT)
end
#---------------------------------------------------------------------------
# end of cf_free
#---------------------------------------------------------------------------
procedure cf_add_point (obj, carpos, order, wlow, whigh,
                        flux, err, npts)

pointer	obj			# I:  CF output cf descriptor.
int	carpos			# I:  Carrousel position.
int	order			# I:  Spectral order.
double	wlow			# I:  Low end wavelength.
double	whigh			# I:  High end wavelength.
double	flux			# I:  Mean flux.
double	err			# I:  Standard deviation.
int	npts			# I:  Number of points in the flux average.

begin
        call cf_grow (obj, CF_N(obj)+1)
	CF_CARPOS_DATA(obj,CF_N(obj)) = carpos
	CF_ORDER_DATA(obj,CF_N(obj)) = order
	CF_WLOW_DATA(obj,CF_N(obj)) = wlow
	CF_WHIGH_DATA(obj,CF_N(obj)) = whigh
	CF_FLUX_DATA(obj,CF_N(obj)) = flux
	CF_ERR_DATA(obj,CF_N(obj)) = err
	CF_NPTS_DATA(obj,CF_N(obj)) = npts
end
#---------------------------------------------------------------------------
# End of cf_add_point
#---------------------------------------------------------------------------
procedure cf_grow (obj, size)

pointer	obj			# I:  CF object.
int	size			# I:  New size.

int	i			# Generic.
bool	new_max			# True to reallocate the arrays.

begin
	CF_N(obj) = size
	
	# See if growth is needed.
        new_max = false
	while (CF_MAX_DATA(obj) <= CF_N(obj)) {
            new_max = true
	    CF_MAX_DATA(obj) = CF_MAX_DATA(obj) + CF_GROW(obj)
        }

        # If the max has changed, reallocate the arrays.
        if (new_max)
            do i = 1, CF_N_COLUMNS
		switch (i) {
		case CF_CARPOS, CF_ORDER, CF_NPTS:
		    call realloc (CF_DATA_ARRAY(obj,i), CF_MAX_DATA(obj),
				  TY_INT)
		default:
		    call realloc (CF_DATA_ARRAY(obj,i), CF_MAX_DATA(obj),
				  TY_DOUBLE)
		}
end
#---------------------------------------------------------------------------
# End of cf_grow
#---------------------------------------------------------------------------
procedure cf_dump (obj)

pointer	obj			# I:  CF object.

int	i, j			# Generic.

begin
	# Write various single values.
	call printf ("cf_obj: The grating name is %s.\n")
	call pargstr (CF_GRATING(obj))
	call printf ("cf_obj: The aperture name is %s.\n")
	call pargstr (CF_APERTURE(obj))
	call printf ("cf_obj: The units is %s.\n")
	call pargstr (CF_UNITS(obj))
	call printf ("cf_obj: the wunits is %s.\n")
	call pargstr (CF_WUNITS(obj))
	call printf ("cf_obj: Number of points = %d.\n")
	call pargi (CF_N(obj))
	call printf ("cf_obj: max data = %d, grow = %d.\n")
	call pargi (CF_MAX_DATA(obj))
	call pargi (CF_GROW(obj))	
	
	# Write out the column information.
	do i = 1, CF_N_COLUMNS {
	    if (CF_EXIST(obj,i) == YES) {
		call printf ("cf_obj: Data %s is ")
		switch (i) {
		case CF_CARPOS: call pargstr ("carpos")
		case CF_ORDER: call pargstr ("order")
		case CF_WLOW: call pargstr ("wlow")
		case CF_WHIGH: call pargstr ("whigh")
		case CF_FLUX: call pargstr ("flux")
		case CF_ERR: call pargstr ("err")
		case CF_NPTS: call pargstr ("npts")
		}	
		do j = 1, min(3,CF_N(obj)) {
		    call printf ("%g ")
		    switch (i) {
		    case CF_CARPOS, CF_ORDER, CF_NPTS:
			call pargi (Memi[CF_DATA_ARRAY(obj,i)+j-1])
		    default:
			call pargd (Memd[CF_DATA_ARRAY(obj,i)+j-1])
		    }	
		}
		call printf ("\n")
	    }
	}
end
#---------------------------------------------------------------------------
# End of cf_dump
#---------------------------------------------------------------------------
procedure cf_read_table (obj, name)

pointer	obj			# I:  CF object.
char	name[ARB]		# I:  Name of table to read from.

# Declarations.
pointer	col_id			# Column id.
pointer	col_name		# Column name.
int	i			# Generic.
pointer	null			# Null flag.
pointer	sp			# Stack pointer.
pointer	strlen()		# Get string length.
pointer	table			# Table descriptor.
int	tbpsta()		# Get table status.
pointer	tbtopn()		# Open a table.

begin
	call smark (sp)
	call salloc (col_name, SZ_COMMAND, TY_CHAR)
	
	# Open the table.
	table = tbtopn (name, READ_ONLY, NULL)
	call cf_grow (obj, tbpsta (table, TBL_NROWS))
	call salloc (null, CF_N(obj), TY_BOOL)

	# Read each column.
	do i = 1, CF_N_COLUMNS {

	    # Get the column name.
	    call cf_col_par (i, Col_name, SZ_COMMAND)

	    # Find column.
	    if (strlen (Col_name) > 0) {
		call tbcfnd (table, Col_name, col_id, 1)
		if (col_id == NULL) {
		    call eprintf ("warning: column %s not found in table %s, no data read.\n")
		    call pargstr (Col_name)
		    call pargstr (name)
		}

		# Get data from table.
		else {
		    CF_EXIST(obj,i) = YES
		    switch (i) {	
		    case CF_CARPOS, CF_ORDER, CF_NPTS:
			call tbcgti (table, col_id, Memi[CF_DATA_ARRAY(obj,i)],
				     Null, 1, CF_N(obj))

		    case CF_WLOW, CF_WHIGH:	
			call tbcgtd (table, col_id, Memd[CF_DATA_ARRAY(obj,i)],
				     Null, 1, CF_N(obj))
			call tbcigt (col_id, TBL_COL_UNITS, CF_WUNITS(obj),
				     CF_SZ_WUNITS)

		    case CF_FLUX:
			call tbcgtd (table, col_id, Memd[CF_DATA_ARRAY(obj,i)],
				     Null, 1, CF_N(obj))
			call tbcigt (col_id, TBL_COL_UNITS, CF_UNITS(obj),
				     CF_SZ_UNITS)

		    default:
			call tbcgtd (table, col_id, Memd[CF_DATA_ARRAY(obj,i)],
				     Null, 1, CF_N(obj))
		    }
		}
	    }
	}

	# Get aperture/grating modes.
	call tbhgtt (table, "aperture", CF_APERTURE(obj), CF_SZ_APERTURE)
	call tbhgtt (table, "grating", CF_GRATING(obj), CF_SZ_GRATING)
	
	# That's all folks.
	call tbtclo (table)
	call sfree (sp)
end
#---------------------------------------------------------------------------
# End of cf_read_table
#---------------------------------------------------------------------------
procedure cf_write_table (obj, name, mode, template)

pointer obj			# I:  CF object
char	name[ARB]		# I:  Name of table to write to.
int	mode			# I:  Mode to open table.
pointer	template		# I:  Table descriptor to use as template.

pointer	cf_find_column()	# Find a column.
pointer	cf_new_column()		# Define a new column.
pointer	col_id			# Column id.
pointer	col_name		# Column name.
int	i			# Generic.
int	n_rows			# Number of rows in table.
pointer	sp			# Stack pointer.
int	strlen()		# String length.
bool	strne()			# Strings not equal?
pointer	sx			# Generic string.
pointer	table			# Table descriptor.
int	tbpsta()		# Table status.
pointer	tbtopn()		# Open table.

begin
	call smark (sp)
	call salloc (sx, SZ_TMPSTRING, TY_CHAR)
	call salloc (col_name, SZ_COLNAME, TY_CHAR)
	
	# Open the table.
	table = tbtopn (name, mode, template)
	if (mode == NEW_FILE) {
	    call tbpset (table, TBL_ALLROWS, CF_N(obj))
	    call tbpset (table, TBL_MAXCOLS, CF_N_COLUMNS)
	    call tbtcre (table)
	}
	n_rows = tbpsta (table, TBL_NROWS)
	
	# If table already exists, check aperture and grating.
	if (mode != NEW_FILE) {
	    call tbhgtt (table, "aperture", Sx, SZ_TMPSTRING)
	    if (strlen (Sx) > 0 && strlen (CF_APERTURE(obj)) > 0)
		if (strne (Sx, CF_APERTURE(obj)))
		    call error (1, "apertures do not match between data and output table")

	    call tbhgtt (table, "grating", Sx, SZ_TMPSTRING)
	    if (strlen (Sx) > 0 && strlen (CF_GRATING(obj)) > 0)
		if (strne (Sx, CF_GRATING(obj)))
		    call error (1, "gratings do not match between data and output table")
	}

	# Else, write the aperture and grating
	else {
	    call tbhadt (table, "aperture", CF_APERTURE(obj))
	    call tbhadt (table, "grating", CF_GRATING(obj))
	}

	# Write each array of data.
	do i = 1, CF_N_COLUMNS {
	    if (CF_EXIST(obj,i) == YES) {
		
		# Get the column name.
		call cf_col_par (i, Col_name, SZ_COLNAME)

		# Find/define the column
		if (mode == NEW_FILE)
		    col_id = cf_new_column (obj, table, Col_name, i)
		else
		    col_id = cf_find_column (obj, table, Col_name, i)

		# Write a warning if the column could not be allocated
		# in the table.
		if (col_id == NULL) {
		    call eprintf ("cf_obj: could not write column %s.\n")
		    call pargstr (Col_name)
		}
		
		# Else write the data.
		else {
		    switch (i) {
		    case CF_CARPOS, CF_ORDER, CF_NPTS:
			call tbcpti (table, col_id, Memi[CF_DATA_ARRAY(obj,i)],
				     n_rows + 1, n_rows + CF_N(obj))
		    default:
			call tbcptd (table, col_id, Memd[CF_DATA_ARRAY(obj,i)],
				     n_rows + 1, n_rows + CF_N(obj))
		    }
		}
	    }
	}
	    
	# That's all folks.
	call tbtclo (table)
	call sfree (sp)
end
#---------------------------------------------------------------------------
# End of cf_write_table
#---------------------------------------------------------------------------
pointer procedure cf_new_column (obj, table, col_name, array)

pointer	obj			# I:  CF object.
pointer	table			# I:  Table descriptor.
char	col_name[ARB]		# I:  Name of column.
int	array			# I:  The data that will go in this column.

pointer	col_id			# Column id.

begin
	switch (array) {
	case CF_CARPOS:
	    call tbcdef (table, col_id, col_name, "encoder units",
			 "", TY_INT, 1, 1)
	case CF_ORDER, CF_NPTS:
	    call tbcdef (table, col_id, col_name, "",
			 "", TY_INT, 1, 1)
	case CF_WLOW, CF_WHIGH:
	    call tbcdef (table, col_id, col_name, CF_WUNITS(obj),
			 "", TY_DOUBLE, 1, 1)
	case CF_FLUX, CF_ERR:
	    call tbcdef (table, col_id, col_name, CF_UNITS(obj),
			 "", TY_DOUBLE, 1, 1)
	}

	# That's all folks.
	return (col_id)
end
#---------------------------------------------------------------------------
# End of cf_new_column
#---------------------------------------------------------------------------
pointer procedure cf_find_column (obj, table, col_name, array)

pointer	obj			# I:  CF object.
pointer	table			# I:  Table descriptor.
char	col_name[ARB]		# I:  Name of column.
int	array			# I:  The data that will go in this column.

pointer	col_id			# Column id.
bool	bad_units			# True if units don't match.
pointer	sp			# Stack pointer.
int	strlen()		# Length of string.
bool	strne()			# Strings not equal?
pointer	sx			# Generic string.

begin
	call smark (sp)
	call salloc (sx, SZ_TMPSTRING, TY_CHAR)
	
	# Find the column id.
	call tbcfnd (table, col_name, col_id, 1)

	# If there is such a column, check units
	if (col_id != NULL) {
	    call tbcigt (col_id, TBL_COL_UNITS, Sx, SZ_COLUNITS)
	    bad_units = false
	    if (strlen (Sx) > 0) {
		switch (array) {
		case CF_CARPOS:
		    call strlwr (Sx)
		    bad_units = strne ("encoder units", Sx)
		case CF_WLOW, CF_WHIGH:
		    if (strlen (CF_WUNITS(obj)) > 0)
			bad_units = strne (CF_WUNITS(obj), Sx)
		case CF_FLUX:
		    if (strlen (CF_UNITS(obj)) > 0)
			bad_units = strne (CF_UNITS(obj), Sx)
		}
		if (bad_units) {
		    call eprintf ("warning: units for column %s does not match between data and table\n")
		    call pargstr (col_name)
		}
	    }
	}

	# That's all folks.
	call sfree (sp)
	return (col_id)
end
#---------------------------------------------------------------------------
# End of cf_find_column
#---------------------------------------------------------------------------
procedure cf_col_par (column, col_name, sz_col_name)

int	column			# I:  CF object column indicator.
char	col_name[sz_col_name]	# O:  The column name to use.
int	sz_col_name		# I:  Maximum length of name.

pointer	par_name		# Parameter name.
pointer	sp			# Stack pointer.

begin
	call smark (sp)
	call salloc (par_name, SZ_COMMAND, TY_CHAR)
	
	switch (column) {
	case CF_CARPOS:
	    call strcpy ("cfcolnames.carpos", Par_name, SZ_COMMAND)
	case CF_ORDER:
	    call strcpy ("cfcolnames.order", Par_name, SZ_COMMAND)
	case CF_WLOW:
	    call strcpy ("cfcolnames.wlow", Par_name, SZ_COMMAND)
	case CF_WHIGH:
	    call strcpy ("cfcolnames.whigh", Par_name, SZ_COMMAND)
	case CF_FLUX:
	    call strcpy ("cfcolnames.flux", Par_name, SZ_COMMAND)
	case CF_ERR:
	    call strcpy ("cfcolnames.err", Par_name, SZ_COMMAND)
	case CF_NPTS:
	    call strcpy ("cfcolnames.npts", Par_name, SZ_COMMAND)
	}
	call clgstr (Par_name, col_name, sz_col_name)

	call sfree (sp)
end
#---------------------------------------------------------------------------
# End of cf_col_par 
#---------------------------------------------------------------------------