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
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include <mach.h>
include <gset.h>
include <gio.h>
# GSETR -- Set any GIO parameter of type integer or real. Real values are
# silently coerced to integer if the actual parameter value is integer.
procedure gsetr (gp, param, rval)
pointer gp # graphics descriptor
int param # parameter to be set
real rval # new value for parameter
real char_height
int wcs, axes, field, ax[2], wflags, i
pointer w, p, pl, pm, tx, fa
real ggetr()
begin
# Compute pointers to substructures once, here, to save space later.
wcs = GP_WCS(gp)
w = GP_WCSPTR(gp,wcs)
wflags = WCS_FLAGS(w)
pl = GP_PLAP(gp)
pm = GP_PMAP(gp)
tx = GP_TXAP(gp)
fa = GP_FAAP(gp)
switch (param) {
# General GIO parameters.
case G_FD:
GP_FD(gp) = nint(rval)
case G_TTY:
GP_TTY(gp) = nint(rval)
case G_WCS:
GP_WCS(gp) = nint(rval)
case G_CURSOR:
GP_CURSOR(gp) = nint(rval)
# These parameters affect the current WCS.
case G_XTRAN:
WCS_XTRAN(w) = nint(rval)
GP_WCSSTATE(gp) = MODIFIED
call gpl_reset()
case G_YTRAN:
WCS_YTRAN(w) = nint(rval)
GP_WCSSTATE(gp) = MODIFIED
call gpl_reset()
case G_CLIP:
if (nint(rval) == 0)
WCS_FLAGS(w) = and (wflags, not(WF_CLIP))
else
WCS_FLAGS(w) = or (wflags, WF_CLIP)
GP_WCSSTATE(gp) = MODIFIED
call gpl_reset()
case G_RASTER:
WCS_FLAGS(w) = WF_SETRASTER (wflags, nint(rval))
GP_WCSSTATE(gp) = MODIFIED
call gpl_reset()
# Default marker sizes (NDC coords).
case G_SZMARKER1:
GP_SZMARKER(gp,1) = rval
case G_SZMARKER2:
GP_SZMARKER(gp,2) = rval
case G_SZMARKER3:
GP_SZMARKER(gp,3) = rval
case G_SZMARKER4:
GP_SZMARKER(gp,4) = rval
# Polyline attributes.
case G_PLTYPE:
call gst_set_attribute_i (nint(rval), PL_LTYPE(pl), PL_STATE(pl))
case G_PLWIDTH:
call gst_set_attribute_r (rval, PL_WIDTH(pl), PL_STATE(pl))
case G_PLCOLOR:
call gst_set_attribute_i (nint(rval), PL_COLOR(pl), PL_STATE(pl))
# Polymarker attributes.
case G_PMLTYPE:
call gst_set_attribute_i (nint(rval), PM_LTYPE(pm), PM_STATE(pm))
case G_PMWIDTH:
call gst_set_attribute_r (rval, PM_WIDTH(pm), PM_STATE(pm))
case G_PMCOLOR:
call gst_set_attribute_i (nint(rval), PM_COLOR(pm), PM_STATE(pm))
# Text drawing attributes.
case G_TXUP:
call gst_set_attribute_i (nint(rval), TX_UP(tx), TX_STATE(tx))
case G_TXSIZE:
call gst_set_attribute_r (rval, TX_SIZE(tx), TX_STATE(tx))
case G_TXPATH:
call gst_set_attribute_i (nint(rval), TX_PATH(tx), TX_STATE(tx))
case G_TXSPACING:
call gst_set_attribute_r (rval, TX_SPACING(tx), TX_STATE(tx))
case G_TXHJUSTIFY:
call gst_set_attribute_i (nint(rval), TX_HJUSTIFY(tx), TX_STATE(tx))
case G_TXVJUSTIFY:
call gst_set_attribute_i (nint(rval), TX_VJUSTIFY(tx), TX_STATE(tx))
case G_TXFONT:
call gst_set_attribute_i (nint(rval), TX_FONT(tx), TX_STATE(tx))
case G_TXQUALITY:
call gst_set_attribute_i (nint(rval), TX_QUALITY(tx), TX_STATE(tx))
case G_TXCOLOR:
call gst_set_attribute_i (nint(rval), TX_COLOR(tx), TX_STATE(tx))
# Fill area attributes.
case G_FASTYLE:
call gst_set_attribute_i (nint(rval), FA_STYLE(fa), FA_STATE(fa))
case G_FACOLOR:
call gst_set_attribute_i (nint(rval), FA_COLOR(fa), FA_STATE(fa))
# Axis labelling parameters affecting more than one axis.
case G_DRAWTITLE:
GP_DRAWTITLE(gp) = nint(rval)
case G_TITLESIZE:
GP_TITLESIZE(gp) = rval
case G_TITLECOLOR:
GP_TITLECOLOR(gp) = nint(rval)
case G_TITLEJUST:
GP_TITLEJUST(gp) = nint(rval)
case G_NTITLELINES:
GP_NTITLELINES(gp) = nint(rval)
case G_FRAMECOLOR:
GP_FRAMECOLOR(gp) = nint(rval)
case G_ASPECT:
GP_ASPECT(gp) = rval
case G_CHARSIZE:
# Set the character size (height) in NDC units. This can also be
# done by querying for "ch" and setting the relative size, but the
# function is fundamental enough to be worth implementing as a
# single call.
char_height = ggetr (gp, "ch")
if (char_height < EPSILON)
char_height = DEF_CHARHEIGHT
call gst_set_attribute_r (rval / char_height, TX_SIZE(tx),
TX_STATE(tx))
default:
# The GLABAX parameters for the X and Y axes may be set separately
# for each axis or simultaneously for both. The parameter codes
# are encoded as 100 (X only) 200 (Y only) or 300 (both) plus the
# code for the field in the lower digits.
if (param < FIRST_GLABAX_PARAM || param > LAST_GLABAX_PARAM)
call syserr (SYS_GSET)
axes = param / 100
field = mod (param, 100) + 300
ax[1] = 0
ax[2] = 0
if (axes == 1 || axes == 3)
ax[1] = YES
if (axes == 2 || axes == 3)
ax[2] = YES
do i = 1, 2 {
if (ax[i] == YES) {
if (i == 1)
p = GP_XAP(gp)
else
p = GP_YAP(gp)
switch (field) {
case G_DRAWAXES:
GL_DRAWAXES(p) = nint(rval)
case G_SETAXISPOS:
GL_SETAXISPOS(p) = nint(rval)
case G_AXISPOS1:
GL_AXISPOS1(p) = rval
case G_AXISPOS2:
GL_AXISPOS2(p) = rval
case G_DRAWGRID:
GL_DRAWGRID(p) = nint(rval)
case G_GRIDCOLOR:
GL_GRIDCOLOR(p) = nint(rval)
case G_ROUND:
GL_ROUND(p) = nint(rval)
case G_LABELAXIS:
GL_LABELAXIS(p) = nint(rval)
case G_AXISLABELSIZE:
GL_AXISLABELSIZE(p) = rval
case G_AXISLABELCOLOR:
GL_AXISLABELCOLOR(p) = nint(rval)
case G_DRAWTICKS:
GL_DRAWTICKS(p) = nint(rval)
case G_LABELTICKS:
GL_LABELTICKS(p) = nint(rval)
case G_NMAJOR:
GL_NMAJOR(p) = nint(rval)
case G_NMINOR:
GL_NMINOR(p) = nint(rval)
case G_MAJORLENGTH:
GL_MAJORLENGTH(p) = rval
case G_MINORLENGTH:
GL_MINORLENGTH(p) = rval
case G_MAJORWIDTH:
GL_MAJORWIDTH(p) = rval
case G_MINORWIDTH:
GL_MINORWIDTH(p) = rval
case G_AXISWIDTH:
GL_AXISWIDTH(p) = rval
case G_AXISCOLOR:
GL_AXISCOLOR(p) = nint(rval)
case G_TICKLABELSIZE:
GL_TICKLABELSIZE(p) = rval
case G_TICKLABELCOLOR:
GL_TICKLABELCOLOR(p) = nint(rval)
case G_TICKCOLOR:
GL_TICKCOLOR(p) = nint(rval)
# case G_TICKFORMAT:
# not a real parameter
default:
call syserr (SYS_GSET)
}
}
}
}
end
# GST_SET_ATTRIBUTE_I -- Compare the new value of an attribute to the current
# value. If the new value is not different, exit without modifying the
# attribute packet, making no-op GSET calls efficient. If the packet must
# be modified, flush any buffered polyline output first else it will be
# written using the new attribute (this is not necessary for text attributes,
# but is harmless and it is unlikely that GSET will be called to modify a
# text attribute while in the midst of building a polyline). Set the
# parameter and flag the attribute packet as modified.
procedure gst_set_attribute_i (new_value, value, state)
int new_value # value in GSET argument list
int value # current value in GP struct
int state # packet state
begin
if (new_value != value) {
call gpl_flush()
value = new_value
state = MODIFIED
}
end
# GST_SET_ATTRIBUTE_R -- Ditto, for real valued parameters.
procedure gst_set_attribute_r (new_value, value, state)
real new_value # value in GSET argument list
real value # current value in GP struct
int state # packet state
begin
if (abs (new_value - value) > EPSILON) {
call gpl_flush()
value = new_value
state = MODIFIED
}
end
|
