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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include <ctype.h>
include <imhdr.h>
include <imio.h>
include "idb.h"
define LEN_HISTSTR 70 # length of a history string on a FITS card
# IMPUTH -- Add a FITS-like history/comment field to the image header.
# Only keywords HISTORY, COMMENT, or " " (eight spaces) are allowed!
# (At least for the present - in the future this routine will probably
# append FITS cards to a distinct FITS-table appearing as a table parameter
# in the generalized image header. Also, since it is not yet decided how
# image history will be handled in the future, there is no guarantee that
# this routine will remain unchanged - it may change or be obsoleted.)
procedure imputh (im, key, text)
pointer im #I image descriptor
char key[ARB] #I name of the new parameter
char text[ARB] #I the history string to be added
pointer sp, keyname, instr, outstr, ua
int fd, max_lenuserarea, curlen, buflen, nchars
int ip, op, in_last_blank, out_last_blank
bool streq()
int stropen(), strlen(), idb_filstr()
errchk syserrs, stropen, fprintf
begin
call smark (sp)
call salloc (instr, SZ_LINE, TY_CHAR)
call salloc (keyname, SZ_FNAME, TY_CHAR)
call salloc (outstr, LEN_HISTSTR, TY_CHAR)
# FITS format requires that the keyword name be upper case.
call strcpy (key, Memc[keyname], SZ_FNAME)
call strupr (Memc[keyname])
# Only standard FITS HISTORY keywords are allowed.
if (!(streq(Memc[keyname],"HISTORY") ||
streq(Memc[keyname],"COMMENT") ||
streq(Memc[keyname]," "))) {
call eprintf ("IMPUTH: Invalid history keyword `%s' ignored\n")
call pargstr (key)
call sfree (sp)
return
}
# Open the user area string for appending. 'buflen' is the malloc-ed
# buffer length in struct units; IMU is the struct offset to the user
# area, i.e., the size of that part of the image descriptor preceding
# the user area. If the buffer fills we must allow one extra char for
# the EOS delimiter; since storage for the image descriptor was
# allocated in struct units the storage allocator will not have
# allocated space for the extra EOS char.
ua = IM_USERAREA(im)
curlen = strlen (Memc[ua])
buflen = LEN_IMDES + IM_LENHDRMEM(im)
max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
# If the user area is not empty the last character must be the newline
# record delimiter, else the new record we add will be invalid.
if (curlen > 0 && Memc[ua+curlen-1] != '\n')
if (curlen >= max_lenuserarea)
call syserrs (SYS_IDBOVFL, key)
else {
Memc[ua+curlen] = '\n'
curlen = curlen + 1
Memc[ua+curlen] = EOS
}
# Open a file descriptor on the userarea buffer.
fd = stropen (Memc[ua+curlen], max_lenuserarea-curlen, APPEND)
# Filter the input string to remove any undesirable characters.
nchars = idb_filstr (text, Memc[instr], SZ_LINE)
# Append the HISTORY or COMMENT record to the user area.
iferr {
if (nchars <= LEN_HISTSTR ) {
# This is the easy case: the HISTORY string will fit in
# one record.
call fprintf (fd, "%-8s %s%*t\n")
call pargstr (Memc[keyname])
call pargstr (Memc[instr])
call pargi (IDB_LENSTRINGRECORD + 1)
} else {
# Not the simple case; break up the string into pieces that
# will fit into LEN_HISTSTR, preferably on word boundaries.
for (ip=1; Memc[instr+ip-1] != EOS; ) {
# If no blanks are found in HISTORY string, make sure
# all of it gets output anyway.
in_last_blank = ip + LEN_HISTSTR - 1
out_last_blank = LEN_HISTSTR
# Copy the string to the output buffer, marking the
# last blank found.
do op = 1, LEN_HISTSTR {
if (IS_WHITE (Memc[instr+ip-1])) {
in_last_blank = ip
out_last_blank = op
} else if (Memc[instr+ip-1] == EOS)
break
Memc[outstr+op-1] = Memc[instr+ip-1]
ip = ip + 1
}
# The output string is full; close it off properly
# and get ready for the next round (if any).
Memc[outstr+op-1] = EOS
if (Memc[instr+ip-1] != EOS) {
# Break at last word boundary if in a word.
if (!IS_WHITE (Memc[instr+ip-1])) {
Memc[outstr+out_last_blank] = EOS
ip = in_last_blank + 1
}
# Skip leading whitespace on next line.
while (IS_WHITE(Memc[instr+ip-1]))
ip = ip + 1
}
# Write out the FITS HISTORY card.
call fprintf (fd, "%-8s %s%*t\n")
call pargstr (Memc[keyname])
call pargstr (Memc[outstr])
call pargi (IDB_LENSTRINGRECORD + 1)
}
}
} then {
# Out of space in the user area. Discard the truncated card
# at the end of the buffer by backing up to the last newline and
# writing an EOS.
call close (fd)
for (ip=ua+max_lenuserarea-1; ip > ua; ip=ip-1)
if (Memc[ip] == '\n') {
Memc[ip+1] = EOS
break
}
call syserrs (SYS_IDBOVFL, key)
}
call close (fd)
call sfree (sp)
end
|
