Repatch (from linux) of OSX IRAF

1 files changed, 370 insertions, 0 deletions

diff --git a/pkg/lists/lintran.x b/pkg/lists/lintran.x
new file mode 100644
index 00000000..70bb59d4
--- /dev/null
+++ b/pkg/lists/lintran.x
@@ -0,0 +1,370 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<pattern.h>
+include	<ctype.h>
+
+define	MAX_FIELDS	100		# Maximum number of fields in list
+define	TABSIZE		8		# Spacing of tab stops
+define	LEN_TR		18		# Length of structure TR
+
+# The TR transformation descriptor structure.
+
+define	X1		Memd[P2D($1)]	# Input origin
+define	Y1		Memd[P2D($1+2)]
+define	XSCALE		Memd[P2D($1+4)]	# Scale factors
+define	YSCALE		Memd[P2D($1+6)]
+define	THETA		Memd[P2D($1+8)]	# Rotation angle
+define	X2		Memd[P2D($1+10)]	# Output origin
+define	Y2		Memd[P2D($1+12)]
+define  COS_THETA	Memd[P2D($1+14)]
+define	SIN_THETA	Memd[P2D($1+16)]
+
+
+# LINTRAN -- Performs a linear translation on each element of the
+# input list, producing a transformed list as output.
+
+procedure t_lintran()
+
+char	in_fname[SZ_FNAME]
+int	list
+pointer	sp, tr
+int	xfield, yfield, min_sigdigits
+
+int 	clgeti(), clpopni(), clgfil()
+
+begin
+	# Allocate memory for transformation parameters structure
+	call smark (sp)
+	call salloc (tr, LEN_TR, TY_STRUCT)
+
+	# Call procedure to get parameters and fill structure
+	call lt_initialize_transform (tr)
+
+	# Get field numbers from cl
+	xfield = clgeti ("xfield")
+	yfield = clgeti ("yfield")
+	min_sigdigits = clgeti("min_sigdigits")
+
+	# Open template of input files
+	list = clpopni ("files")
+
+	# While input list is not depleted, open file and transform list
+	while (clgfil (list, in_fname, SZ_FNAME) != EOF) 
+	    call lt_transform_file (in_fname, xfield, yfield, min_sigdigits, tr)
+
+	# Close template
+	call clpcls (list)
+	call sfree (sp)
+end
+
+
+# LT_INITIALIZE_TRANSFORM -- gets parameter values relevant to the
+# transformation from the cl.  List entries will be transformed
+# in procedure lt_transform.  Scaling is performed
+# first, followed by translation and then rotation.
+
+procedure lt_initialize_transform (tr)
+
+pointer	tr
+
+bool	clgetb()
+double	clgetd()
+
+begin
+	# Get parameters from cl
+	X1(tr) = clgetd ("x1")				# (x1,y1) = crnt origin
+	Y1(tr) = clgetd ("y1")
+	XSCALE(tr) = clgetd ("xscale")
+	YSCALE(tr) = clgetd ("yscale")
+	THETA(tr) = clgetd ("angle")
+	if (! clgetb ("radians"))
+	    THETA(tr) = THETA(tr) / 57.29577951 
+	X2(tr) = clgetd ("x2")				# (x2,y2) = new origin
+	Y2(tr) = clgetd ("y2")
+
+	# The following terms are constant for a given transformation.
+	# They are calculated once and saved in the structure.
+
+	COS_THETA(tr) = cos (THETA(tr))
+	SIN_THETA(tr) = sin (THETA(tr))
+end
+
+
+# LT_TRANSFORM_FILE -- This procedure is called once for each file
+# in the input list.  For each line in the input file that isn't
+# blank or comment, the line is transformed.  Blank and comment
+# lines are output unaltered.
+
+procedure lt_transform_file (in_fname, xfield, yfield, min_sigdigits, tr)
+
+char	in_fname[ARB]
+int	xfield, yfield
+pointer	tr
+
+char	outbuf[SZ_LINE]
+int	nfields, nchars, max_fields, in, nline
+int	nsdig_x, nsdig_y, offset, min_sigdigits
+pointer	sp, field_pos, linebuf, inbuf, ip
+double	x, y, xt, yt
+int	getline(), lt_get_num(), open()
+
+begin
+	call smark (sp)
+	call salloc (inbuf, SZ_LINE, TY_CHAR)
+	call salloc (linebuf, SZ_LINE, TY_CHAR)
+	call salloc (field_pos, MAX_FIELDS, TY_INT)
+
+	max_fields = MAX_FIELDS
+
+	# Open input file
+	in = open (in_fname, READ_ONLY, TEXT_FILE)
+
+	for (nline=1;  getline (in, Memc[inbuf]) != EOF;  nline = nline + 1) {
+	    for (ip=inbuf;  IS_WHITE(Memc[ip]);  ip=ip+1)
+		;
+	    if (Memc[ip] == '#') {
+		# Pass comment lines on to the output unchanged.
+		call putline (STDOUT, Memc[inbuf])
+		next
+	    } else if (Memc[ip] == '\n' || Memc[ip] == EOS) {
+		# Blank lines too.
+		call putline (STDOUT, Memc[inbuf])
+		next
+	    }
+
+	    # Expand tabs into blanks, determine field offsets.
+	    call strdetab (Memc[inbuf], Memc[linebuf], SZ_LINE, TABSIZE)
+	    call lt_find_fields (Memc[linebuf], Memi[field_pos],
+		max_fields, nfields)
+
+	    if (xfield > nfields || yfield > nfields) {
+		call eprintf ("Not enough fields in file '%s', line %d\n")
+		    call pargstr (in_fname)
+		    call pargi (nline)
+		call putline (STDOUT, Memc[linebuf])
+		next
+	    }
+		 
+            offset = Memi[field_pos + xfield-1]
+	    nchars = lt_get_num (Memc[linebuf+offset-1], x, nsdig_x)
+	    if (nchars == 0) {
+		call eprintf ("Bad x value in file '%s' at line %d:\n")
+		    call pargstr (in_fname)
+		    call pargi (nline)
+		call putline (STDOUT, Memc[linebuf])
+		next
+	    }
+
+            offset = Memi[field_pos + yfield-1]
+	    nchars = lt_get_num (Memc[linebuf+offset-1], y, nsdig_y)
+	    if (nchars == 0) {
+		call eprintf ("Bad y value in file '%s' at line %d:\n")
+		    call pargstr (in_fname)
+		    call pargi (nline)
+		call putline (STDOUT, Memc[linebuf])
+		next
+	    }
+		 
+	    call lt_transform (x, y, xt, yt, tr)
+
+	    call lt_pack_line (Memc[linebuf], outbuf, SZ_LINE, Memi[field_pos], 
+	      nfields, xfield, yfield, xt, yt, nsdig_x, nsdig_y, min_sigdigits)
+
+	    call putline (STDOUT, outbuf)
+	}
+
+	call sfree (sp)
+	call close (in)
+end
+
+
+# LT_FIND_FIELDS -- This procedure finds the starting column for each field
+# in the input line.  These column numbers are returned in the array
+# field_pos; the number of fields is also returned.
+
+procedure lt_find_fields (linebuf, field_pos, max_fields, nfields)
+
+char	linebuf[SZ_LINE]
+int	field_pos[max_fields],max_fields, nfields
+bool	in_field
+int	ip, field_num
+
+begin
+	field_num = 1
+	field_pos[1] = 1
+	in_field = false
+
+	for (ip=1; linebuf[ip] != '\n' && linebuf[ip] != EOS; ip=ip+1) {
+	    if (! IS_WHITE(linebuf[ip]))
+		in_field = true
+	    else if (in_field) {
+		in_field = false
+		field_num = field_num + 1
+		field_pos[field_num] = ip
+	    }
+	}
+
+	field_pos[field_num+1] = ip 
+	nfields = field_num
+end
+
+
+# LT_GET_NUM -- The field entry is converted from character to double
+# in preparation for the transformation.  The number of significant
+# digits is counted and returned as an argument; the number of chars in
+# the number is returned as the function value.
+
+int procedure lt_get_num (linebuf, dval, nsdig) 
+
+char	linebuf[SZ_LINE]
+int	nsdig
+double	dval
+char	ch
+int 	nchar, ip
+
+int	gctod()
+
+begin
+	ip = 1
+	nsdig = 0
+	nchar = gctod (linebuf, ip, dval)
+	if (nchar == 0 || IS_INDEFD(dval))
+	    return (nchar)
+
+	# Skip leading white space.
+	ip = 1
+    	repeat {
+	    ch = linebuf[ip]
+	    if (! IS_WHITE(ch)) 
+		break
+	    ip = ip + 1
+	} 
+
+	# Count signifigant digits
+	for (; ! IS_WHITE(ch) && ch != '\n' && ch != EOS; ch=linebuf[ip]) {
+	    if (IS_DIGIT (ch))
+		nsdig = nsdig + 1
+		ip = ip + 1
+	}
+	return (nchar)
+end
+
+
+# LT_TRANSFORM -- The linear transformation is performed in this procedure.
+# First the coordinates are scaled, then rotated and translated.  The
+# transformed coordinates are returned.
+
+procedure lt_transform (x, y, xt, yt, tr)
+
+double	x, y, xt, yt
+pointer	tr
+double	xtemp, ytemp
+
+begin
+	# Subtract off current origin:
+	if (IS_INDEFD (x))
+	    xt = INDEFD
+	else {
+	    xt = x - X1(tr)
+	}
+	if (IS_INDEFD (y))
+	    yt = INDEFD
+	else {
+	    yt = y - Y1(tr)
+	}
+
+	# Scale and rotate coordinates:
+	if (THETA(tr) == 0) {
+	    if (!IS_INDEFD (xt))
+		xt = xt * XSCALE(tr) + X2(tr)
+	    if (!IS_INDEFD (yt))
+		yt = yt * YSCALE(tr) + Y2(tr)
+	    return
+
+	} else if (IS_INDEFD(xt) || IS_INDEFD(yt)) {
+	    # Non-zero angle and either coordinate indefinite results in
+	    # both transformed coordinates = INDEFD
+	    xt = INDEFD
+	    yt = INDEFD
+	    return
+	}
+
+	# Rotation for non-zero angle and both coordinates defined
+	xtemp = xt * XSCALE(tr)
+	ytemp = yt * YSCALE(tr)
+
+	xt = xtemp * COS_THETA(tr) - ytemp * SIN_THETA(tr) 
+	yt = xtemp * SIN_THETA(tr) + ytemp * COS_THETA(tr)
+
+	# Now shift the rotated coordinates
+	xt = xt + X2(tr)
+	yt = yt + Y2(tr)
+end
+
+
+# LT_PACK_LINE -- Fields are packed into the outbuf buffer.  Transformed
+# fields are converted to strings; other fields are copied from
+# the input line to output buffer.
+
+procedure lt_pack_line (inbuf, outbuf, maxch, field_pos, nfields, 
+		xfield, yfield, xt, yt, nsdig_x, nsdig_y, min_sigdigits)
+
+char	inbuf[ARB], outbuf[maxch]
+int	maxch, field_pos[ARB], nfields, xfield, yfield, nsdig_x, nsdig_y
+int	min_sigdigits
+double	xt, yt
+
+char	field[SZ_LINE]
+int	num_field, width, op
+
+int	gstrcpy()
+
+begin
+	# Initialize output pointer.
+	op = 1
+
+	do num_field = 1, nfields {
+	    width = field_pos[num_field + 1] - field_pos[num_field]
+
+	    if (num_field == xfield) {
+	        call lt_format_field (xt, field, maxch, nsdig_x, width, 
+				      min_sigdigits)
+	    } else if (num_field == yfield) {
+		call lt_format_field (yt, field, maxch, nsdig_y, width,
+				      min_sigdigits)
+	    } else {
+	        # Put "width" characters from inbuf into field
+		call strcpy (inbuf[field_pos[num_field]], field, width)
+	    }
+
+	    # Fields must be delimited by at least one blank.
+	    if (num_field > 1 && !IS_WHITE (field[1])) {
+		outbuf[op] = ' '
+		op = op + 1
+	    }
+
+	    # Copy "field" to output buffer.
+	    op = op + gstrcpy (field, outbuf[op], maxch)
+	}
+
+	outbuf[op] = '\n'
+	outbuf[op+1] = EOS
+end
+
+
+# LT_FORMAT_FIELD -- A transformed coordinate is written into a string
+# buffer.  The output field is of (at least) the same width and significance
+# as the input list entry.
+
+procedure lt_format_field (dval, wordbuf, maxch, nsdig, width, min_sigdigits)
+
+char	wordbuf[maxch]
+int	width, nsdig, maxch, min_sigdigits
+double	dval
+
+begin
+	call sprintf (wordbuf, maxch, "%*.*g")
+	    call pargi (width)
+	    call pargi (max (min_sigdigits, nsdig))
+	    call pargd (dval)
+end