Initial commit

1 files changed, 406 insertions, 0 deletions

diff --git a/noao/nproto/ace/mapio.x b/noao/nproto/ace/mapio.x
new file mode 100644
index 00000000..d8f9f9de
--- /dev/null
+++ b/noao/nproto/ace/mapio.x
@@ -0,0 +1,406 @@
+include	<error.h>
+include	<imhdr.h>
+
+define	MAP_LENSTR	99		# Length of strings
+
+# Map data structure.
+define	MAP_LEN		64		# Length of map structure
+define	MAP_NAME	Memc[P2C($1)]	# Name of map
+define	MAP_TYPE	Memi[$1+51]	# Type of map
+define	MAP_MAP		Memi[$1+52]	# Structure pointer
+define	MAP_COPY	Memi[$1+53]	# Data buffer for copy
+define	MAP_NC		Memi[$1+54]	# Number of columns
+define	MAP_NL		Memi[$1+55]	# Number of columns
+define	MAP_SAMPLE	Memi[$1+56]	# Sample size for lines
+define	MAP_BUF		Memi[$1+57]	# Data buffer for constant or sampling
+define	MAP_BUF1	Memi[$1+58]	# Data buffer for sampling
+define	MAP_BUF2	Memi[$1+59]	# Data buffer for sampling
+define	MAP_LINE1	Memi[$1+60]	# Sampling line number
+define	MAP_LINE2	Memi[$1+61]	# Sampling line number
+define	MAP_LASTLINE	Memi[$1+62]	# Last line
+define	MAP_LASTBUF	Memi[$1+63]	# Data buffer last returned
+
+# Types of maps allowed.
+define	MAP_CONST	1		# Constant
+define	MAP_IMAGE	2		# Image
+define	MAP_GSURFIT	3		# GSURFIT
+
+
+# MAP_GLR -- Get a line of map data.
+
+pointer procedure map_glr (map, line, mode)
+
+pointer	map		#I Map pointer
+int	line		#I Line
+int	mode		#I Access mode (READ_ONLY, READ_WRITE)
+
+int	i, nc, nl, sample, line1, line2
+real	a, b
+pointer	buf, buf1, buf2, mim_glr(), mgs_glr()
+errchk	malloc, mim_glr, mgs_glr
+
+begin
+	# Check for repeated request.
+	if (line == MAP_LASTLINE(map)) {
+	    buf = MAP_LASTBUF(map)
+	    if (mode == READ_WRITE) {
+		nc = MAP_NC(map)
+		if (MAP_COPY(map) == NULL)
+		    call malloc (MAP_COPY(map), nc, TY_REAL)
+		call amovr (Memr[buf], Memr[MAP_COPY(map)], nc)
+		buf = MAP_COPY(map)
+	    }
+	    return (buf)
+	}
+
+	nc = MAP_NC(map)
+	nl = MAP_NL(map)
+	sample = MAP_SAMPLE(map)
+
+	# Check for subsampling.  A constant map will never be sampled.
+	if (sample > 1) {
+	    if (MAP_BUF1(map) == NULL) {
+		call malloc (MAP_BUF(map), nc, TY_REAL)
+		call malloc (MAP_BUF1(map), nc, TY_REAL)
+		call malloc (MAP_BUF2(map), nc, TY_REAL)
+	    }
+	    line1 = (line-1) / sample * sample + 1
+	    line2 = min (nl, line1 + sample)
+	    buf1 = MAP_BUF1(map)
+	    buf2 = MAP_BUF2(map)
+	    if (line1 == MAP_LINE2(map)) {
+		MAP_BUF2(map) = buf1
+		MAP_BUF1(map) = buf2
+		MAP_LINE2(map) = MAP_LINE1(map)
+		MAP_LINE1(map) = line1
+		buf1 = MAP_BUF1(map)
+		buf2 = MAP_BUF2(map)
+	    } else if (line2 == MAP_LINE1(map)) {
+		MAP_BUF1(map) = buf2
+		MAP_BUF2(map) = buf1
+		MAP_LINE1(map) = MAP_LINE2(map)
+		MAP_LINE2(map) = line2
+		buf1 = MAP_BUF1(map)
+		buf2 = MAP_BUF2(map)
+	    }
+	    if (line1 != MAP_LINE1(map)) {
+		switch (MAP_TYPE(map)) {
+		case MAP_IMAGE:
+		    buf = mim_glr (MAP_MAP(map), line1)
+		case MAP_GSURFIT:
+		    buf = mgs_glr (MAP_MAP(map), line1)
+		}
+		call amovr (Memr[buf], Memr[buf1], nc)
+		MAP_LINE1(map) = line1
+	    }
+	    if (line2 != MAP_LINE2(map)) {
+		switch (MAP_TYPE(map)) {
+		case MAP_IMAGE:
+		    buf = mim_glr (MAP_MAP(map), line2)
+		case MAP_GSURFIT:
+		    buf = mgs_glr (MAP_MAP(map), line2)
+		}
+		call amovr (Memr[buf], Memr[buf2], nc)
+		MAP_LINE2(map) = line2
+	    }
+	    if (line == line1)
+		buf = buf1
+	    else if (line == line2)
+		buf = buf2
+	    else {
+		buf = MAP_BUF(map)
+		b = real (line - line1) / sample
+		a = 1 - b
+		do i = 0, nc-1
+		    Memr[buf+i] = a * Memr[buf1+i] + b * Memr[buf2+i]
+	    }
+	} else {
+	    switch (MAP_TYPE(map)) {
+	    case MAP_IMAGE:
+		buf = mim_glr (MAP_MAP(map), line)
+	    case MAP_GSURFIT:
+		buf = mgs_glr (MAP_MAP(map), line)
+	    case MAP_CONST:
+		buf = MAP_BUF(map)
+	    }
+	}
+	MAP_LASTLINE(map) = line
+	MAP_LASTBUF(map) = buf
+
+	# Make a copy which might be modified by the caller.
+	if (mode == READ_WRITE) {
+	    nc = MAP_NC(map)
+	    if (MAP_COPY(map) == NULL)
+		call malloc (MAP_COPY(map), nc, TY_REAL)
+	    call amovr (Memr[buf], Memr[MAP_COPY(map)], nc)
+	    buf = MAP_COPY(map)
+	}
+
+	return (buf)
+end
+
+
+# MAP_OPEN -- Open map.  Return NULL if no map is found.
+
+pointer procedure map_open (name, refim)
+
+char	name[ARB]	#I Name
+pointer	refim		#I Reference image
+pointer	map		#O Map pointer returned
+
+int	i, nc, nl, nowhite(), ctor()
+real	const
+pointer	sp, mapstr, im, gs, immap(), mim_open(), mgs_open()
+errchk	calloc, malloc, imgstr, mim_open, mgs_open
+
+begin
+	call smark (sp)
+	call salloc (mapstr, SZ_FNAME, TY_CHAR)
+
+	i = 1
+	nc = IM_LEN(refim,1)
+	nl = IM_LEN(refim,2)
+
+	call calloc (map, MAP_LEN, TY_STRUCT)
+	MAP_NC(map) = nc
+	MAP_NL(map) = nl
+
+	iferr {
+	    # Check for missing map name, and keyword redirection.
+	    if (nowhite (name, Memc[mapstr], SZ_FNAME) == 0)
+		call error (1, "No map specified")
+	    if (Memc[mapstr] == '!')
+		call imgstr (refim, Memc[mapstr+1], Memc[mapstr], SZ_FNAME)
+	    call strcpy (Memc[mapstr], MAP_NAME(map), MAP_LENSTR)
+
+	    ifnoerr (im = immap (MAP_NAME(map), READ_ONLY, 0)) {
+		call imunmap (im)
+		MAP_TYPE(map) = MAP_IMAGE
+		MAP_MAP(map) = mim_open (MAP_NAME(map), refim)
+	    } else ifnoerr (call mgs_ggs (refim, MAP_NAME(map), gs)) {
+		MAP_TYPE(map) = MAP_GSURFIT
+		MAP_MAP(map) = mgs_open (MAP_NAME(map), refim, gs)
+	    } else if (ctor (MAP_NAME(map), i, const) > 0) {
+		MAP_TYPE(map) = MAP_CONST
+		call malloc (MAP_BUF(map), nc, TY_REAL)
+		call amovkr (const, Memr[MAP_BUF(map)], nc)
+	    } else {
+		call mfree (map, TY_STRUCT)
+		call sprintf (Memc[mapstr], SZ_FNAME, "Can't open map (%s)")
+		    call pargstr (name)
+		call error (2, Memc[mapstr])
+	    }
+	} then {
+	    call map_close (map)
+	    call erract (EA_ERROR)
+	}
+
+	call sfree (sp)
+	return (map)
+end
+
+
+# MAP_OPENGS -- Open GSURFIT map given the GSURFIT pointer.
+
+pointer procedure map_opengs (gs, refim)
+
+pointer	gs		#I GSURFIT pointer
+pointer	refim		#I Reference image
+pointer	map		#O Map pointer returned
+
+pointer	mgs_open()
+errchk	calloc, mgs_open
+
+begin
+	iferr {
+	    call calloc (map, MAP_LEN, TY_STRUCT)
+	    MAP_NC(map) = IM_LEN(refim,1)
+	    MAP_NL(map) = IM_LEN(refim,2)
+	    MAP_TYPE(map) = MAP_GSURFIT
+	    MAP_MAP(map) = mgs_open (MAP_NAME(map), refim, gs)
+	} then {
+	    call map_close (map)
+	    call erract (EA_ERROR)
+	}
+
+	return (map)
+end
+
+
+# MAP_CLOSE -- Unmap map structure.
+
+procedure map_close (map)
+
+pointer	map			#I Map pointer
+
+begin
+	if (map == NULL)
+	    return
+
+	switch (MAP_TYPE(map)) {
+	case MAP_IMAGE:
+	    call mim_close (MAP_MAP(map))
+	case MAP_GSURFIT:
+	    call mgs_close (MAP_MAP(map))
+	}
+
+	call mfree (MAP_COPY(map), TY_REAL)
+	call mfree (MAP_BUF(map), TY_REAL)
+	call mfree (MAP_BUF1(map), TY_REAL)
+	call mfree (MAP_BUF2(map), TY_REAL)
+	call mfree (map, TY_STRUCT)
+end
+
+
+# MAP_GETS -- Get string parameter.
+
+procedure map_gets (map, param, val, maxchar)
+
+pointer	map		#I Map pointer
+char	param[ARB]	#I Parameter
+char	val[ARB]	#O Parameter string value 
+int	maxchar		#I Maximum number of characters to return
+
+bool	streq()
+errchk	mim_gets(), mgs_gets()
+
+begin
+	if (streq (param, "mapname"))
+	    call strcpy (MAP_NAME(map), val, maxchar)
+	else {
+	    switch (MAP_TYPE(map)) {
+	    case MAP_IMAGE:
+		call mim_gets (MAP_MAP(map), param, val, maxchar)
+	    case MAP_GSURFIT:
+		call mgs_gets (MAP_MAP(map), param, val, maxchar)
+	    default:
+		call error (1, "map_gets: unknown parameter")
+	    }
+	}
+end
+
+
+# MAP_GETI -- Get integer parameter.
+
+procedure map_geti (map, param, val)
+
+pointer	map		#I Map pointer
+char	param[ARB]	#I Parameter
+int	val		#O Value
+
+errchk	mim_geti(), mgs_geti()
+
+begin
+	switch (MAP_TYPE(map)) {
+	case MAP_IMAGE:
+	    call mim_geti (MAP_MAP(map), param, val)
+	case MAP_GSURFIT:
+	    call mgs_geti (MAP_MAP(map), param, val)
+	default:
+	    call error (1, "map_geti: unknown parameter")
+	}
+end
+
+
+# MAP_GETR -- Get real parameter.
+
+procedure map_getr (map, param, val)
+
+pointer	map		#I Map pointer
+char	param[ARB]	#I Parameter
+real	val		#O Value
+
+bool	streq()
+errchk	mim_getr(), mgs_getr()
+
+begin
+	if (streq (param, "constant")) {
+	    if (MAP_TYPE(map) == MAP_CONST) {
+		val = Memr[MAP_BUF(map)]
+	        return
+	    } else
+	        call error (1, "map_getr: map is not constant")
+	}
+
+	switch (MAP_TYPE(map)) {
+	case MAP_IMAGE:
+	    call mim_getr (MAP_MAP(map), param, val)
+	case MAP_GSURFIT:
+	    call mgs_getr (MAP_MAP(map), param, val)
+	default:
+	    call error (1, "map_getr: unknown parameter")
+	}
+end
+
+
+# MAP_SETI -- Set integer parameter.
+
+procedure map_seti (map, param, val)
+
+pointer	map		#I Map pointer
+char	param[ARB]	#I Parameter
+int	val		#I Value
+
+bool	streq()
+errchk	mim_seti(), mgs_seti
+
+begin
+	switch (MAP_TYPE(map)) {
+	case MAP_CONST:
+	    ;
+	case MAP_IMAGE:
+	    if (streq (param, "sample"))
+		MAP_SAMPLE(map) = max (1, val)
+	    else
+		call mim_seti (MAP_MAP(map), param, val)
+	case MAP_GSURFIT:
+	    if (streq (param, "sample"))
+		MAP_SAMPLE(map) = max (1, val)
+	    else
+		call mgs_seti (MAP_MAP(map), param, val)
+	}
+end
+
+
+# MAP_SETR -- Set real parameter.
+
+procedure map_setr (map, param, val)
+
+pointer	map		#I Map pointer
+char	param[ARB]	#I Parameter
+real	val		#I Value
+
+errchk	mim_setr(), mgs_setr
+
+begin
+	switch (MAP_TYPE(map)) {
+	case MAP_IMAGE:
+	    call mim_setr (MAP_MAP(map), param, val)
+	case MAP_GSURFIT:
+	    call mgs_setr (MAP_MAP(map), param, val)
+	default:
+	    call error (1, "map_setr: unknown parameter")
+	}
+end
+
+
+# MAP_SETS -- Set string parameter.
+
+procedure map_sets (map, param, val)
+
+pointer	map		#I Map pointer
+char	param[ARB]	#I Parameter
+char	val[ARB]	#I Value
+
+errchk	mim_sets(), mgs_sets
+
+begin
+	switch (MAP_TYPE(map)) {
+	case MAP_IMAGE:
+	    call mim_sets (MAP_MAP(map), param, val)
+	case MAP_GSURFIT:
+	    call mgs_sets (MAP_MAP(map), param, val)
+	default:
+	    call error (1, "map_sets: unknown parameter")
+	}
+end