include <tbset.h>
include "spec_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 spec_obj Apr94 source
.ih
NAME
spec_obj -- Definition of a simple spectrum object.  The routines are
as follows:
.nf
sp_alloc	-- Allocate the spectrum object.
sp_free 	-- Free an object.
sp_add_point	-- Add a point to the object's arrays.
sp_grow		-- Make sure the data arrays are large enough.
sp_read_table	-- Fill an object from a table.
sp_write_table	-- Save an object to a table.

sp_dump		-- Diagnostic dump of an object's contents.
sp_new_column	-- Return a column ID for a new table column.
sp_find_column	-- Find a column.
sp_col_par	-- Get column names from a pset.
.fi
.ih
USAGE
.nf
object = sp_alloc()
call sp_free (object)
call sp_add_point (object, flux, wave, err)
call sp_grow (object, new_size)
call sp_read_table (object, name)
call sp_write_table (object, name, mode, template)

call sp_dump (object)
column_id = sp_new_column (object, table, col_name, array)
column_id = sp_find_column (object, table, col_name, array)
call sp_col_par (column_id, col_name, sz_col_name)
.fi
.ih
ARGUMENTS
.ls object [pointer]
Pointer to the simple SPectrum object.
.le
.ls flux [double]
Flux value to add to the end of the object's flux array.
.le
.ls wave [double]
Wavelength value to add to the end of the object's wavelength array.
.le
.ls err [double]
Error value to add to the end of the object's error array.
.le
.ls name [char[ARB]]
Name of the table to read/write the object's contents from/to.
.le
.ls mode [int]
The mode to open the table for writing.
.le
.ls template [pointer]
Pointer to a table descriptor with which to open the new table with.
.le
.ls column_id [pointer]
A table column descriptor.
.le
.ls table [pointer]
The table descriptor.
.le
.ls col_name [char[ARB]]
Column name to find/create.
.le
.ls array [int]
The ID of the type of data that will go into/comes from a specified
column or vector.  May be on of the following: SP_FLUX, SP_WAVE, SP_ERR.
.le
.ih
DESCRIPTION
The routines specified, along with the constants defined in
"spec_obj.h", define a Simple Spectrum Object.  The object has two
parts: the in-memory representation and a table I/O interface.

A Simple Spectrum object defines a spectrum having the following
components:  a flux array, a wavelength array, and an error array.
Also stored are the units of the flux and wavelengths.  The arrays are
accessed by the following macro definitions:

.nf
	SP_FLUX_DATA(object,i) -- The i'th value in the flux array.
        SP_WAVE_DATA(object,i) -- The i'th value in the wavelength array.
	SP_ERR_DATA(object,i)  -- The i'th value in the error array.
        SP_N(object)           -- Number of values in the arrays.
        SP_UNITS(object)       -- Units of the flux.
        SP_WUNITS(object)      -- Units of the wavelengths.
.fi
.endhelp
#---------------------------------------------------------------------------
pointer	procedure sp_alloc ()

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

begin
	# Allocate the memory structure.
	call malloc (obj, SP_SIZE, TY_STRUCT)
	call malloc (SP_UNITS_PTR(obj), SP_SZ_UNITS, TY_CHAR)
	call malloc (SP_WUNITS_PTR(obj), SP_SZ_WUNITS, TY_CHAR)
	call malloc (SP_DATA_ARRAY_PTR(obj), SP_N_COLUMNS, TY_POINTER)
	call malloc (SP_EXIST_PTR(obj), SP_N_COLUMNS, TY_INT)
	
        # Set default values.
        call strcpy ("", SP_UNITS(obj), SP_SZ_UNITS)
        call strcpy ("", SP_WUNITS(obj), SP_SZ_WUNITS)
        SP_GROW(obj) = DEFAULT_GROW
        SP_N(obj) = 0
        SP_MAX_DATA(obj) = 0
        do i = 1, SP_N_COLUMNS {
            SP_DATA_ARRAY(obj,i) = NULL
	    SP_EXIST(obj,i) = NO
        }

        # That's all folks.
        return (obj)
end
#---------------------------------------------------------------------------
# end of sp_alloc
#---------------------------------------------------------------------------
procedure sp_free (obj)

pointer	obj			# IO: SP sp object, NULL on return.

int	i			# Generic.

begin
	# Free the memory.
	do i = 1, SP_N_COLUMNS
	    call mfree (SP_DATA_ARRAY(obj,i), TY_DOUBLE)

	call mfree (SP_EXIST_PTR(obj), TY_INT)
	call mfree (SP_DATA_ARRAY_PTR(obj), TY_POINTER)
	call mfree (SP_WUNITS_PTR(obj), TY_CHAR)
	call mfree (SP_UNITS_PTR(obj), TY_CHAR)
	call mfree (obj, TY_STRUCT)
end
#---------------------------------------------------------------------------
# end of sp_free
#---------------------------------------------------------------------------
procedure sp_add_point (obj, flux, wave, err)

pointer	obj			# I:  SP output sp descriptor.
double	flux			# I:  Flux.
double	wave			# I:  Wave.
double	err			# I:  Error.

begin
        call sp_grow (obj, SP_N(obj) + 1)
	SP_FLUX_DATA(obj,SP_N(obj)) = flux
	SP_WAVE_DATA(obj,SP_N(obj)) = wave
	SP_ERR_DATA(obj,SP_N(obj)) = err
end
#---------------------------------------------------------------------------
# End of sp_add_point
#---------------------------------------------------------------------------
procedure sp_grow (obj, size)

pointer	obj			# I:  SP object.
int	size			# I:  Size to grow to.

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

