aboutsummaryrefslogtreecommitdiff
path: root/noao/imred/dtoi/hdicfit/hdicparams.x
diff options
context:
space:
mode:
Diffstat (limited to 'noao/imred/dtoi/hdicfit/hdicparams.x')
-rw-r--r--noao/imred/dtoi/hdicfit/hdicparams.x323
1 files changed, 323 insertions, 0 deletions
diff --git a/noao/imred/dtoi/hdicfit/hdicparams.x b/noao/imred/dtoi/hdicfit/hdicparams.x
new file mode 100644
index 00000000..1840dccd
--- /dev/null
+++ b/noao/imred/dtoi/hdicfit/hdicparams.x
@@ -0,0 +1,323 @@
+include "hdicfit.h"
+
+define FUNCTIONS "|chebyshev|legendre|spline3|spline1|power|"
+define TRANSFORMS "|none|logopacitance|k50|k75|"
+
+# IC_OPEN -- Open ICFIT parameter structure.
+
+procedure ic_open (ic)
+
+pointer ic # ICFIT pointer
+errchk malloc
+
+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)
+
+ # 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", 0.)
+ call ic_putr (ic, "high", 0.)
+ call ic_putr (ic, "grow", 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_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')
+
+ # Initialize other parameters
+ IC_RG(ic) = NULL
+ IC_XFIT(ic) = NULL
+ IC_YFIT(ic) = NULL
+ IC_WTSFIT(ic) = NULL
+ IC_REJPTS(ic) = NULL
+end
+
+
+# IC_CLOSER -- Close ICFIT parameter structure.
+
+procedure ic_closer (ic)
+
+pointer ic # ICFIT pointer
+
+begin
+ # 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, TY_STRUCT)
+end
+
+
+# IC_CLOSED -- Close ICFIT parameter structure.
+
+procedure ic_closed (ic)
+
+pointer ic # ICFIT pointer
+
+begin
+ # 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, 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, "transform")) {
+ call malloc (ptr, SZ_LINE, TY_CHAR)
+ i = strdic (str, Memc[ptr], SZ_LINE, TRANSFORMS)
+ if (i > 0)
+ IC_TRANSFORM(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
+ 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, "order"))
+ IC_ORDER(ic) = ival
+ else if (streq (param, "niterate"))
+ IC_NITERATE(ic) = ival
+ else if (streq (param, "key"))
+ IC_GKEY(ic) = ival
+ else if (streq (param, "transform"))
+ IC_TRANSFORM(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, "fog"))
+ IC_FOG(ic) = rval
+ else if (streq (param, "rfog"))
+ IC_RFOG(ic) = rval
+ else
+ 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 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, "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 ("power", str, maxchars)
+ }
+ } else if (streq (param, "transform")) {
+ switch (IC_TRANSFORM(ic)) {
+ case 1:
+ call strcpy ("none", str, maxchars)
+ case 2:
+ call strcpy ("logopacitance", str, maxchars)
+ case 3:
+ call strcpy ("k50", str, maxchars)
+ case 4:
+ call strcpy ("k75", 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, "transform"))
+ return (IC_TRANSFORM(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, "fog"))
+ return (IC_FOG(ic))
+
+ call error (0, "ICFIT: Unknown parameter")
+end
generated by cgit (git 2.34.1) at 2025-09-20 09:05:15 -0400