Repatch (from linux) of OSX IRAF

1 files changed, 178 insertions, 0 deletions

diff --git a/pkg/images/tv/iis/ids/idspcell.x b/pkg/images/tv/iis/ids/idspcell.x
new file mode 100644
index 00000000..d678b286
--- /dev/null
+++ b/pkg/images/tv/iis/ids/idspcell.x
@@ -0,0 +1,178 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <gki.h>
+include <gset.h>
+include "../lib/ids.h"
+
+# number of grey scale symbols
+define NSYMBOL	11
+define TSIZE	(1.0/2.0)
+
+# IDS_PUTCELLARRAY -- Draw a cell array, i.e., two dimensional array of pixels
+# (greylevels or colors).
+
+procedure ids_putcellarray (m, nc, nr, ax1,ay1, ax2,ay2)
+
+short	m[ARB]			# cell array
+int	nc, nr			# number of pixels in X and Y
+				# (number of columns[x], rows[y]
+int	ax1, ay1		# lower left corner of output window
+int	ax2, ay2		# upper right corner of output window
+
+int	x1,y1,x2,y2
+real	px1, py1, px2, py2
+int	nx, ny
+real	skip_x, skip_y, sx, sy
+real	blockx, blocky, bcy
+int	i, j, startrow, element
+real	xres, yres
+pointer	sp, cell
+bool	ca, use_orig, new_row
+
+include "../lib/ids.com"
+
+begin
+	# determine if can do real cell array.
+
+	ca = (IDS_CELLARRAY(i_kt) != 0)
+	if ( !ca )
+	     return
+
+	skip_x = 1.0
+	skip_y = 1.0
+	blockx = 1.0
+	blocky = 1.0
+
+	xres = real(i_xres)
+	yres = real(i_yres)
+
+	# adjust pixels for edges
+	x1 = ax1
+	x2 = ax2
+	y1 = ay1
+	y2 = ay2
+	call ids_cround(x1,x2,xres)
+	call ids_cround(y1,y2,yres)
+
+	# find out how many real pixels we have to fill
+
+	px1 = real(x1) * xres /(GKI_MAXNDC+1)
+	py1 = real(y1) * yres /(GKI_MAXNDC+1)
+	px2 = real(x2) * xres /(GKI_MAXNDC+1)
+	py2 = real(y2) * yres /(GKI_MAXNDC+1)
+
+	nx = int( px2 ) - int( px1 ) + 1
+	ny = int( py2 ) - int( py1 ) + 1
+
+	# if too many data points in input, set skip.  If skip is close
+	# enough to one, set it to one.
+	# set block replication factors - will be > 1.0 if too few input points.
+	# cannot set to 1.0 if "close" enough, since, if > 1.0, we don't have
+	# enough points and so *some* have to be replicated.
+
+	if ( nc > nx ) {
+	    skip_x = real(nc)/nx
+	    if ( (skip_x - 1.0)*(nx-1) < 1.0 )
+		skip_x = 1.0
+	} else
+	    blockx = real(nx)/nc
+
+	if ( nr > ny ) {
+	    skip_y = real(nr)/ny
+	    if ( (skip_y - 1.0)*(ny-1) < 1.0 )
+		skip_y = 1.0
+	} else
+	    blocky = real(ny)/nr
+
+	# initialize counters
+
+	call smark(sp)
+	sy = skip_y
+	bcy = blocky
+	startrow = 1
+	element = startrow
+
+	# see if we can use original data ... no massaging
+	# also set the initial value of the new_row flag, which tells
+	# if we have to rebuild the row data
+	# note that if blockx > 1.0, skip_x must be 1.0, and vv
+
+	if ( (skip_x == 1.0) && (blockx == 1.0) ) {
+	    use_orig = true
+	    new_row  = false
+	} else {
+	    use_orig = false
+	    new_row  = true
+	    # allocate storage for a row of pixels.
+	    call salloc ( cell, nx, TY_SHORT)
+	}
+
+	# do it
+
+	for ( i = 1; i <= ny ; i = i + 1) {
+
+	    # Build the row data.
+
+	    if (!use_orig && new_row) {
+		if ( skip_x == 1.0)
+		    call ids_blockit(m[element], Mems[cell], nx, blockx)
+		else {
+	            sx = skip_x
+	            for ( j = 1; j <= nx; j = j + 1) {
+		        Mems[cell+j-1] = m[element]
+		        element = startrow + int(sx+0.5)
+		        sx = sx + skip_x
+	            }
+		}
+	    }
+
+	    # Send the row data.  The writing routine will figure out
+	    # how to send to the various individual frames and bitplanes.
+
+	    call zseek (i_out, int(px1), int(py1)+i-1)
+	    if (use_orig)
+		call write (i_out, m[element], nx)
+	    else
+		call write (i_out, Mems[cell], nx)
+
+	    # Advance a row.
+
+	    element = startrow
+	    if ( bcy <= real(i) ) {
+		startrow = 1 + nc * int(sy+0.5)
+		element = startrow
+		sy = sy + skip_y
+	        bcy = bcy + blocky
+		new_row = true
+	    } else {
+		new_row = false
+	    }
+	}
+
+	call sfree(sp)
+end
+
+
+# IDS_BLOCKIT -- block replication of data
+
+procedure ids_blockit( from, to, count, factor)
+
+short	from[ARB]			# input data
+short	to[ARB]				# output data
+int	count				# number of output pixels
+real	factor				# blocking factor
+
+int	i, j
+real	bc
+
+begin
+	bc = factor
+	j = 1
+	for ( i = 1; i <= count ; i = i + 1 ) {
+	    to[i] = from[j]
+	    if ( bc <= real(i) ) {
+		j = j + 1
+		bc = bc + factor
+	    }
+	}
+end