begin
	SP_N(obj) = size
	
	# See if growth is needed.
	new_max = false
	while (SP_MAX_DATA(obj) <= SP_N(obj)) {
	    new_max = true
	    SP_MAX_DATA(obj) = SP_MAX_DATA(obj) + SP_GROW(obj)
	}

	# If the max has changed, reallocate the arrays.
	if (new_max)
	    do i = 1, SP_N_COLUMNS
		call realloc (SP_DATA_ARRAY(obj,i), SP_MAX_DATA(obj),
			      TY_DOUBLE)
end
#---------------------------------------------------------------------------
# End of sp_grow
#---------------------------------------------------------------------------
procedure sp_dump (obj)

pointer	obj			# I:  SP object.

int	i, j			# Generic.

begin
	# Write various single values.
	call printf ("spec_obj: The units is %s.\n")
	call pargstr (SP_UNITS(obj))
	call printf ("spec_obj: the wunits is %s.\n")
	call pargstr (SP_WUNITS(obj))
	call printf ("spec_obj: Number of points = %d.\n")
	call pargi (SP_N(obj))
	call printf ("spec_obj: max data = %d, grow = %d.\n")
	call pargi (SP_MAX_DATA(obj))
	call pargi (SP_GROW(obj))	
	
	# Write out the column information.
	do i = 1, SP_N_COLUMNS {
	    if (SP_EXIST(obj,i) == YES) {
		call printf ("spec_obj: Data %s is ")
		switch (i) {
		case SP_FLUX: call pargstr ("flux")
		case SP_WAVE: call pargstr ("wave")
		case SP_ERR: call pargstr ("err")
		}	
		do j = 1, min(3,SP_N(obj)) {
		    call printf ("%g ")
		    call pargd (Memd[SP_DATA_ARRAY(obj,i)+j-1])
		}
		call printf ("\n")
	    }
	}
end
#---------------------------------------------------------------------------
# End of sp_dump
#---------------------------------------------------------------------------
procedure sp_read_table (obj, name)

pointer	obj			# I:  SP 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 sp_grow (obj, tbpsta (table, TBL_NROWS))
	call salloc (null, SP_N(obj), TY_BOOL)

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

	    # Get the column name.
	    call sp_col_par (i, Col_name, SZ_COLNAME)
	    
	    # 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 {
		    SP_EXIST(obj,i) = YES
		    switch (i) {	
		    case SP_WAVE:	
			call tbcgtd (table, col_id, Memd[SP_DATA_ARRAY(obj,i)],
				     Null, 1, SP_N(obj))
			call tbcigt (col_id, TBL_COL_UNITS, SP_WUNITS(obj),
				     SP_SZ_WUNITS)

		    case SP_FLUX:
			call tbcgtd (table, col_id, Memd[SP_DATA_ARRAY(obj,i)],
				     Null, 1, SP_N(obj))
			call tbcigt (col_id, TBL_COL_UNITS, SP_UNITS(obj),
				     SP_SZ_UNITS)
		    }
		}
	    }
	}

	# That's all folks.
	call tbtclo (table)
	call sfree (sp)
end
#---------------------------------------------------------------------------
# End of sp_read_table
#---------------------------------------------------------------------------
procedure sp_write_table (obj, name, mode, template)

pointer obj			# I:  SP 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	sp_find_column()	# Find a column.
pointer	sp_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.
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, SP_N(obj))
	    call tbpset (table, TBL_MAXCOLS, SP_N_COLUMNS)
	    call tbtcre (table)
	}
	n_rows = tbpsta (table, TBL_NROWS)
	
	# Write each array of data.
	do i = 1, SP_N_COLUMNS {
	    if (SP_EXIST(obj,i) == YES) {

		# Get the column name.
		call sp_col_par (i, Col_name, SZ_COLNAME)
		
		# Find/define the column
		if (mode == NEW_FILE)
		    col_id = sp_new_column (obj, table, Col_name, i)
		else
		    col_id = sp_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 ("spec_obj: could not write column %s.\n")
		    call pargstr (Col_name)
		}
		
		# Else write the data.
		else {
		    call tbcptd (table, col_id, Memd[SP_DATA_ARRAY(obj,i)],
				 n_rows + 1, n_rows + SP_N(obj))
		}
	    }
	}

	# That's all folks.
	call tbtclo (table)
	call sfree (sp)
end
#---------------------------------------------------------------------------
# End of sp_write_table
#---------------------------------------------------------------------------
pointer procedure sp_new_column (obj, table, col_name, array)

pointer	obj			# I:  SP 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 SP_WAVE:
	    call tbcdef (table, col_id, col_name, SP_WUNITS(obj),
			 "", TY_DOUBLE, 1, 1)
	case SP_FLUX, SP_ERR:
	    call tbcdef (table, col_id, col_name, SP_UNITS(obj),
			 "", TY_INT, 1, 1)
	}

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

pointer	obj			# I:  SP 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 SP_WAVE:
		    if (strlen (SP_WUNITS(obj)) > 0)
			bad_units = strne (SP_WUNITS(obj), Sx)
		case SP_FLUX:
		    if (strlen (SP_UNITS(obj)) > 0)
			bad_units = strne (SP_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 sp_find_column
#---------------------------------------------------------------------------
procedure sp_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 SP_FLUX:
	    call strcpy ("spcolnames.flux", Par_name, SZ_COMMAND)
	case SP_WAVE:
	    call strcpy ("spcolnames.wave", Par_name, SZ_COMMAND)
	case SP_ERR:
	    call strcpy ("spcolnames.err", Par_name, SZ_COMMAND)
	}
	call clgstr (Par_name, col_name, sz_col_name)

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