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
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
include <imhdr.h>
include <gset.h>
include <pkg/rg.h>
include <pkg/gtools.h>
include <pkg/xtanswer.h>
define HELP "noao$lib/scr/ilsetbins.key"
define PROMPT "illumination options"
define SZ_BINS 2048 # Length of bin string
# IL_SETBINS -- Set the dispersion bins.
procedure il_setbins (im, axis, interactive, rg)
pointer im # IMIO pointer for calibration image
int axis # Slit axis
int interactive # Set bins interactively?
pointer rg # Range pointer for bins
char bins[SZ_BINS], str[SZ_LINE]
int i, npts, nbins
real dx
pointer x
int clgeti()
pointer rg_ranges()
begin
# Get the bins. If the bin string is null then divide the dispersion
# range into a number of equal bins.
call clgstr ("bins", bins, SZ_BINS)
call xt_stripwhite (bins)
npts = IM_LEN (im, axis)
if (bins[1] == EOS) {
call malloc (x, npts, TY_INT)
do i = 1, npts
Memi[x+i-1] = i
nbins = clgeti ("nbins")
dx = npts / nbins
do i = 1, nbins {
call sprintf (str, SZ_LINE, "%d:%d ")
call pargi (Memi[x + int ((i - 1) * dx)])
call pargi (Memi[x + int (i * dx - 1)])
call strcat (str, bins, SZ_BINS)
}
call mfree (x, TY_INT)
}
rg = rg_ranges (bins, 1, npts)
if (rg == NULL)
call error (0, "Bad range string for parameter bins")
# Set the bins interactively.
if ((interactive == YES) || (interactive == ALWAYSYES)) {
call sprintf (str, SZ_LINE, "Set illumination bins\n%s")
call pargstr (IM_TITLE(im))
call il_gsetbins (im, axis, str, bins, SZ_BINS, rg)
}
call rg_order (rg)
end
# IL_GSETBINS -- Set dispersion bins graphically.
procedure il_gsetbins (im, axis, title, bins, sz_bins, rg)
pointer im # IMIO pointer
int axis # Slit axis
char title[ARB] # Title
char bins[sz_bins] # Bin string
int sz_bins # Size of bin string
pointer rg # Range pointer for the bins
int npts, newbins, newgraph
real x1, x2
char oldbins[SZ_BINS]
pointer gp, gt, x, y
real wx, wy
int wcs, key
char cmd[SZ_BINS]
int gt_gcur(), stridxs(), strlen()
pointer gopen(), gt_init(), rg_xrangesr()
begin
# Get the average spectrum.
call ls_aimavg (im, axis, 1, IM_LEN(im,1), 1, IM_LEN(im,2), x, y, npts)
# Graph the spectrum and mark the bins.
call clgstr ("graphics", oldbins, SZ_BINS)
gp = gopen (oldbins, NEW_FILE, STDGRAPH)
gt = gt_init()
call il_gbins (gp, gt, axis, Memr[x], Memr[y], npts, bins, title)
while (gt_gcur ("cursor", wx, wy, wcs, key, cmd, SZ_BINS) != EOF) {
switch (key) {
case '?': # Print help text
call gpagefile (gp, HELP, PROMPT)
case ':': # Colon commands
call strcpy (bins, oldbins, SZ_BINS)
if (cmd[1] == '/')
call gt_colon (cmd, gp, gt, newgraph)
else
call il_colon (cmd, bins, sz_bins, newbins)
if (newgraph == YES) {
call il_gbins (gp, gt, axis, Memr[x], Memr[y], npts, bins,
title)
} else if (newbins == YES) {
call rg_gxmarkr (gp, oldbins, Memr[x], npts, 0)
call rg_gxmarkr (gp, bins, Memr[x], npts, 1)
}
case 'i': # Initialize range string
call rg_gxmarkr (gp, bins, Memr[x], npts, 0)
call sprintf (bins, sz_bins, "*")
case 's': # Set sample ranges with the cursor.
if (stridxs ("*", bins) > 0)
bins[1] = EOS
x1 = wx
call printf ("again:\n")
if (gt_gcur ("cursor", wx, wy, wcs, key, cmd, SZ_BINS) == EOF)
break
x2 = wx
call sprintf (cmd, SZ_BINS, "%d:%d ")
call pargr (x1)
call pargr (x2)
if (strlen (cmd) + strlen (bins) > sz_bins)
call eprintf (
"Warning: Too many bins. New bin ignored.\n")
else {
call strcat (cmd, bins, sz_bins)
call rg_gxmarkr (gp, bins, Memr[x], npts, 1)
}
case 'I':
call fatal (0, "Interrupt")
default: # Ring bell for unrecognized commands.
call printf ("\7\n")
}
}
rg = rg_xrangesr (bins, Memr[x], npts)
call mfree (x, TY_REAL)
call mfree (y, TY_REAL)
call gclose (gp)
call gt_free (gt)
end
define COMMANDS "|show|bins|"
define SHOW 1 # Show bins
define BINS 2 # Set bins
# IL_COLON -- Processes colon commands.
procedure il_colon (cmdstr, bins, sz_bins, newbins)
char cmdstr[ARB] # Colon command
char bins[sz_bins] # Bins string
int sz_bins # Size of bins string
int newbins # New bins?
char cmd[SZ_BINS]
int ncmd
int strdic()
begin
newbins = NO
call sscan (cmdstr)
call gargwrd (cmd, SZ_BINS)
ncmd = strdic (cmd, cmd, SZ_BINS, COMMANDS)
switch (ncmd) {
case SHOW:
call printf ("bins = %s\n")
call pargstr (bins)
case BINS:
call gargstr (cmd, SZ_BINS)
call xt_stripwhite (cmd)
if (cmd[1] == EOS) {
call printf ("bins = %s\n")
call pargstr (bins)
} else {
call strcpy (cmd, bins, sz_bins)
newbins = YES
}
}
end
# IL_GBINS -- Graph data
procedure il_gbins (gp, gt, axis, x, y, npts, bins, title)
pointer gp # GIO pointer
pointer gt # GTOOLS pointer
int axis # Slit axis
real x[npts], y[npts] # Data to graph
int npts # Number of data points
char bins[ARB] # Bins to graph
char title[ARB] # Graph labels
begin
call gclear (gp)
call gascale (gp, x, npts, 1)
call gascale (gp, y, npts, 2)
call gt_swind (gp, gt)
switch (axis) {
case 1:
call glabax (gp, title, "Line", "")
case 2:
call glabax (gp, title, "Column", "")
}
call gpline (gp, x, y, npts)
call rg_gxmarkr (gp, bins, x, npts, 1)
end
|
