aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/copyone/keypar.x
blob: 0a5c94230e1fb7e5cdb2d6a6919f1ef2bff24195 (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
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	"filetype.h"

define	SZ_KEYWORD	64
define	USRERR		1

# KEYPAR -- Transfer header keyword to IRAF parameter
#
# B.Simon	14-Aug-87	First Code
# B.Simon	14-Dec-94	Added error checking

procedure t_keypar()

#--
pointer	input		# Name of file containing header keyword
pointer	keyword		# Name of header keyword
bool	silent		# Don't print warning message
pointer	value		# IRAF parameter value

bool	found
int	ftype, keytype, junk
pointer errtxt, sp, hd

string	unfilerr	"Header file name not found or ambiguous (%s)"

bool	clgetb()
int	filetype(), errget()
pointer	immap(), tbtopn()

begin
	# Allocate storage for character strings

	call smark (sp)
	call salloc (input, SZ_FNAME, TY_CHAR)
	call salloc (keyword, SZ_KEYWORD, TY_CHAR)
	call salloc (value, SZ_KEYWORD, TY_CHAR)
	call salloc (errtxt, SZ_LINE, TY_CHAR)

	# Read input parameters

	call clgstr ("input", Memc[input], SZ_FNAME)
	call clgstr ("keyword", Memc[keyword], SZ_KEYWORD)
	silent = clgetb ("silent")

	ftype = filetype (Memc[input])

	if (ftype == IMAGE_FILE) {

	    # Read image header keyword and get datatype

	    found = true
	    hd = immap (Memc[input], READ_ONLY, NULL)
	    iferr {
		call getimghdr (hd, Memc[keyword], SZ_KEYWORD, 
				Memc[value], keytype)
	    } then {
		junk = errget (Memc[errtxt], SZ_LINE)
		call xer_reset

		keytype = TY_CHAR
		Memc[value] = EOS
		found = false

		if (! silent) {
		    call eprintf ("Warning: %s\n")
		    call pargstr (Memc[errtxt])
		}
	    }
	    call imunmap (hd)

	} else if (ftype == TABLE_FILE) {

	    # Read table header keyword and get datatype

	    found = true
	    hd = tbtopn (Memc[input], READ_ONLY, NULL)
	    iferr {
		call gettabhdr (hd, Memc[keyword], SZ_KEYWORD, 
				Memc[value], keytype)
	    } then {
		junk = errget (Memc[errtxt], SZ_LINE)
		call xer_reset

		keytype = TY_CHAR
		Memc[value] = EOS
		found = false

		if (! silent) {
		    call eprintf ("Warning: %s\n")
		    call pargstr (Memc[errtxt])
		}
	    }
	    call tbtclo (hd)

	} else {

	    call sprintf (Memc[errtxt], SZ_LINE, unfilerr)
	    call pargstr (Memc[input])
	    call error (USRERR, Memc[errtxt])

	}

	# Write output parameters and free string storage

	call addslash (Memc[value], SZ_KEYWORD)
	call clpstr ("value", Memc[value])
	call clputb ("found", found)
	call sfree(sp)
	return
end