include "icfit.h"

# Thuis file contains procedures for opening, closing and accessing
# the parameter structure.

# IC_OPEN -- Open ICFIT parameter structure.

procedure ic_open (ic)

pointer	ic		# ICFIT pointer
#--

begin
	# Allocate memory for the package parameter structure.
	call malloc (ic, IC_LENSTRUCT, TY_STRUCT)
	call malloc (IC_SAMPLE(ic), SZ_LINE, TY_CHAR)
	call malloc (IC_LABELS(ic,1), SZ_LINE, TY_CHAR)
	call malloc (IC_LABELS(ic,2), SZ_LINE, TY_CHAR)
	call malloc (IC_UNITS(ic,1), SZ_LINE, TY_CHAR)
	call malloc (IC_UNITS(ic,2), SZ_LINE, TY_CHAR)
	call malloc (IC_HELP(ic), SZ_FNAME, TY_CHAR)

	# Set defaults
	call ic_pstr (ic, "function", "powerlaw")
	call ic_puti (ic, "npar", 3)
	call ic_pstr (ic, "sample", "*")
	call ic_puti (ic, "naverage", 1)
	call ic_puti (ic, "niterate", 0)
	call ic_putr (ic, "low", 3.)
	call ic_putr (ic, "high", 3.)
	call ic_putr (ic, "grow", 0.)
	call ic_putr (ic, "mag0", 0.)
	call ic_pstr (ic, "xlabel", "X")
	call ic_pstr (ic, "ylabel", "Y")
	call ic_pstr (ic, "xunits", "")
	call ic_pstr (ic, "yunits", "")
	call ic_pstr (ic, "help", IC_DEFHELP)
	call ic_puti (ic, "key", 1)
	call ic_puti (ic, "pcomp", NO)
	call ic_puti (ic, "xaxis", IC_LINEAR)
	call ic_puti (ic, "yaxis", IC_LINEAR)
	call ic_puti (ic, "ltype", IC_CONTINUOUS)
	call ic_pkey (ic, 1, 'x', 'y')
	call ic_pkey (ic, 2, 'y', 'x')
	call ic_pkey (ic, 3, 'x', 'r')
	call ic_pkey (ic, 4, 'x', 'd')
	call ic_pkey (ic, 5, 'x', 'n')

	# Initialize other parameters
	IC_OVERPLOT(ic) = NO
	IC_FITERROR(ic) = NO
	IC_RG(ic) = NULL
	IC_XFIT(ic) = NULL
	IC_YFIT(ic) = NULL
	IC_WTSFIT(ic) = NULL
	IC_REJPTS(ic) = NULL
end


# IC_COPY -- Copy an ICFIT structure.
# The output pointer must be allocated already.

procedure ic_copy (icin, icout)

pointer	icin		# Input ICFIT pointer to copy
pointer	icout		# Ouput ICFIT pointer
#--
begin
	IC_FUNCTION(icout) = IC_FUNCTION(icin)
	IC_NPAR(icout) = IC_NPAR(icin)
	IC_NAVERAGE(icout) = IC_NAVERAGE(icin)
	IC_NITERATE(icout) = IC_NITERATE(icin)
	IC_XMIN(icout) = IC_XMIN(icin)
	IC_XMAX(icout) = IC_XMAX(icin)
	IC_LOW(icout) = IC_LOW(icin)
	IC_HIGH(icout) = IC_HIGH(icin)
	IC_GROW(icout) = IC_GROW(icin)
	IC_GKEY(icout) = IC_GKEY(icin)
	IC_COMP(icout) = IC_COMP(icin)
	IC_XAXIS(icout) = IC_XAXIS(icin)
	IC_YAXIS(icout) = IC_YAXIS(icin)

	call strcpy (Memc[IC_SAMPLE(icin)], Memc[IC_SAMPLE(icout)], SZ_LINE)
	call strcpy (Memc[IC_LABELS(icin,1)], Memc[IC_LABELS(icout,1)], SZ_LINE)
	call strcpy (Memc[IC_LABELS(icin,2)], Memc[IC_LABELS(icout,2)], SZ_LINE)
	call strcpy (Memc[IC_UNITS(icin,1)], Memc[IC_UNITS(icout,1)], SZ_LINE)
	call strcpy (Memc[IC_UNITS(icin,2)], Memc[IC_UNITS(icout,2)], SZ_LINE)
	call strcpy (Memc[IC_HELP(icin)], Memc[IC_HELP(icout)], SZ_LINE)

	call amovi (IC_AXES(icin,1,1), IC_AXES(icout,1,1), 10)

	IC_RG(icout) = NULL
	IC_XFIT(icout) = NULL
	IC_YFIT(icout) = NULL
	IC_WTSFIT(icout) = NULL
	IC_REJPTS(icout) = NULL
end


