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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <gio.h>
include <fset.h>
include <chars.h>
include <mach.h>
# GMSG -- Write a string value to a UI (user interface) parameter. Another
# way to look at this is that we are sending a message to a UI object, hence
# this is called a message facility.
#
# NOTE -- This routine quotes the string with curly braces { } and prefaces
# the string with a "setValue", as required to set the value of a GUI client
# state variable. This is done here rather than build knowledge into the
# lower level i/o system about the requirements for sending messages to UI
# parameters. The low level i/o system just sends arbitrary messages to
# named UI objects; setting the value of a UI parameter object is a higher
# level abstraction layered upon the general i/o mechanism.
#
# One limitation of the UI parameter mechanism as it currently stands is that
# if the message contains curly braces, they must match up to avoid having
# the message be prematurely delimited (fortunately curly braces tend to
# match up in any valid text that uses them). So far I haven't found a way
# around this. The problem is that while Tcl allows braces to be backslash
# escaped to avoid being treated as delimiters, the backslashes are not
# removed, they are left in the message as data. Hence they cannot be
# inserted in an arbitrary string without changing the string.
#
# Messages may be arbitrarily large and may extend over multiple lines. The
# only restriction is that if the messages contain curly braces they must
# match up.
procedure gmsg (gp, object, message)
pointer gp #I graphics descriptor
char object[ARB] #I object name
char message[ARB] #I message text
int flushnl, control_stream
int fstati()
bool ttygetb()
begin
call gflush (gp)
call flush (STDOUT)
call flush (STDERR)
control_stream = STDERR
if (ttygetb (GP_TTY(gp), "EM")) {
flushnl = fstati (control_stream, F_FLUSHNL)
if (flushnl == YES)
call fseti (control_stream, F_FLUSHNL, NO)
call putci (control_stream, EM)
call putline (control_stream, object)
call putci (control_stream, ' ')
call putline (control_stream, "setValue ")
call putci (control_stream, '{')
call putline (control_stream, message)
call putci (control_stream, '}')
call putci (control_stream, GS)
call putci (control_stream, US)
call flush (control_stream)
if (flushnl == YES)
call fseti (control_stream, F_FLUSHNL, YES)
}
end
# GMSGB -- Set the value of a boolean UI parameter.
procedure gmsgb (gp, object, value)
pointer gp #I graphics descriptor
char object[ARB] #I object name
bool value #I value
begin
if (value)
call gmsg (gp, object, "yes")
else
call gmsg (gp, object, "no")
end
# GMSGC -- Set the value of a character UI parameter.
procedure gmsgc (gp, object, value)
pointer gp #I graphics descriptor
char object[ARB] #I object name
char value #I value
char buf[10]
int junk, ctocc()
begin
junk = ctocc (value, buf, 10)
call gmsg (gp, object, buf)
end
# GMSGS -- Set the value of a short integer UI parameter.
procedure gmsgs (gp, object, value)
pointer gp #I graphics descriptor
char object[ARB] #I object name
short value #I value
long val
char buf[32]
int junk, ltoc()
begin
if (IS_INDEFS (value))
call gmsg (gp, object, "INDEF")
else {
val = value
junk = ltoc (val, buf, 32)
call gmsg (gp, object, buf)
}
end
# GMSGI -- Set the value of an integer UI parameter.
procedure gmsgi (gp, object, value)
pointer gp #I graphics descriptor
char object[ARB] #I object name
int value #I value
long val
char buf[32]
int junk, ltoc()
begin
if (IS_INDEFI (value))
call gmsg (gp, object, "INDEF")
else {
val = value
junk = ltoc (val, buf, 32)
call gmsg (gp, object, buf)
}
end
# GMSGL -- Set the value of a long integer UI parameter.
procedure gmsgl (gp, object, value)
pointer gp #I graphics descriptor
char object[ARB] #I object name
long value #I value
char buf[32]
int junk, ltoc()
begin
if (IS_INDEFL (value))
call gmsg (gp, object, "INDEF")
else {
junk = ltoc (value, buf, 32)
call gmsg (gp, object, buf)
}
end
# GMSGR -- Set the value of a type real UI parameter.
procedure gmsgr (gp, object, value)
pointer gp #I graphics descriptor
char object[ARB] #I object name
real value #I value
double dval
char buf[MAX_DIGITS]
int junk, dtoc()
begin
if (IS_INDEFR (value))
call gmsg (gp, object, "INDEF")
else {
dval = value
junk = dtoc (dval, buf, MAX_DIGITS, NDIGITS_RP, 'g', MAX_DIGITS)
call gmsg (gp, object, buf)
}
end
# GMSGD -- Set the value of a type double UI parameter.
procedure gmsgd (gp, object, value)
pointer gp #I graphics descriptor
char object[ARB] #I object name
double value #I value
char buf[MAX_DIGITS]
int junk, dtoc()
begin
if (IS_INDEFR (value))
call gmsg (gp, object, "INDEF")
else {
junk = dtoc (value, buf, MAX_DIGITS, NDIGITS_DP, 'g', MAX_DIGITS)
call gmsg (gp, object, buf)
}
end
# GMSGX -- Set the value of a type complex UI parameter.
procedure gmsgx (gp, object, value)
pointer gp #I graphics descriptor
char object[ARB] #I object name
complex value #I value
char buf[MAX_DIGITS]
int junk, xtoc()
begin
junk = xtoc (value, buf, MAX_DIGITS, NDIGITS_RP, 'g', MAX_DIGITS/2)
call gmsg (gp, object, buf)
end
|
