aboutsummaryrefslogtreecommitdiff
path: root/sys/imio/iki/stf/stfrgpb.x
blob: 15c4da0aa63ac1405285b90d59c0502bf8ec84ba (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
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.

include	<imhdr.h>
include	<imio.h>
include	<mach.h>
include	"stf.h"

# STF_RGPB -- Read the group data block into the first few cards of the user
# area of the IMIO image header.  The GPB is stored as a binary data structure
# in the STF pixfile.  The values of the standard GPB parameters DATAMIN and
# DATAMAX are returned as output arguments.
#
# DLB--11/03/87: Made changes to allow i*2 and i*4 integer parameters in GPB.
# DLB--11/11/87: Changed calculation of character string length in GPB to
# avoid integer truncation error by using P_PSIZE directly.

procedure stf_rgpb (im, group, acmode, datamin, datamax)

pointer	im			# IMIO image descriptor
int	group			# group to be accessed
int	acmode			# image access mode
real	datamin, datamax	# min,max pixel values from GPB

real	rval
double	dval
short	sval
long	lval, offset
bool	bval, newgroup
pointer	sp, stf, gpb, lbuf, pp
int	pfd, pn, sz_param, sz_gpb
errchk	imaddb, imadds, imaddl, imaddr, imaddd, imastr
errchk	imputd, impstr, open, read
int	open(), read(), imaccf()
real	imgetr()

string	readerr "cannot read group data block - no such group?"
string	badtype "illegal group data parameter datatype"
string	nogroup "group index out of range"
define	minmax_ 91

begin
	call smark (sp)
	call salloc (lbuf, SZ_LINE, TY_CHAR)

	stf = IM_KDES(im)
	pfd = STF_PFD(stf)

	# Verify that the given group exists.
	if (group < 1 || group > STF_GCOUNT(stf))
	    call error (1, nogroup)

	# Skip ahead if there is no group parameter block.
	if (STF_PSIZE(stf) == 0)
	    goto minmax_

	# Open the pixel file if not already open.
	if (pfd == NULL) {
	    iferr {
		if (IM_ACMODE(im) == READ_ONLY)
		    pfd = open (IM_PIXFILE(im), READ_ONLY, BINARY_FILE)
		else
		    pfd = open (IM_PIXFILE(im), READ_WRITE, BINARY_FILE)
		STF_PFD(stf) = pfd
	    } then {
		call eprintf ("Warning: Cannot open pixfile to read GPB (%s)\n")
		    call pargstr (IM_NAME(im))
		pfd = NULL
	    }
	}

	# Allocate a buffer for the GPB.
	sz_gpb = STF_PSIZE(stf) / NBITS_BYTE / SZB_CHAR
	call salloc (gpb, sz_gpb, TY_CHAR)

	# Read the GPB into a buffer.  The GPB is located at the very end of
	# the data storage area for the group.  If we are opening a new,
	# uninitialized group (acmode = new_image or new_copy), do not
	# physically read the GPB as it is will be uninitialized data.

	newgroup = (acmode == NEW_IMAGE || acmode == NEW_COPY || pfd == NULL)
	if (newgroup)
	    call aclrc (Memc[gpb], sz_gpb)
	else {
	    offset = (group * STF_SZGROUP(stf) + 1) - sz_gpb
	    call seek (pfd, offset)
	    if (read (pfd, Memc[gpb], sz_gpb) != sz_gpb)
		call error (1, readerr)
	}

	# Extract the binary value of each parameter in the GPB and encode it
	# in FITS format in the IMIO user area.

	offset = 0
	for (pn=1;  pn <= STF_PCOUNT(stf);  pn=pn+1) {
	    pp = STF_PDES(stf,pn)
		
	    # Fill in the unitialized fields of the GPB parameter descriptor.
	    P_OFFSET(pp) = offset
	    sz_param = P_PSIZE(pp) / NBITS_BYTE / SZB_CHAR

	    switch (P_PDTYPE(pp)) {
	    # changed case for int to short and long--dlb 11/3/87
	    case 'I':
		if (sz_param == SZ_SHORT)
		    P_SPPTYPE(pp) = TY_SHORT
		else
		    P_SPPTYPE(pp) = TY_LONG
		P_LEN(pp) = 1
	    case 'R':
		if (sz_param == SZ_REAL)
		    P_SPPTYPE(pp) = TY_REAL
		else
		    P_SPPTYPE(pp) = TY_DOUBLE
		P_LEN(pp) = 1
	    case 'C':
		P_SPPTYPE(pp) = TY_CHAR
		# calculate length directly from PSIZE to avoid truncation error
		P_LEN(pp) = min (SZ_LINE, P_PSIZE(pp) / NBITS_BYTE)
	    case 'L':
		P_SPPTYPE(pp) = TY_BOOL
		P_LEN(pp) = 1
	    default:
		call error (1, badtype)
	    }

	    # Extract the binary parameter value and add a FITS encoded card
	    # to the IMIO user area.  In the case of a new copy image, the
	    # GPB values will already be in the image header, do not modify
	    # the parameter value, but add the parameter if it was not
	    # inherited from the old image.

	    if (acmode != NEW_COPY || imaccf (im, P_PTYPE(pp)) == NO) {
		switch (P_SPPTYPE(pp)) {
		case TY_BOOL:
                    if (SZ_INT != SZ_INT32)
		        call amovc (Memc[gpb+offset], bval, SZ_INT32)
                    else
		        call amovc (Memc[gpb+offset], bval, SZ_BOOL)
		    call imaddb (im, P_PTYPE(pp), bval)
		case TY_SHORT:
		    call amovc (Memc[gpb+offset], sval, SZ_SHORT)
		    call imadds (im, P_PTYPE(pp), sval)
		case TY_LONG:
                    if (SZ_INT != SZ_INT32)
		        call amovc (Memc[gpb+offset], lval, SZ_INT32)
                    else
		        call amovc (Memc[gpb+offset], lval, SZ_LONG)
		    call imaddl (im, P_PTYPE(pp), lval)
		case TY_REAL:
		    call amovc (Memc[gpb+offset], rval, SZ_REAL)
		    call imaddr (im, P_PTYPE(pp), rval)
		case TY_DOUBLE:
		    call amovc (Memc[gpb+offset], dval, SZ_DOUBLE)
		    call imaddd (im, P_PTYPE(pp), dval)
		case TY_CHAR:
		    call chrupk (Memc[gpb+offset], 1, Memc[lbuf], 1, P_LEN(pp))
		    Memc[lbuf+P_LEN(pp)] = EOS
		    call imastr (im, P_PTYPE(pp), Memc[lbuf])
		default:
		    call error (1, badtype)
		}
	    }

	    offset = offset + sz_param
	}

minmax_
	# Return DATAMIN, DATAMAX.  This is done by searching the user area so
	# that ordinary keywords may be used to set datamin and datamax if the
	# GPB is not used.

	datamin = 0.0; datamax = 0.0
	if (imaccf (im, "DATAMIN") == YES)
	    datamin = imgetr (im, "DATAMIN")
	if (imaccf (im, "DATAMAX") == YES)
	    datamax = imgetr (im, "DATAMAX")

	call sfree (sp)
end