1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <error.h>
include <pkg/gtools.h>
include "icfit.h"
include "names.h"
# List of colon commands.
define CMDS "|function|order|sample|naverage|niterate|low_reject|high_reject\
|grow|markrej|color|show|vshow|xyshow|errors|evaluate\
|graph|help|gui|"
define FUNCTION 1 # Set or show function type
define ORDER 2 # Set or show function order
define SAMPLE 3 # Set or show sample ranges
define NAVERAGE 4 # Set or show sample averaging or medianing
define NITERATE 5 # Set or show rejection iterations
define LOW_REJECT 6 # Set or show lower rejection factor
define HIGH_REJECT 7 # Set or show upper rejection factor
define GROW 8 # Set or show rejection growing radius
define MARKREJ 9 # Mark rejected points
define COLOR 10 # Fit color
define SHOW 11 # Show values of parameters
define VSHOW 12 # Show verbose information
define XYSHOW 13 # Show x-y-fit-wts values
define ERRORS 14 # Show errors of fit
define EVALUATE 15 # Evaluate fit at specified value
define GRAPH 16 # Define graph
define HELP 17 # Set help file
define GUI 18 # Send GUI command
# ICG_COLON -- Processes colon commands. The common flags and newgraph
# signal changes in fitting parameters or the need to redraw the graph.
procedure icg_colon$t (ic, cmdstr, newgraph, gp, gt, cv, x, y, wts, npts)
pointer ic # ICFIT pointer
char cmdstr[ARB] # Command string
int newgraph # New graph?
pointer gp # GIO pointer
pointer gt # GTOOLS pointer
pointer cv # CURFIT pointer for error listing
PIXEL x[npts], y[npts], wts[npts] # Data arrays for error listing
int npts # Number of data points
PIXEL val, $tcveval()
char key, xtype, ytype
bool bval
int ncmd, ival
real rval
pointer sp, cmd
int nscan(), strdic(), btoi()
string funcs "|chebyshev|legendre|spline1|spline3|power|"
begin
# Check for GTOOLS command.
if (cmdstr[1] == '/') {
call gt_colon (cmdstr, gp, gt, newgraph)
return
}
# Use formated scan to parse the command string.
# The first word is the command and it may be minimum match
# abbreviated with the list of commands.
call smark (sp)
call salloc (cmd, IC_SZSAMPLE, TY_CHAR)
call sscan (cmdstr)
call gargwrd (Memc[cmd], IC_SZSAMPLE)
ncmd = strdic (Memc[cmd], Memc[cmd], IC_SZSAMPLE, CMDS)
switch (ncmd) {
case FUNCTION: # :function - List or set the fitting function.
call gargwrd (Memc[cmd], IC_SZSAMPLE)
if (nscan() == 1) {
call printf ("function = %s\n")
call ic_gstr (ic, "function", Memc[cmd], IC_SZSAMPLE)
call pargstr (Memc[cmd])
} else {
if (strdic (Memc[cmd], Memc[cmd], IC_SZSAMPLE, funcs) > 0) {
call ic_pstr (ic, "function", Memc[cmd])
IC_NEWFUNCTION(ic) = YES
} else
call printf ("Unknown or ambiguous function\n")
}
case ORDER: # :order - List or set the function order.
call gargi (ival)
if (nscan() == 1) {
call printf ("order = %d\n")
call pargi (IC_ORDER(ic))
} else if (ival < 1) {
call printf ("Order must be greater than zero\n")
} else {
call ic_puti (ic, "order", ival)
IC_NEWFUNCTION(ic) = YES
}
case SAMPLE: # :sample - List or set the sample points.
call gargstr (Memc[cmd], IC_SZSAMPLE)
if (Memc[cmd] == EOS) {
call printf ("sample = %s\n")
call pargstr (Memc[IC_SAMPLE(ic)])
} else {
call ic_pstr (ic, "sample", Memc[cmd])
IC_NEWX(ic) = YES
}
case NAVERAGE: # :naverage - List or set the sample averging.
call gargi (ival)
if (nscan() == 1) {
call printf ("naverage = %d\n")
call pargi (IC_NAVERAGE(ic))
} else {
call ic_puti (ic, "naverage", ival)
IC_NEWX(ic) = YES
}
case NITERATE: # :niterate - List or set the rejection iterations.
call gargi (ival)
if (nscan() == 1) {
call printf ("niterate = %d\n")
call pargi (IC_NITERATE(ic))
} else
call ic_puti (ic, "niterate", ival)
case LOW_REJECT: # :low_reject - List or set lower rejection factor.
call gargr (rval)
if (nscan() == 1) {
call printf ("low_reject = %g\n")
call pargr (IC_LOW(ic))
} else
call ic_putr (ic, "low", rval)
case HIGH_REJECT: # :high_reject - List or set high rejection factor.
call gargr (rval)
if (nscan() == 1) {
call printf ("high_reject = %g\n")
call pargr (IC_HIGH(ic))
} else
call ic_putr (ic, "high", rval)
case GROW: # :grow - List or set the rejection growing.
call gargr (rval)
if (nscan() == 1) {
call printf ("grow = %g\n")
call pargr (IC_GROW(ic))
} else
call ic_putr (ic, "grow", rval)
case MARKREJ: # :markrej - Mark rejected points
call gargb (bval)
if (nscan() == 1) {
call printf ("markrej = %b\n")
call pargi (IC_MARKREJ(ic))
} else
call ic_puti (ic, "markrej", btoi (bval))
case COLOR: # :color - List or set the fit color.
call gargi (ival)
if (nscan() == 1) {
call printf ("color = %d\n")
call pargi (IC_COLOR(ic))
} else
call ic_puti (ic, "color", ival)
case SHOW, VSHOW, XYSHOW, ERRORS:
call ic_guishow$t (ic, cmdstr, cv, x, y, wts, npts)
case EVALUATE: # :evaluate x - evaluate fit at x.
call garg$t (val)
if (nscan() == 1)
call printf ("evaluate requires a value to evaluate\n")
else {
call printf ("fit(%g) = %g\n")
call parg$t (val)
call parg$t ($tcveval (cv, val))
}
case GRAPH: # :graph key xtype ytpe
call gargc (key)
call gargc (xtype)
call gargc (ytype)
if (nscan() != 4) {
ival = IC_GKEY(ic)
call printf ("graph %c %c %c\n")
call pargi ('h'+ival-1)
call pargi (IC_AXES(ic,ival,1))
call pargi (IC_AXES(ic,ival,2))
} else {
ival = key - 'h' + 1
IC_GKEY(ic) = ival
call ic_pkey (ic, ival, int(xtype), int(ytype))
newgraph = YES
}
case HELP: # :help file
call gargwrd (Memc[cmd], IC_SZSAMPLE)
if (Memc[cmd] == EOS) {
call printf ("help = %s\n")
call pargstr (Memc[IC_HELP(ic)])
} else
call ic_pstr (ic, "help", Memc[cmd])
case GUI: # :gui command - Update, unlearn or set the options.
call gargstr (Memc[cmd], IC_SZSAMPLE)
call ic_gui (ic, Memc[cmd])
default: # Unrecognized command.
call printf ("Unrecognized command or ambiguous abbreviation\007")
}
call sfree (sp)
end
|
