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
|
include <ctype.h>
$for (rd)
# 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_line$t (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
PIXEL 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_field$t (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_field$t (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
$endfor
|
