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
|
include <ctype.h>
# RG_APACK_LINE -- Fields are packed into the output buffer. Transformed
# fields are converted to strings; other fields are copied from the input
# line to the output buffer.
procedure rg_apack_liner (inbuf, outbuf, maxch, field_pos, nfields,
cinfields, ncin, coords, laxno, formats, nsdig, ncout, min_sigdigits)
char inbuf[ARB] #I the input string buffer
char outbuf[maxch] #O the output string buffer
int maxch #I the maximum size of the output buffer
int field_pos[ARB] #I starting positions for the fields
int nfields #I the number of fields
int cinfields[ARB] #I fields to be replaced
int ncin #I the number of input fields
real coords[ARB] #I the transformed coordinates
int laxno[ARB] #I the logical axis mapping
pointer formats[ARB] #I array of format pointers
int nsdig[ARB] #I array of numbers of significant digits
int ncout #I the number of coordinates
int min_sigdigits #I the minimum number of signficant digits
int op, num_field, width, cf, cfptr
pointer sp, field
int gstrcpy()
begin
call smark (sp)
call salloc (field, SZ_LINE, TY_CHAR)
# Initialize output pointer.
op = 1
# Copy the file replacing fields as one goes.
do num_field = 1, nfields {
# Find the width of the field.
width = field_pos[num_field + 1] - field_pos[num_field]
# Find the field to be replaced.
cfptr = 0
do cf = 1, ncin {
if (cinfields[cf] != num_field)
next
cfptr = cf
break
}
# Replace the field.
if (cfptr != 0) {
if (laxno[cfptr] == 0) {
Memc[field] = EOS
next
#call li_format_field$t ($INDEF$T, Memc[field], maxch,
#Memc[formats[cfptr]], nsdig[cfptr], width,
#min_sigdigits)
} else
call li_format_fieldr (coords[laxno[cfptr]], Memc[field],
maxch, Memc[formats[laxno[cfptr]]], nsdig[laxno[cfptr]],
width, min_sigdigits)
} else {
# Put "width" characters from inbuf into field
call strcpy (inbuf[field_pos[num_field]], Memc[field], width)
}
# Fields must be delimited by at least one blank.
if (num_field > 1 && !IS_WHITE (Memc[field])) {
outbuf[op] = ' '
op = op + 1
}
# Copy "field" to output buffer.
op = op + gstrcpy (Memc[field], outbuf[op], maxch)
}
do cfptr = ncin + 1, ncout {
# Copy out the extra fields if any.
if (laxno[cfptr] == 0) {
Memc[field] = EOS
next
#call li_format_field$t ($INDEF$T, Memc[field], maxch, "%g",
#min_sigdigits, width, min_sigdigits)
} else
call li_format_fieldr (coords[laxno[cfptr]], Memc[field],
maxch, Memc[formats[laxno[cfptr]]], nsdig[laxno[cfptr]],
width, min_sigdigits)
# Fields must be delimited by at least one blank.
if (!IS_WHITE (Memc[field])) {
outbuf[op] = ' '
op = op + 1
}
# Copy "field" to output buffer.
op = op + gstrcpy (Memc[field], outbuf[op], maxch)
}
outbuf[op] = '\n'
outbuf[op+1] = EOS
call sfree (sp)
end
# RG_APACK_LINE -- Fields are packed into the output buffer. Transformed
# fields are converted to strings; other fields are copied from the input
# line to the output buffer.
procedure rg_apack_lined (inbuf, outbuf, maxch, field_pos, nfields,
cinfields, ncin, coords, laxno, formats, nsdig, ncout, min_sigdigits)
char inbuf[ARB] #I the input string buffer
char outbuf[maxch] #O the output string buffer
int maxch #I the maximum size of the output buffer
int field_pos[ARB] #I starting positions for the fields
int nfields #I the number of fields
int cinfields[ARB] #I fields to be replaced
int ncin #I the number of input fields
double coords[ARB] #I the transformed coordinates
int laxno[ARB] #I the logical axis mapping
pointer formats[ARB] #I array of format pointers
int nsdig[ARB] #I array of numbers of significant digits
int ncout #I the number of coordinates
int min_sigdigits #I the minimum number of signficant digits
int op, num_field, width, cf, cfptr
pointer sp, field
int gstrcpy()
begin
call smark (sp)
call salloc (field, SZ_LINE, TY_CHAR)
# Initialize output pointer.
op = 1
# Copy the file replacing fields as one goes.
do num_field = 1, nfields {
# Find the width of the field.
width = field_pos[num_field + 1] - field_pos[num_field]
# Find the field to be replaced.
cfptr = 0
do cf = 1, ncin {
if (cinfields[cf] != num_field)
next
cfptr = cf
break
}
# Replace the field.
if (cfptr != 0) {
if (laxno[cfptr] == 0) {
Memc[field] = EOS
next
#call li_format_field$t ($INDEF$T, Memc[field], maxch,
#Memc[formats[cfptr]], nsdig[cfptr], width,
#min_sigdigits)
} else
call li_format_fieldd (coords[laxno[cfptr]], Memc[field],
maxch, Memc[formats[laxno[cfptr]]], nsdig[laxno[cfptr]],
width, min_sigdigits)
} else {
# Put "width" characters from inbuf into field
call strcpy (inbuf[field_pos[num_field]], Memc[field], width)
}
# Fields must be delimited by at least one blank.
if (num_field > 1 && !IS_WHITE (Memc[field])) {
outbuf[op] = ' '
op = op + 1
}
# Copy "field" to output buffer.
op = op + gstrcpy (Memc[field], outbuf[op], maxch)
}
do cfptr = ncin + 1, ncout {
# Copy out the extra fields if any.
if (laxno[cfptr] == 0) {
Memc[field] = EOS
next
#call li_format_field$t ($INDEF$T, Memc[field], maxch, "%g",
#min_sigdigits, width, min_sigdigits)
} else
call li_format_fieldd (coords[laxno[cfptr]], Memc[field],
maxch, Memc[formats[laxno[cfptr]]], nsdig[laxno[cfptr]],
width, min_sigdigits)
# Fields must be delimited by at least one blank.
if (!IS_WHITE (Memc[field])) {
outbuf[op] = ' '
op = op + 1
}
# Copy "field" to output buffer.
op = op + gstrcpy (Memc[field], outbuf[op], maxch)
}
outbuf[op] = '\n'
outbuf[op+1] = EOS
call sfree (sp)
end
|
