aboutsummaryrefslogtreecommitdiff
path: root/pkg/xtools/mef/mefdummyh.x
blob: ba0d38dd2ca8d497b6ccdd586246aafca0d2a141 (plain) (blame)
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
include <pkg/mef.h>

# MEF_DUMMYHDR -- Write a dummy Primary header Unit with no data to a new file.
# Optionaly a header file with user keywords can be used.

procedure mef_dummyhdr (out, hdrfname)

int	out		#I File descriptor
char	hdrfname[ARB]	#I Header filename

char    card[LEN_CARD]
pointer sp, path, op
int	n, nlines, i, nchars, FD
int	strlen(), open(), getline(), strncmp()

begin
	call smark(sp)
	call salloc (path, SZ_PATHNAME, TY_CHAR)

	n = 0
	call mef_encodeb ("SIMPLE", YES, card, "FITS STANDARD")
	call mef_pakwr (out, card)
	n = n + 1

	call mef_encodei ("BITPIX", 8, card, "Character information")
	call mef_pakwr (out, card)
	n = n + 1

	call mef_encodei ("NAXIS", 0, card, "No image data array present")
	call mef_pakwr (out, card)
	n = n + 1

	call mef_encodeb ("EXTEND", YES, card,
	                         "There maybe standard extensions")
	call mef_pakwr (out, card)
	n = n + 1

        call mef_encodec ("ORIGIN", FITS_ORIGIN, strlen(FITS_ORIGIN),
		           card, "FITS file originator")
	call mef_pakwr (out, card)
	n = n + 1

        call mef_encode_date (Memc[path], SZ_PATHNAME)
	call mef_encodec ("DATE", Memc[path], strlen(Memc[path]), 
			card, "Date FITS file was generated")
	call mef_pakwr (out, card)
	n = n + 1

	# Write a header file if one is given
	if (hdrfname[1] != EOS) {
	   fd = open (hdrfname, READ_ONLY, TEXT_FILE)
	   nchars = getline(fd, Memc[path])
	   repeat {
	       if ((strncmp (Memc[path], "SIMPLE", 6) == 0) ||
	           (strncmp (Memc[path], "BITPIX", 6) == 0) ||
	           (strncmp (Memc[path], "NAXIS",  5) == 0) )
	            nchars = getline(fd, Memc[path])
	       for (op=nchars-1; op <= LEN_CARD; op=op+1)
		   Memc[path+op] = ' '
	       Memc[path+LEN_CARD] = EOS
	       call mef_pakwr (out, Memc[path])
	       n = n + 1
	       if (n == 36)
	           n = 0
	       nchars = getline(fd, Memc[path])
	   } until (nchars == EOF)
	   call close (fd)
	}

        Memc[path] = ' '
	call amovkc (Memc[path], card, 80)
	call strcpy ("END", card, 3)
	card[4] = ' '                           # Clear EOS mark
	call mef_pakwr (out, card)

	n = n + 1

	call amovkc (" ", card, 80)
	nlines = 36 - n
	for (i=1; i<= nlines; i=i+1)
	   call mef_pakwr (out, card)

	call sfree (sp)
end