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
|
include <imhdr.h>
include <ctype.h>
include "import.h"
define LEN_COMMENT 70 # Maximum comment length
define COMMENT "COMMENT " # Comment key
define IS_FITS (IS_DIGIT($1)||IS_UPPER($1)||($1=='-')||($1=='_'))
# IP_MKHEADER -- Append or substitute new image header from an image or file.
# Only the legal FITS cards (ignoring leading whitespace) will be copied
# from a file.
procedure ip_mkheader (im, fname)
pointer im # IMIO pointer
char fname[ARB] # Image or data file name
int i, j
pointer ua, fd
pointer sp, str
int open(), getline(), nowhite()
pointer immap()
errchk open
begin
if (nowhite (fname, fname, SZ_FNAME) == 0)
return
ua = IM_USERAREA(im)
ifnoerr (fd = immap (fname, READ_ONLY, LEN_UA)) {
call strcpy (Memc[IM_USERAREA(fd)], Memc[ua], LEN_UA)
call imunmap (fd)
} else {
fd = open (fname, READ_ONLY, TEXT_FILE)
call smark (sp)
call salloc (str, SZ_LINE, TY_CHAR)
Memc[ua] = EOS
while (getline (fd, Memc[str]) != EOF) {
for (i=str; IS_WHITE(Memc[i]); i=i+1)
;
for (j=i; IS_FITS(Memc[j]); j=j+1)
;
for (; j<i+8 && Memc[j]==' '; j=j+1)
;
if (j<i+8 && (Memc[j] != EOS || Memc[j] != '\n'))
next
if (Memc[j] == '=' && Memc[j+1] != ' ')
next
for (; j<i+80 && Memc[j] != EOS; j=j+1)
;
if (Memc[j-1] != '\n') {
Memc[j] = '\n'
Memc[j+1] = EOS
}
call strcat (Memc[i], Memc[ua], LEN_UA)
}
call sfree (sp)
call close (fd)
}
end
|