# IC_CLOSE -- Close ICFIT parameter structure.

procedure ic_close (ic)

pointer	ic		# ICFIT pointer
#--

begin
	if (ic != NULL) {
	    # Free memory for the package parameter structure.
	    call rg_free (IC_RG(ic))
	    call mfree (IC_XFIT(ic), TY_REAL)
	    call mfree (IC_YFIT(ic), TY_REAL)
	    call mfree (IC_WTSFIT(ic), TY_REAL)
	    call mfree (IC_REJPTS(ic), TY_INT)
	    call mfree (IC_SAMPLE(ic), TY_CHAR)
	    call mfree (IC_LABELS(ic,1), TY_CHAR)
	    call mfree (IC_LABELS(ic,2), TY_CHAR)
	    call mfree (IC_UNITS(ic,1), TY_CHAR)
	    call mfree (IC_UNITS(ic,2), TY_CHAR)
	    call mfree (IC_HELP(ic), TY_CHAR)
	    call mfree (ic, TY_STRUCT)
	}
end


# IC_PSTR -- Put string valued parameters.

procedure ic_pstr (ic, param, str)

pointer	ic			# ICFIT pointer
char	param[ARB]		# Parameter to be put
char	str[ARB]		# String value
#--

int	i
pointer	ptr

int	strdic()
bool	streq()

begin
	if (streq (param, "sample"))
	    call strcpy (str, Memc[IC_SAMPLE(ic)], SZ_LINE)
	else if (streq (param, "function")) {
	    call malloc (ptr, SZ_LINE, TY_CHAR)
	    i = strdic (str, Memc[ptr], SZ_LINE, FUNCTIONS)
	    if (i > 0)
		IC_FUNCTION(ic) = i
	    call mfree (ptr, TY_CHAR)
	} else if (streq (param, "algorithm")) {
	    call malloc (ptr, SZ_LINE, TY_CHAR)
	    i = strdic (str, Memc[ptr], SZ_LINE, METHODS)
	    if (i > 0)
		IC_METHOD(ic) = i
	    call mfree (ptr, TY_CHAR)
	} else if (streq (param, "xlabel"))
	    call strcpy (str, Memc[IC_LABELS(ic,1)], SZ_LINE)
	else if (streq (param, "ylabel"))
	    call strcpy (str, Memc[IC_LABELS(ic,2)], SZ_LINE)
	else if (streq (param, "xunits"))
	    call strcpy (str, Memc[IC_UNITS(ic,1)], SZ_LINE)
	else if (streq (param, "yunits"))
	    call strcpy (str, Memc[IC_UNITS(ic,2)], SZ_LINE)
	else if (streq (param, "help"))
	    call strcpy (str, Memc[IC_HELP(ic)], SZ_LINE)
	else
	    call error (0, "ICFIT: Unknown parameter")
end


# IC_PUTI -- Put integer valued parameters.

procedure ic_puti (ic, param, ival)

pointer	ic			# ICFIT pointer
char	param[ARB]		# Parameter to be put
int	ival			# Integer value
#--

bool	streq()

begin
	if (streq (param, "naverage"))
	    IC_NAVERAGE(ic) = ival
	else if (streq (param, "npar"))
	    IC_NPAR(ic) = ival
	else if (streq (param, "niterate"))
	    IC_NITERATE(ic) = ival
	else if (streq (param, "key"))
	    IC_GKEY(ic) = ival
	else if (streq (param, "pcomp"))
	    IC_COMP(ic) = ival
	else if (streq (param, "xaxis"))
	    IC_XAXIS(ic) = ival
	else if (streq (param, "yaxis"))
	    IC_YAXIS(ic) = ival
	else if (streq (param, "ltype"))
	    IC_LTYPE(ic) = ival
	else
	    call error (0, "ICFIT: Unknown parameter")
end


# IC_PKEY -- Put key parameters.
# Note the key types must be integers not characters.

procedure ic_pkey (ic, key, xaxis, yaxis)

pointer	ic			# ICFIT pointer
int	key			# Key to be defined
int	xaxis			# X axis type
int	yaxis			# Y axis type
#--

begin
	IC_AXES(ic, key, 1) = xaxis
	IC_AXES(ic, key, 2) = yaxis
end


# IC_GKEY -- Get key parameters.

procedure ic_gkey (ic, key, xaxis, yaxis)

pointer	ic			# ICFIT pointer
int	key			# Key to be gotten
int	xaxis			# X axis type
int	yaxis			# Y axis type
#--

begin
	xaxis = IC_AXES(ic, key, 1)
	yaxis = IC_AXES(ic, key, 2)
end


# IC_PUTR -- Put real valued parameters.

procedure ic_putr (ic, param, rval)

pointer	ic			# ICFIT pointer
char	param[ARB]		# Parameter to be put
real	rval			# Real value
#--

bool	streq()

