Initial commit

1 files changed, 388 insertions, 0 deletions

diff --git a/pkg/xtools/icfit/icparams.x b/pkg/xtools/icfit/icparams.x
new file mode 100644
index 00000000..da829ce0
--- /dev/null
+++ b/pkg/xtools/icfit/icparams.x
@@ -0,0 +1,388 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "icfit.h"
+
+define	FUNCTIONS	"|chebyshev|legendre|spline3|spline1|user|"
+
+# 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), IC_SZSAMPLE, 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)
+
+	# Initialize parameters
+	IC_OVERPLOT(ic) = NO
+	IC_RG(ic) = NULL
+	IC_XFIT(ic) = NULL
+	IC_YFIT(ic) = NULL
+	IC_WTSFIT(ic) = NULL
+	IC_REJPTS(ic) = NULL
+	IC_GP(ic) = NULL
+	IC_GT(ic) = NULL
+
+	# Set defaults
+	call ic_pstr (ic, "function", "spline3")
+	call ic_puti (ic, "order", 1)
+	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_puti (ic, "markrej", YES)
+	call ic_pstr (ic, "xlabel", "X")
+	call ic_pstr (ic, "ylabel", "Y")
+	call ic_pstr (ic, "xunits", "")
+	call ic_pstr (ic, "yunits", "")
+	call ic_puti (ic, "color", 1)
+	call ic_pstr (ic, "help", IC_DEFHELP)
+	call ic_puti (ic, "key", 1)
+	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')
+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_ORDER(icout) = IC_ORDER(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_COLOR(icout) = IC_COLOR(icin)
+	IC_MARKREJ(icout) = IC_MARKREJ(icin)
+	IC_GKEY(icout) = IC_GKEY(icin)
+
+	call strcpy (Memc[IC_SAMPLE(icin)], Memc[IC_SAMPLE(icout)], IC_SZSAMPLE)
+	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_CLOSER -- Close ICFIT parameter structure.
+
+procedure ic_closer (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_CLOSED -- Close ICFIT parameter structure.
+
+procedure ic_closed (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_DOUBLE)
+	    call mfree (IC_YFIT(ic), TY_DOUBLE)
+	    call mfree (IC_WTSFIT(ic), TY_DOUBLE)
+	    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)], IC_SZSAMPLE)
+	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, "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")
+
+	call ic_gui (ic, "params")
+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, "order"))
+	    IC_ORDER(ic) = max (1, ival)
+	else if (streq (param, "niterate"))
+	    IC_NITERATE(ic) = ival
+	else if (streq (param, "key"))
+	    IC_GKEY(ic) = ival
+	else if (streq (param, "color"))
+	    IC_COLOR(ic) = ival
+	else if (streq (param, "markrej"))
+	    IC_MARKREJ(ic) = ival
+	else
+	    call error (0, "ICFIT: Unknown parameter")
+
+	call ic_gui (ic, "params")
+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
+	if (key >= 1 && key <= 5) {
+	    IC_AXES(ic, key, 1) = xaxis
+	    IC_AXES(ic, key, 2) = yaxis
+
+	    if (key == IC_GKEY(ic))
+		call ic_gui (ic, "graph")
+	}
+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
+	    call error (0, "ICFIT: Unknown parameter")
+
+	call ic_gui (ic, "params")
+end
+
+
+# IC_GSTR -- Get string valued parameters.
+
+procedure ic_gstr (ic, param, str, maxchars)
+
+pointer	ic			# ICFIT pointer
+char	param[ARB]		# Parameter to be put
+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")) {
+	    switch (IC_FUNCTION(ic)) {
+	    case 1:
+		call strcpy ("chebyshev", str, maxchars)
+	    case 2:
+		call strcpy ("legendre", str, maxchars)
+	    case 3:
+		call strcpy ("spline3", str, maxchars)
+	    case 4:
+		call strcpy ("spline1", str, maxchars)
+	    case 5:
+		call strcpy ("user", str, maxchars)
+	    }
+	} 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, "order"))
+	    return (IC_ORDER(ic))
+	else if (streq (param, "niterate"))
+	    return (IC_NITERATE(ic))
+	else if (streq (param, "key"))
+	    return (IC_GKEY(ic))
+	else if (streq (param, "nfit"))
+	    return (IC_NFIT(ic))
+	else if (streq (param, "nreject"))
+	    return (IC_NREJECT(ic))
+	else if (streq (param, "rejpts"))
+	    return (IC_REJPTS(ic))
+	else if (streq (param, "color"))
+	    return (IC_COLOR(ic))
+	else if (streq (param, "markrej"))
+	    return (IC_MARKREJ(ic))
+	else if (streq (param, "nmin")) {
+	    switch (IC_FUNCTION(ic)) {
+	    case 3:
+		return (IC_ORDER(ic) + 3)
+	    case 4:
+		return (IC_ORDER(ic) + 1)
+	    default:
+		return (IC_ORDER(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))
+
+	call error (0, "ICFIT: Unknown parameter")
+end