begin
	if (streq (param, "xmin"))
	    IC_XMIN(ic) = rval
	else if (streq (param, "xmax"))
	    IC_XMAX(ic) = rval
	else if (streq (param, "low"))
	    IC_LOW(ic) = rval
	else if (streq (param, "high"))
	    IC_HIGH(ic) = rval
	else if (streq (param, "grow"))
	    IC_GROW(ic) = rval
	else if (streq (param, "mag0"))
	    IC_MAG0(ic) = rval
	else
	    call error (0, "ICFIT: Unknown parameter")
end


# IC_GETI -- Get integer valued parameters.

int procedure ic_geti (ic, param)

pointer	ic			# ICFIT pointer
char	param[ARB]		# Parameter to be gotten
#--

bool	streq()

begin
	if (streq (param, "naverage"))
	    return (IC_NAVERAGE(ic))
	else if (streq (param, "npar"))
	    return (IC_NPAR(ic))
	else if (streq (param, "niterate"))
	    return (IC_NITERATE(ic))
	else if (streq (param, "key"))
	    return (IC_GKEY(ic))
	else if (streq (param, "pcomp"))
	    return (IC_COMP(ic))
	else if (streq (param, "xaxis"))
	    return (IC_XAXIS(ic))
	else if (streq (param, "yaxis"))
	    return (IC_YAXIS(ic))
	else if (streq (param, "ltype"))
	    return (IC_LTYPE(ic))

	call error (0, "ICFIT: Unknown parameter")
end


# IC_GETR -- Get real valued parameters.

real procedure ic_getr (ic, param)

pointer	ic			# ICFIT pointer
char	param[ARB]		# Parameter to be put
#--

bool	streq()

begin
	if (streq (param, "xmin"))
	    return (IC_XMIN(ic))
	else if (streq (param, "xmax"))
	    return (IC_XMAX(ic))
	else if (streq (param, "low"))
	    return (IC_LOW(ic))
	else if (streq (param, "high"))
	    return (IC_HIGH(ic))
	else if (streq (param, "grow"))
	    return (IC_GROW(ic))
	else if (streq (param, "mag0"))
	    return (IC_MAG0(ic))

	call error (0, "ICFIT: Unknown parameter")
end


# IC_GSTR -- Get string valued parameters.

procedure ic_gstr (ic, param, str, maxchars)

pointer	ic			# ICFIT pointer
char	param[ARB]		# Parameter to be gotten
char	str[maxchars]		# String value
int	maxchars		# Maximum number of characters
#--

bool	streq()

begin
	if (streq (param, "sample"))
	    call strcpy (Memc[IC_SAMPLE(ic)], str, maxchars)
	else if (streq (param, "xlabel"))
	    call strcpy (Memc[IC_LABELS(ic,1)], str, maxchars)
	else if (streq (param, "ylabel"))
	    call strcpy (Memc[IC_LABELS(ic,2)], str, maxchars)
	else if (streq (param, "xunits"))
	    call strcpy (Memc[IC_UNITS(ic,1)], str, maxchars)
	else if (streq (param, "yunits"))
	    call strcpy (Memc[IC_UNITS(ic,2)], str, maxchars)
	else if (streq (param, "help"))
	    call strcpy (Memc[IC_HELP(ic)], str, maxchars)
	else if (streq (param, "function"))
	    call ic_dent (FUNCTIONS, IC_FUNCTION(ic), str, maxchars)
	else if (streq (param, "algorithm"))
	    call ic_dent (METHODS, IC_METHOD(ic), str, maxchars)
	else
	    call error (0, "ICFIT: Unknown parameter")
end


# IC_DENT -- Get a dictionary entry, given the index. The string separation
# character in the dictionary is assumed to be its first character (same
# format as used in strdic). Actually, this routine performs the inverse
# operation found in iraf$sys/fmtio/strdic.x.

procedure ic_dent (dic, index, outstr, maxchars)

char	dic[ARB]		#i: dictionary string
int	index			#i: index of string to get
char	outstr[ARB]		#o: output string
int	maxchars		#i: max. size of output string

int	i, j

begin
	if ((dic[1] == EOS) || (index == 0)) {
	    outstr[1] = EOS
	    return
	}

	# find entry
	i = 1
	j = 0
	while (j < index) {
	    while (dic[i] != dic[1]) {
	        i = i + 1
	        if (dic[i] == EOS) {
	            outstr[1] = EOS
	            return
	        }
	    }
	    j = j + 1
	    i = i + 1
	}

	# transfer to output
	do j = 1, maxchars-1 {
	    if ((dic[i] == dic[1]) || (dic[i] == EOS)) {
	        outstr[j] = EOS
	        return
	    } else {
	        outstr[j] = dic[i]
	        i = i + 1
	    }
	}
	outstr[maxchars] = EOS
end