diff options
Diffstat (limited to 'vendor/x11iraf/ximtool/clients')
27 files changed, 6893 insertions, 0 deletions
diff --git a/vendor/x11iraf/ximtool/clients/DONE b/vendor/x11iraf/ximtool/clients/DONE new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/DONE diff --git a/vendor/x11iraf/ximtool/clients/Imakefile b/vendor/x11iraf/ximtool/clients/Imakefile new file mode 100644 index 00000000..0c126522 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/Imakefile @@ -0,0 +1,32 @@ +XCOMM Imakefile for the Image Support Module components. + +X11IRAFDIR = ../../ +#include <../../X11IRAF.tmpl> + + WC_SRCS = wcspix/t_wcspix.x wcspix/wcimage.x wcspix/wcmef.x \ + wcspix/wcmspec.x wcspix/wcspix.h + LIB_SRCS = lib/dspmmap.x lib/ism.x lib/idxstr.x lib/wcsgfterm.x + + +all:: ism_wcspix.e + +ism_wcspix.e: $(WC_SRCS) $(LIB_SRCS) + @(SHELL=/bin/sh ; export SHELL ; mkpkg relink) + touch DONE + +SubdirLibraryRule($(WC_SRCS) $(LIB_SRCS)) + +clean:: + @(rmbin -v .) + touch DONE + +includes:: + +#if InstallBinaries +install:: ism_wcspix.e + -@if [ -d X11irafBinDir ]; then set +x; \ + else (set -x; $(MKDIRHIER) X11irafBinDir); fi + mv ism_wcspix.e X11irafBinDir +#endif + +DependTarget() diff --git a/vendor/x11iraf/ximtool/clients/Makefile b/vendor/x11iraf/ximtool/clients/Makefile new file mode 100644 index 00000000..9de62c08 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/Makefile @@ -0,0 +1,1067 @@ +# Makefile generated by imake - do not edit! +# $Xorg: imake.c,v 1.6 2001/02/09 02:03:15 xorgcvs Exp $ + +# ---------------------------------------------------------------------- +# Makefile generated from "Imake.tmpl" and <Imakefile> +# $Xorg: Imake.tmpl,v 1.4 2000/08/17 19:41:46 cpqbld Exp $ +# +# +# +# +# $XFree86: xc/config/cf/Imake.tmpl,v 3.138 2002/12/10 03:20:41 dawes Exp $ +# ---------------------------------------------------------------------- + +all:: + +.SUFFIXES: .i + +# $Xorg: Imake.cf,v 1.4 2000/08/17 19:41:45 cpqbld Exp $ + +# $XFree86: xc/config/cf/Imake.cf,v 3.80 2003/01/15 02:52:12 dawes Exp $ + +# Keep cpp from replacing path elements containing i486/i586/i686 + +# ----------------------------------------------------------------------- +# site-specific configuration parameters that need to come before +# the platform-specific parameters - edit site.def to change + +# site: $TOG: site.sample /main/r64_final/1 1998/02/05 16:28:49 kaleb $ + +# site: $XFree86: xc/config/cf/site.def,v 3.24 2000/06/25 20:17:29 dawes Exp $ + +# $XFree86: xc/config/cf/xf86site.def,v 3.181 2002/02/22 21:32:33 dawes Exp $ + +# ---------------------------------------------------------------------- +# platform-specific configuration parameters - edit linux.cf to change + +# platform: $Xorg: linux.cf,v 1.3 2000/08/17 19:41:47 cpqbld Exp $ + +# platform: $XFree86: xc/config/cf/linux.cf,v 3.201tsi Exp $ + +# operating system: Linux 2.4.29-4aslsmp i686 [ELF] (2.4.29) +# libc: (6.3.2) +# binutils: (213) + +# $Xorg: lnxLib.rules,v 1.3 2000/08/17 19:41:47 cpqbld Exp $ +# $XFree86: xc/config/cf/lnxLib.rules,v 3.43 2002/04/04 14:05:33 eich Exp $ + +# $XFree86: xc/config/cf/xfree86.cf,v 3.439.2.1 2003/03/13 04:10:40 tsi Exp $ + +# $Xorg: xfree86.cf,v 1.4 2000/08/17 19:41:49 cpqbld Exp $ + +VENDORMANNAME = XFree86 +VENDORMANVERSION = `echo 4 3 0 | sed -e 's/ /./g' -e 's/^/Version\\\ /'` + +AFB_DEFS = -DUSE_AFB + +DRIVERSDKDIR = $(USRLIBDIR)/Server +DRIVERSDKMODULEDIR = $(USRLIBDIR)/Server/modules +DRIVERSDKINCLUDEDIR = $(USRLIBDIR)/Server/include + + XF86SRC = $(SERVERSRC)/hw/xfree86 + XF86COMSRC = $(XF86SRC)/common + XF86PARSERSRC = $(XF86SRC)/parser + XF86OSSRC = $(XF86SRC)/os-support + XF86DRIVERSRC = $(XF86SRC)/drivers + DRIVERSRC = $(XF86DRIVERSRC) + + XFREE86DOCDIR = $(DOCDIR) + XFREE86PSDOCDIR = $(DOCPSDIR) + XFREE86HTMLDOCDIR = $(DOCHTMLDIR) +XFREE86JAPANESEDOCDIR = $(DOCDIR)/Japanese + +# $Xorg: xf86.rules,v 1.3 2000/08/17 19:41:48 cpqbld Exp $ + +# $XFree86: xc/config/cf/xf86.rules,v 3.33 2001/01/17 16:38:51 dawes Exp $ + +# ---------------------------------------------------------------------- +# site-specific configuration parameters that go after +# the platform-specific parameters - edit site.def to change + +# site: $TOG: site.sample /main/r64_final/1 1998/02/05 16:28:49 kaleb $ + +# site: $XFree86: xc/config/cf/site.def,v 3.24 2000/06/25 20:17:29 dawes Exp $ + +# --------------------------------------------------------------------- +# Imake rules for building libraries, programs, scripts, and data files +# rules: $Xorg: Imake.rules,v 1.3 2000/08/17 19:41:46 cpqbld Exp $ +# +# +# +# +# rules: $XFree86: xc/config/cf/Imake.rules,v 3.112 2002/11/14 21:01:13 tsi Exp $ + + _NULLCMD_ = @ echo -n + +GLIDE2INCDIR = /usr/include/glide + +GLIDE3INCDIR = /usr/include/glide3 + +GLIDE3LIBNAME = glide3 + +TKLIBNAME = + +TKLIBDIR = + +TCLLIBNAME = + +TCLIBDIR = + + PATHSEP = / + SHELL = /bin/sh -e + + TOP = ../.. + CURRENT_DIR = ximtool/clients + + IMAKE = imake + DEPEND = gccmakedep + MKDIRHIER = mkdir -p + REVPATH = revpath + EXPORTLISTGEN = + RMAN = rman + RMANBASENAME = rman + RMANOPTIONS = -f HTML + CONFIGSRC = $(TOP)/config + IMAKESRC = $(CONFIGSRC)/imake + DEPENDSRC = $(CONFIGSRC)/util + + INCROOT = /usr/X11R6/include + USRLIBDIR = /usr/X11R6/lib + VARDIR = /var + VARLIBDIR = $(VARDIR)/lib + SYSTEMUSRLIBDIR = /usr/lib + SYSTEMUSRINCDIR = /usr/include + SHLIBDIR = /usr/X11R6/lib + LINTLIBDIR = $(USRLIBDIR)/lint + MANPATH = /usr/X11R6/man + MANSOURCEPATH = $(MANPATH)/man + MANDIR = $(MANSOURCEPATH)1 + LIBMANDIR = $(MANSOURCEPATH)3 + FILEMANDIR = $(MANSOURCEPATH)5 + MISCMANDIR = $(MANSOURCEPATH)7 + DRIVERMANDIR = $(MANSOURCEPATH)4 + ICONDIR = /usr/share/icons + XCURSORPATH = "~/.icons:/usr/share/icons:/usr/share/pixmaps" + LOGDIRECTORY = $(VARDIR)/log + + VARRUNDIR = $(VARDIR)/run + + VARDBDIR = $(VARDIR)/lib + + AR = ar clq + +# Nice try but useless: make will inherit BOOTSTRAPCFLAGS +# from top Makefile + BOOTSTRAPCFLAGS = -O2 -pipe -march=i386 -mcpu=i686 -pipe + + CC = gcc -m32 + AS = gcc -m32 -c -x assembler + +.SUFFIXES: .cc + + CXX = c++ -m32 + + CXXFILT = c++filt + CXXLIB = + CXXDEBUGFLAGS = -O2 -pipe -march=i386 -mcpu=i686 -fno-strict-aliasing -pipe +CXXDEPENDINCLUDES = + CXXEXTRA_DEFINES = +CXXEXTRA_INCLUDES = + CXXSTD_DEFINES = -Dlinux -D__i386__ -D_POSIX_C_SOURCE=199309L -D_POSIX_SOURCE -D_XOPEN_SOURCE -D_BSD_SOURCE -D_SVID_SOURCE $(CXXPROJECT_DEFINES) + CXXOPTIONS = + CXXINCLUDES = $(INCLUDES) $(TOP_INCLUDES) $(CXXEXTRA_INCLUDES) + CXXDEFINES = $(CXXINCLUDES) $(CXXSTD_DEFINES) $(THREADS_CXXDEFINES) $(DEFINES) $(CXXEXTRA_DEFINES) + CXXFLAGS = $(CXXDEBUGFLAGS) $(CXXOPTIONS) $(THREADS_CXXFLAGS) $(CXXDEFINES) + + COMPRESS = compress + GZIPCMD = gzip + + CPP = /usr/bin/cpp $(STD_CPP_DEFINES) + RAWCPP = /usr/bin/cpp -undef $(STD_CPP_OPTIONS) + PREPROCESSCMD = gcc -m32 -E $(STD_CPP_DEFINES) + + INSTALL = install + INSTALLFLAGS = -c + + LD = gcc -m32 -nostdlib + + LEX = flex -l + M4 = m4 + M4FLAGS = + LEXLIB = -lfl + YACC = bison -y + CCYACC = bison -y + + LINT = lint + + LINTLIBFLAG = -C + LINTOPTS = -axz + LN = ln -s + MAKE = make + MV = mv -f + CP = cp + + RANLIB = ranlib + + RANLIBINSTFLAGS = + + RM = rm -f + PERL = perl + PERLOPTS = + MANSUFFIX = 1x + LIBMANSUFFIX = 3x + FILEMANSUFFIX = 5x + MISCMANSUFFIX = 7x + DRIVERMANSUFFIX = 4x + MANSRCSUFFIX = man + MANNEWSUFFIX = _man + MANDEFS = -D__apploaddir__=$(XAPPLOADDIR) -D__filemansuffix__=$(FILEMANSUFFIX) -D__libmansuffix__=$(LIBMANSUFFIX) -D__miscmansuffix__=$(MISCMANSUFFIX) -D__drivermansuffix__=$(DRIVERMANSUFFIX) -D__projectroot__=$(PROJECTROOT) $(XORGMANDEFS) $(VENDORMANDEFS) + + COMPRESSMANCMD = gzip -n + + TROFF = groff -Tps + NROFF = nroff + MSMACROS = -ms + MANMACROS = -man + TBL = tbl + EQN = eqn + NEQN = neqn + COL = col + COLFLAGS = -b + + MODCC = gcc -m32 + + MODCPP = /usr/bin/cpp + MODCFLAGS = $(CFLAGS) + MODAS = gcc -m32 -c -x assembler + MODASFLAGS = + + MODLD = gcc -m32 -nostdlib + + MODLDFLAGS = +MODLDCOMBINEFLAGS = -r + MODAR = ar clq + + MODRANLIB = ranlib + + STD_INCLUDES = + STD_CPP_OPTIONS = -traditional + STD_CPP_DEFINES = -traditional -Dlinux -D__i386__ -D_POSIX_C_SOURCE=199309L -D_POSIX_SOURCE -D_XOPEN_SOURCE -D_BSD_SOURCE -D_SVID_SOURCE $(PROJECT_DEFINES) + STD_DEFINES = -Dlinux -D__i386__ -D_POSIX_C_SOURCE=199309L -D_POSIX_SOURCE -D_XOPEN_SOURCE -D_BSD_SOURCE -D_SVID_SOURCE $(PROJECT_DEFINES) + EXTRA_LOAD_FLAGS = + EXTRA_LDOPTIONS = + EXTRA_LIBRARIES = + TAGS = ctags + + PARALLELMFLAGS = + + SHAREDCODEDEF = + SHLIBDEF = + + SHLIBLDFLAGS = -shared $(SHLIBGLOBALSFLAGS) + + PICFLAGS = -fPIC + + CXXPICFLAGS = -fPIC + + PROTO_DEFINES = -DFUNCPROTO=15 -DNARROWPROTO + + INSTPGMFLAGS = + + INSTBINFLAGS = -m 0755 + INSTUIDFLAGS = -m 4711 + INSTLIBFLAGS = -m 0644 + INSTINCFLAGS = -m 0444 + INSTMANFLAGS = -m 0444 + INSTDATFLAGS = -m 0444 + INSTKMEMFLAGS = -m 4711 + + PROJECTROOT = /usr/X11R6 + + CDEBUGFLAGS = -O2 -pipe -march=i386 -mcpu=i686 -fno-strict-aliasing -pipe + CCOPTIONS = + + ALLINCLUDES = $(INCLUDES) $(EXTRA_INCLUDES) $(TOP_INCLUDES) $(INSTALLED_INCLUDES) $(STD_INCLUDES) + ALLDEFINES = $(ALLINCLUDES) $(STD_DEFINES) $(PROTO_DEFINES) $(THREADS_DEFINES) $(MODULE_DEFINES) $(DEFINES) $(EXTRA_DEFINES) + CFLAGS = $(CDEBUGFLAGS) $(CCOPTIONS) $(THREADS_CFLAGS) $(MODULE_CFLAGS) $(ALLDEFINES) + LINTFLAGS = $(LINTOPTS) -DLINT $(ALLDEFINES) $(DEPEND_DEFINES) + LDPRELIB = -L$(USRLIBDIR) $(INSTALLED_LIBS) + LDPOSTLIB = + LDOPTIONS = $(CDEBUGFLAGS) $(CCOPTIONS) $(EXTRA_LDOPTIONS) $(THREADS_LDFLAGS) $(LOCAL_LDFLAGS) $(LDPRELIBS) + CXXLDOPTIONS = $(CXXDEBUGFLAGS) $(CXXOPTIONS) $(EXTRA_LDOPTIONS) $(THREADS_CXXLDFLAGS) $(LOCAL_LDFLAGS) $(LDPRELIBS) + + LDLIBS = $(LDPOSTLIBS) $(THREADS_LIBS) $(SYS_LIBRARIES) $(EXTRA_LIBRARIES) + + CCLINK = $(CC) + + CXXLINK = $(CXX) + + LDSTRIPFLAGS = -x + LDCOMBINEFLAGS = -r + DEPENDFLAGS = + DEPEND_DEFINES = + +# Not sure this belongs here + TKLIBDIR = + TKINCDIR = + TKLIBNAME = + TKLIBRARY = -L$(TKLIBDIR) -l$(TKLIBNAME) + TCLLIBDIR = + TCLINCDIR = + TCLLIBNAME = + TCLLIBRARY = -L$(TCLLIBDIR) -l$(TCLLIBNAME) + + MACROFILE = linux.cf + RM_CMD = $(RM) + + IMAKE_DEFINES = + IMAKE_WARNINGS = -Wundef + + IRULESRC = $(CONFIGDIR) + IMAKE_CMD = $(IMAKE) -DUseInstalled -I$(IRULESRC) $(IMAKE_DEFINES) $(IMAKE_WARNINGS) + + ICONFIGFILES = $(IRULESRC)/Imake.tmpl $(IRULESRC)/X11.tmpl $(IRULESRC)/site.def $(IRULESRC)/$(MACROFILE) $(IRULESRC)/xfree86.cf $(IRULESRC)/xf86.rules $(IRULESRC)/xf86site.def $(IRULESRC)/host.def $(EXTRA_ICONFIGFILES) + +# $Xorg: X11.rules,v 1.4 2000/08/17 19:41:46 cpqbld Exp $ + +# $XFree86: xc/config/cf/X11.rules,v 1.5 2000/11/06 19:24:00 dawes Exp $ + +# ---------------------------------------------------------------------- +# X Window System Build Parameters and Rules +# $Xorg: X11.tmpl,v 1.6 2000/08/17 19:41:46 cpqbld Exp $ +# +# +# +# +# $XFree86: xc/config/cf/X11.tmpl,v 1.196.2.2 2003/09/17 05:58:15 herrb Exp $ + +XORGRELSTRING = Release 6.6 +XORGMANNAME = X Version 11 + +VENDORMANNAME = XFree86 +VENDORMANVERSION = `echo 4 3 0 | sed -e 's/ /./g' -e 's/^/Version\\\ /'` + +STICKY_DEFINES = -DHAS_STICKY_DIR_BIT + +FCHOWN_DEFINES = -DHAS_FCHOWN + +# ----------------------------------------------------------------------- +# X Window System make variables; these need to be coordinated with rules + + XTOP = $(TOP) + BINDIR = /usr/X11R6/bin + BUILDINCROOT = $(TOP)/exports + BUILDINCDIR = $(BUILDINCROOT)/include + BUILDINCTOP = ../.. + BUILDLIBDIR = $(TOP)/exports/lib + BUILDLIBTOP = ../.. + BUILDBINDIR = $(TOP)/exports/bin + BUILDBINTOP = ../.. + BUILDMODULEDIR = $(BUILDLIBDIR)/modules + BUILDMODULETOP = $(BUILDLIBTOP)/.. + XBUILDINCROOT = $(XTOP)/exports + XBUILDINCDIR = $(XBUILDINCROOT)/include/X11 + XBUILDINCTOP = ../../.. + XBUILDBINDIR = $(XBUILDINCROOT)/bin + INCDIR = $(INCROOT) + ADMDIR = /var/log + LIBDIR = /usr/X11R6/lib/X11 + LIBEXECDIR = /usr/X11R6/libexec + MODULEDIR = $(USRLIBDIR)/modules + TOP_X_INCLUDES = + + ETCX11DIR = /etc/X11 + + CONFDIR = $(ETCX11DIR) + + DOCDIR = $(LIBDIR)/doc + DOCHTMLDIR = $(DOCDIR)/html + DOCPSDIR = $(DOCDIR)/PostScript + FONTDIR = $(LIBDIR)/fonts + ENCODINGSDIR = $(FONTDIR)/encodings + XINITDIR = /etc/X11/xinit + XDMDIR = /etc/X11/xdm + XDMVARDIR = $(VARLIBDIR)/xdm + TWMDIR = $(LIBDIR)/twm + XSMDIR = $(LIBDIR)/xsm + NLSDIR = $(LIBDIR)/nls + XLOCALEDIR = $(LIBDIR)/locale + PEXAPIDIR = $(LIBDIR)/PEX + LBXPROXYDIR = /etc/X11/lbxproxy + PROXYMANAGERDIR = /etc/X11/proxymngr + XPRINTDIR = /etc/X11/xserver + XAPPLOADDIR = $(LIBDIR)/app-defaults + FONTCFLAGS = -t + + INSTAPPFLAGS = $(INSTDATFLAGS) + + RGB = $(BINDIR)/rgb + FONTC = $(BINDIR)/bdftopcf + MKFONTDIR = $(BINDIR)/mkfontdir + MKHTMLINDEX = $(BINDIR)/mkhtmlindex + UCS2ANY = $(BINDIR)/ucs2any + BDFTRUNCATE = $(BINDIR)/bdftruncate + UCSMAPPREFIX = $(FONTDIR)/util/map- + XCURSORGEN = $(BINDIR)/xcursorgen + + HTMLINDEXCMD = HtmlIndexCmd + + DOCUTILSRC = $(XTOP)/doc/util + CLIENTSRC = $(TOP)/clients + DEMOSRC = $(TOP)/demos + XDOCMACROS = $(DOCUTILSRC)/macros.t + XIDXMACROS = $(DOCUTILSRC)/indexmacros.t + PROGRAMSRC = $(TOP)/programs + LIBSRC = $(XTOP)/lib + FONTSRC = $(XTOP)/fonts + ENCODINGSSRC = $(FONTSRC)/encodings + INCLUDESRC = $(BUILDINCROOT)/include + XINCLUDESRC = $(INCLUDESRC)/X11 + SERVERSRC = $(XTOP)/programs/Xserver + CONTRIBSRC = $(XTOP)/../contrib + UNSUPPORTEDSRC = $(XTOP)/unsupported + DOCSRC = $(XTOP)/doc + RGBSRC = $(XTOP)/programs/rgb + BDFTOPCFSRC = $(PROGRAMSRC)/bdftopcf + MKFONTDIRSRC = $(PROGRAMSRC)/mkfontdir + FONTSERVERSRC = $(PROGRAMSRC)/xfs + FONTINCSRC = $(XTOP)/include/fonts + EXTINCSRC = $(XTOP)/include/extensions + FTSOURCEDIR = $(TOP)/extras/FreeType + XTTSOURCEDIR = $(TOP)/extras/X-TrueType + MESASRCDIR = $(TOP)/extras/Mesa + OGLSAMPLESRCDIR = $(TOP)/extras/ogl-sample + PSWRAPSRC = $(XTOP)/config/pswrap + TRANSCOMMSRC = $(LIBSRC)/xtrans + TRANS_INCLUDES = -I$(TRANSCOMMSRC) + CONNECTION_FLAGS = -DUNIXCONN -DTCPCONN $(STICKY_DEFINES) $(FCHOWN_DEFINES) + + XORGMANDEFS = -D__xorgversion__='"$(XORGRELSTRING)" "$(XORGMANNAME)"' + VENDORMANDEFS = -D__vendorversion__="\"Version $(VENDORMANVERSION)\" $(VENDORMANNAME)" + + XENVLIBDIR = $(USRLIBDIR) + CLIENTENVSETUP = LD_LIBRARY_PATH=$(XENVLIBDIR) + +# $Xorg: lnxLib.tmpl,v 1.3 2000/08/17 19:41:47 cpqbld Exp $ +# $XFree86: xc/config/cf/lnxLib.tmpl,v 3.13 2001/01/17 16:22:32 dawes Exp $ + + XLIBSRC = $(LIBSRC)/X11 + +SOXLIBREV = 6.2 +DEPXONLYLIB = +XONLYLIB = -lX11 + +LINTXONLY = $(LINTLIBDIR)/llib-lX11.ln + + XLIBONLY = $(XONLYLIB) + + XEXTLIBSRC = $(LIBSRC)/Xext + +SOXEXTREV = 6.4 +DEPEXTENSIONLIB = +EXTENSIONLIB = -lXext + +LINTEXTENSION = $(LINTLIBDIR)/llib-lXext.ln + +LINTEXTENSIONLIB = $(LINTEXTENSION) + DEPXLIB = $(DEPEXTENSIONLIB) $(DEPXONLYLIB) + XLIB = $(EXTENSIONLIB) $(XONLYLIB) + LINTXLIB = $(LINTXONLYLIB) + + XSSLIBSRC = $(LIBSRC)/Xss + +DEPXSSLIB = $(USRLIBDIR)/libXss.a +XSSLIB = -lXss + +LINTXSS = $(LINTLIBDIR)/llib-lXss.ln + + XXF86MISCLIBSRC = $(LIBSRC)/Xxf86misc + +DEPXXF86MISCLIB = $(USRLIBDIR)/libXxf86misc.a +XXF86MISCLIB = -lXxf86misc + +LINTXXF86MISC = $(LINTLIBDIR)/llib-lXxf86misc.ln + + XXF86VMLIBSRC = $(LIBSRC)/Xxf86vm + +DEPXXF86VMLIB = $(USRLIBDIR)/libXxf86vm.a +XXF86VMLIB = -lXxf86vm + +LINTXXF86VM = $(LINTLIBDIR)/llib-lXxf86vm.ln + + XXF86DGALIBSRC = $(LIBSRC)/Xxf86dga + +DEPXXF86DGALIB = $(USRLIBDIR)/libXxf86dga.a +XXF86DGALIB = -lXxf86dga + +LINTXXF86DGA = $(LINTLIBDIR)/llib-lXxf86dga.ln + + XXF86RUSHLIBSRC = $(LIBSRC)/Xxf86rush + +DEPXXF86RUSHLIB = $(USRLIBDIR)/libXxf86rush.a +XXF86RUSHLIB = -lXxf86rush + +LINTXXF86RUSH = $(LINTLIBDIR)/llib-lXxf86rush.ln + + XVLIBSRC = $(LIBSRC)/Xv + +SOXVREV = 1.0 +DEPXVLIB = +XVLIB = -lXv + +LINTXV = $(LINTLIBDIR)/llib-lXv.ln + + XVMCLIBSRC = $(LIBSRC)/XvMC + +DEPXVMCLIB = $(USRLIBDIR)/libXvMC.a +XVMCLIB = -lXvMC + +LINTXVMC = $(LINTLIBDIR)/llib-lXvMC.ln + + XINERAMALIBSRC = $(LIBSRC)/Xinerama + +DEPXINERAMALIB = $(USRLIBDIR)/libXinerama.a +XINERAMALIB = -lXinerama + +LINTXINERAMA = $(LINTLIBDIR)/llib-lXinerama.ln + + XRESLIBSRC = $(LIBSRC)/XRes + +DEPXRESLIB = $(USRLIBDIR)/libXRes.a +XRESLIB = -lXRes + +LINTXRES = $(LINTLIBDIR)/llib-lXRes.ln + + DPSLIBSRC = $(LIBSRC)/dps + +SODPSREV = 1.0 +DEPDPSLIB = +DPSLIB = -ldps + +LINTDPS = $(LINTLIBDIR)/llib-ldps.ln + + DPSTKLIBSRC = $(LIBSRC)/dpstk + +SODPSTKREV = 1.0 +DEPDPSTKLIB = +DPSTKLIB = -ldpstk + +LINTDPSTK = $(LINTLIBDIR)/llib-ldpstk.ln + + PSRESLIBSRC = $(LIBSRC)/psres + +SOPSRESREV = 1.0 +DEPPSRESLIB = +PSRESLIB = -lpsres + +LINTPSRES = $(LINTLIBDIR)/llib-lpsres.ln + + GLULIBSRC = $(LIBSRC)/GLU + +SOGLUREV = 1.3 +DEPGLULIB = +GLULIB = -lGLU + +LINTGLU = $(LINTLIBDIR)/llib-lGLU.ln + + GLXLIBSRC = $(LIBSRC)/GL + +SOGLREV = 1.2 +DEPGLXLIB = +GLXLIB = -lGL + +LINTGLX = $(LINTLIBDIR)/llib-lGL.ln + + GLWIDGETSRC = $(LIBSRC)/GLw + +DEPGLWLIB = $(USRLIBDIR)/libGLw.a +GLWLIB = -lGLw + +LINTGLW = $(LINTLIBDIR)/llib-lGLw.ln + + XRENDERLIBSRC = $(LIBSRC)/Xrender + +SOXRENDERREV = 1.2 +DEPXRENDERLIB = +XRENDERLIB = -lXrender + +LINTXRENDER = $(LINTLIBDIR)/llib-lXrender.ln + + XRANDRRLIBSRC = $(LIBSRC)/Xrandr + +SOXRANDRREV = 2.0 +DEPXRANDRLIB = +XRANDRLIB = -lXrandr + +LINTXRANDR = $(LINTLIBDIR)/llib-lXrandr.ln + + XCURSORRLIBSRC = $(LIBSRC)/Xcursor + +SOXCURSORREV = 1.0 +DEPXCURSORLIB = +XCURSORLIB = -lXcursor + +LINTXCURSOR = $(LINTLIBDIR)/llib-lXcursor.ln + + XFONTCACHELIBSRC = $(LIBSRC)/Xfontcache + +DEPXFONTCACHELIB = $(USRLIBDIR)/libXfontcache.a +XFONTCACHELIB = -lXfontcache + +LINTXFONTCACHE = $(LINTLIBDIR)/llib-lXfontcache.ln + + XAUTHSRC = $(LIBSRC)/Xau + +DEPXAUTHLIB = $(USRLIBDIR)/libXau.a +XAUTHLIB = -lXau + +LINTXAUTH = $(LINTLIBDIR)/llib-lXau.ln + + XDMCPLIBSRC = $(LIBSRC)/Xdmcp + +DEPXDMCPLIB = $(USRLIBDIR)/libXdmcp.a +XDMCPLIB = -lXdmcp + +LINTXDMCP = $(LINTLIBDIR)/llib-lXdmcp.ln + + XMUSRC = $(LIBSRC)/Xmu + +SOXMUREV = 6.2 +DEPXMULIB = +XMULIB = -lXmu + +LINTXMU = $(LINTLIBDIR)/llib-lXmu.ln + + XMUUSRC = $(LIBSRC)/Xmuu + +SOXMUUREV = 1.0 +DEPXMUULIB = +XMUULIB = -lXmuu + +LINTXMUU = $(LINTLIBDIR)/llib-lXmuu.ln + + OLDXLIBSRC = $(LIBSRC)/oldX + +DEPOLDXLIB = $(USRLIBDIR)/liboldX.a +OLDXLIB = -loldX + +LINTOLDX = $(LINTLIBDIR)/llib-loldX.ln + + XPLIBSRC = $(LIBSRC)/Xp + +SOXPREV = 6.2 +DEPXPLIB = +XPLIB = -lXp + +LINTXP = $(LINTLIBDIR)/llib-lXp.ln + + TOOLKITSRC = $(LIBSRC)/Xt + +SOXTREV = 6.0 +DEPXTOOLONLYLIB = +XTOOLONLYLIB = -lXt + +LINTXTOOLONLY = $(LINTLIBDIR)/llib-lXt.ln + + DEPXTOOLLIB = $(DEPXTOOLONLYLIB) $(DEPSMLIB) $(DEPICELIB) + XTOOLLIB = $(XTOOLONLYLIB) $(SMLIB) $(ICELIB) + LINTXTOOLLIB = $(LINTXTOOLONLYLIB) + + XALIBSRC = $(LIBSRC)/Xa + +SOXAREV = 1.0 +DEPXALIB = +XALIB = -lXa + +LINTXA = $(LINTLIBDIR)/llib-lXa.ln + + AWIDGETSRC = $(LIBSRC)/Xaw + +SOXAWREV = 7.0 +DEPXAWLIB = +XAWLIB = -lXaw + +LINTXAW = $(LINTLIBDIR)/llib-lXaw.ln + + AWIDGET6SRC = $(LIBSRC)/Xaw6 + +SOXAW6REV = 6.1 +DEPXAW6LIB = +XAW6LIB = -lXaw + +LINTXAW6 = $(LINTLIBDIR)/llib-lXaw.ln + + XILIBSRC = $(LIBSRC)/Xi + +SOXINPUTREV = 6.0 +DEPXILIB = +XILIB = -lXi + +LINTXI = $(LINTLIBDIR)/llib-lXi.ln + + XTESTLIBSRC = $(LIBSRC)/Xtst + +SOXTESTREV = 6.1 +DEPXTESTLIB = +XTESTLIB = -lXtst + +LINTXTEST = $(LINTLIBDIR)/llib-lXtst.ln + + PEXLIBSRC = $(LIBSRC)/PEX5 + +SOPEXREV = 6.0 +DEPPEXLIB = +PEXLIB = -lPEX5 + +LINTPEX = $(LINTLIBDIR)/llib-lPEX5.ln + + XIELIBSRC = $(LIBSRC)/XIE + +SOXIEREV = 6.0 +DEPXIELIB = +XIELIB = -lXIE + +LINTXIE = $(LINTLIBDIR)/llib-lXIE.ln + + PHIGSLIBSRC = $(LIBSRC)/PHIGS + +DEPPHIGSLIB = $(USRLIBDIR)/libphigs.a +PHIGSLIB = -lphigs + +LINTPHIGS = $(LINTLIBDIR)/llib-lphigs.ln + +DEPXBSDLIB = $(USRLIBDIR)/libXbsd.a +XBSDLIB = -lXbsd + +LINTXBSD = $(LINTLIBDIR)/llib-lXbsd.ln + + ICESRC = $(LIBSRC)/ICE + +SOICEREV = 6.3 +DEPICELIB = +ICELIB = -lICE + +LINTICE = $(LINTLIBDIR)/llib-lICE.ln + + SMSRC = $(LIBSRC)/SM + +SOSMREV = 6.0 +DEPSMLIB = +SMLIB = -lSM + +LINTSM = $(LINTLIBDIR)/llib-lSM.ln + + XKEYSRC = $(LIBSRC)/Xkey + +SOXKEYREV = 6.0 +DEPXKEYLIB = +XKEYLIB = -lXkey + +LINTXKEY = $(LINTLIBDIR)/llib-lXkey.ln + + FSLIBSRC = $(LIBSRC)/FS + +DEPFSLIB = $(USRLIBDIR)/libFS.a +FSLIB = -lFS + +LINTFS = $(LINTLIBDIR)/llib-lFS.ln + + FONTLIBSRC = $(LIBSRC)/font + +SOFONTREV = 1.4 +DEPFONTLIB = +FONTLIB = -L$(FREETYPELIBDIR) -L$(FONTLIBSRC) -lXfont + +LINTXFONT = $(LINTLIBDIR)/llib-lXfont.ln +# +SOFONTREV = 1.4 +DEPXFONTLIB = +XFONTLIB = -lXfont + +LINTXFONT = $(LINTLIBDIR)/llib-lXfont.ln + + FONTSTUBLIBSRC = $(FONTLIBSRC)/stubs + +DEPFONTSTUBLIB = $(USRLIBDIR)/libfntstubs.a +FONTSTUBLIB = -lfntstubs + +LINTFONTSTUB = $(LINTLIBDIR)/llib-lfntstubs.ln + DEPFONTLIB = $(DEPXFONTLIB) $(DEPFONTSTUBLIB) + FONTLIB = $(XFONTLIB) $(FONTSTUBLIB) $(FONTFT2LIB) + + FONTENCLIBSRC = $(LIBSRC)/fontenc + +DEPXFONTENCLIB = $(USRLIBDIR)/libfontenc.a +XFONTENCLIB = -lfontenc + +LINTXFONTENC = $(LINTLIBDIR)/llib-lfontenc.ln + + XPMLIBSRC = $(LIBSRC)/Xpm + +SOXPMREV = 4.11 +DEPXPMLIB = +XPMLIB = -lXpm + +LINTXPM = $(LINTLIBDIR)/llib-lXpm.ln + +FREETYPE2DIR = /usr +FREETYPE2LIBDIR = /usr/lib +FREETYPE2INCDIR = /usr/include/freetype2 + +FREETYPE2LIB = -lfreetype + +FREETYPE2INCLUDES = -I$(FREETYPE2INCDIR) +FREETYPE2DEFINES = -DFREETYPE2 + + EXPATLIBSRC = $(LIBSRC)/expat + +SOEXPATREV = 1.0 +DEPEXPATLIB = +EXPATLIB = -lexpat + +LINTEXPAT = $(LINTLIBDIR)/llib-lexpat.ln + +EXPATDIR = /usr +EXPATLIBDIR = /usr/lib +EXPATINCDIR = /usr/include + +EXPATINCLUDES = + +EXPATLIB = -lexpat + +EXPATDEFINES = -DEXPAT + + XFT1LIBSRC = $(LIBSRC)/Xft1 + +SOXFT1REV = 1.1 +DEPXFT1LIB = +XFT1LIB = -lXft + +LINTXFT1 = $(LINTLIBDIR)/llib-lXft.ln + + XFTLIBSRC = $(LIBSRC)/Xft + +SOXFTREV = 2.1 +DEPXFTLIB = +XFTLIB = -lXft + +LINTXFT = $(LINTLIBDIR)/llib-lXft.ln + +XFTINCLUDES=$(FONTCONFIGINCLUDES) $(FREETYPE2INCLUDES) + +FONTCONFIGDIR = /usr +FONTCONFIGLIBDIR = /usr/lib +FONTCONFIGINCDIR = /usr/include +FONTCONFIGBINDIR = /usr/bin + +FONTCONFIGLIB = -lfontconfig + +FONTCONFIGINCLUDES = + +FCCACHE = $(FONTCONFIGBINDIR)/fc-cache + +FONTCONFIGDEFINES = -DFONTCONFIG + +LIBPNGINCDIR = /usr/include + +LIBPNGINC= + +LIBPNGDIR = /usr +LIBPNGLIBDIR = /usr/lib +LIBPNGINCDIR = /usr/include + +LIBPNGLIB = -lpng + + XKBFILELIBSRC = $(LIBSRC)/xkbfile + +DEPXKBFILELIB = $(USRLIBDIR)/libxkbfile.a +XKBFILELIB = -lxkbfile + +LINTXKBFILE = $(LINTLIBDIR)/llib-lxkbfile.ln + + XKBCOMPCMD = $(BINDIR)/xkbcomp + + XKBUILIBSRC = $(LIBSRC)/xkbui + +DEPXKBUILIB = $(USRLIBDIR)/libxkbui.a +XKBUILIB = -lxkbui + +LINTXKBUI = $(LINTLIBDIR)/llib-lxkbui.ln + + XTRAPLIBSRC = $(LIBSRC)/XTrap + +SOXTRAPREV = 6.4 +DEPXTRAPLIB = +XTRAPLIB = -lXTrap + +LINTXTRAP = $(LINTLIBDIR)/llib-lXTrap.ln + + DEPLIBS = $(DEPXAWLIB) $(DEPXMULIB) $(DEPXTOOLLIB) $(DEPXLIB) + + DEPLIBS1 = $(DEPLIBS) + DEPLIBS2 = $(DEPLIBS) + DEPLIBS3 = $(DEPLIBS) + DEPLIBS4 = $(DEPLIBS) + DEPLIBS5 = $(DEPLIBS) + DEPLIBS6 = $(DEPLIBS) + DEPLIBS7 = $(DEPLIBS) + DEPLIBS8 = $(DEPLIBS) + DEPLIBS9 = $(DEPLIBS) + DEPLIBS10 = $(DEPLIBS) + +XMULIBONLY = -lXmu +XMULIB = $(XMULIBONLY) $(XTOOLLIB) $(XLIB) + + CONFIGDIR = $(LIBDIR)/config + + USRLIBDIRPATH = $(USRLIBDIR) + LDPRELIBS = -L$(USRLIBDIR) $(INSTALLED_LIBS) + LDPOSTLIBS = + TOP_INCLUDES = -I$(INCROOT) $(TOP_X_INCLUDES) + PROJECT_DEFINES = + +CXXPROJECT_DEFINES = + +# ---------------------------------------------------------------------- +# start of Imakefile + +# Imakefile for the Image Support Module components. + +X11IRAFDIR = ../../ + +# $Xorg: Library.tmpl,v 1.3 2000/08/17 19:41:46 cpqbld Exp $ + +# $XFree86: xc/config/cf/Library.tmpl,v 3.20 2002/11/25 14:04:47 eich Exp $ + + CC = gcc -m32 + + CCOPTIONS = +STD_DEFINES = -Dlinux -D__i386__ -D_POSIX_C_SOURCE=199309L -D_POSIX_SOURCE -D_XOPEN_SOURCE -D_BSD_SOURCE -D_SVID_SOURCE $(PROJECT_DEFINES) +CDEBUGFLAGS = -O2 -pipe -march=i386 -mcpu=i686 -fno-strict-aliasing -pipe +CLIBDEBUGFLAGS = + CFLAGS = $(CDEBUGFLAGS) $(CLIBDEBUGFLAGS) $(CCOPTIONS) $(THREADS_CFLAGS) $(ALLDEFINES) + +LIB_MT_DEFINES = LibraryMTDefines + +SOSYMLINK = true + + X11IRAFBINDIR = $(X11IRAFDIR)/bin + X11IRAFMANDIR = $(X11IRAFDIR)/man + X11IRAFLIBDIR = $(X11IRAFDIR)/lib + X11IRAFINCDIR = $(X11IRAFDIR)/include + + XGTERMDIR = $(X11IRAFDIR)/xgterm + XIMTOOLDIR = $(X11IRAFDIR)/ximtool + XTAPEMONDIR = $(X11IRAFDIR)/xtapemon + OBMSHDIR = $(X11IRAFDIR)/obmsh + OBMDIR = $(X11IRAFDIR)/obm + XPMDIR = $(X11IRAFDIR)/xpm + XAW3DDIR = $(X11IRAFDIR)/xaw3d + CDLDIR = $(X11IRAFDIR)/cdl + + DEPLIBOBM = $(OBMDIR)/libobm.a + LIBOBM = -lobm + DEPLIBXPM = $(XPMDIR)/libXpm.a + LIBXPM = -lXpm + DEPLIBXAW3D = $(XAW3DDIR)/libXaw3d.a + LIBXAW3D = -lXaw3d + LIBCDL = -lcdl + + X11IRAF_LDFLAGS = -L$(X11IRAFDIR)/lib -L../lib + X11IRAF_INCLUDES = -I$(X11IRAFDIR)/include -I../include + + CP = cp -p + + WC_SRCS = wcspix/t_wcspix.x wcspix/wcimage.x wcspix/wcmef.x wcspix/wcmspec.x wcspix/wcspix.h + + LIB_SRCS = lib/dspmmap.x lib/ism.x lib/idxstr.x lib/wcsgfterm.x + +all:: ism_wcspix.e + +ism_wcspix.e: $(WC_SRCS) $(LIB_SRCS) + @(SHELL=/bin/sh ; export SHELL ; mkpkg relink) + touch DONE + +all:: DONE + +DONE: $(WC_SRCS) $(LIB_SRCS) + $(RM) $@ + touch $@ + +cleandir:: + $(RM) DONE + +cleandir:: + @(rmbin -v .) + touch DONE + +includes:: + +install:: ism_wcspix.e + -@if [ -d $(X11IRAFDIR)/bin ]; then set +x; else (set -x; $(MKDIRHIER) $(X11IRAFDIR)/bin); fi + + mv ism_wcspix.e $(X11IRAFDIR)/bin + +depend:: + $(DEPEND) $(DEPENDFLAGS) -- $(ALLDEFINES) $(DEPEND_DEFINES) -- $(SRCS) + +# ---------------------------------------------------------------------- +# common rules for all Makefiles - do not edit + +.c.i: + $(RM) $@ + $(CC) -E $(CFLAGS) $(_NOOP_) $*.c > $@ + +.SUFFIXES: .s + +.c.s: + $(RM) $@ + $(CC) -S $(CFLAGS) $(_NOOP_) $*.c + +emptyrule:: + +cleandir:: + $(RM) *.CKP *.ln *.BAK *.bak *.o core errs ,* *~ *.a .emacs_* tags TAGS make.log MakeOut "#"* + +Makefile:: + -@if [ -f Makefile ]; then set -x; \ + $(RM) Makefile.bak; $(MV) Makefile Makefile.bak; \ + else exit 0; fi + $(IMAKE_CMD) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT_DIR) + +tags:: + $(TAGS) -w *.[ch] + $(TAGS) -xw *.[ch] > TAGS + +man_keywords:: + +html_index:: + +clean:: cleandir + +distclean:: cleandir + +# ---------------------------------------------------------------------- +# empty rules for directories that do not have SUBDIRS - do not edit + +install:: + @echo "install in $(CURRENT_DIR) done" + +install.man:: + @echo "install.man in $(CURRENT_DIR) done" + +install.sdk:: + @echo "install.sdk in $(CURRENT_DIR) done" + +Makefiles:: + +includes:: + +depend:: + +distclean:: + $(RM) Makefile Makefile.dep + +# ---------------------------------------------------------------------- +# dependencies generated by makedepend + diff --git a/vendor/x11iraf/ximtool/clients/README b/vendor/x11iraf/ximtool/clients/README new file mode 100644 index 00000000..c668daaa --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/README @@ -0,0 +1,3 @@ +# +# CLIENTS -- This directory contains the code for the ISM client tasks. +# diff --git a/vendor/x11iraf/ximtool/clients/doc/Notes b/vendor/x11iraf/ximtool/clients/doc/Notes new file mode 100644 index 00000000..da021306 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/doc/Notes @@ -0,0 +1,199 @@ + + +define MAX_WCSLINES 4 + +define SZ_WPIX 6 +define WP_CPTR Memi[$1 ] # cache pointer +define WP_PTABSZ Memi[$1+1] # pixel table size +define WP_SYSTEMS Memi[$1+2] # WCS readout systems +define WP_FORMATS Memi[$1+3] # WCS readout formats + +define SYSTEMS Memi[WP_SYSTEMS($1)+$2-1] # WCS systems per line +define FORMATS Memi[WP_FORMATS($1)+$2-1] # WCS formats per line +define OBJCACHE Memi[WP_CPTR($1)+$2] # object cache + +# Element of an object cache. +define SZ_CNODE 135 # size of a cache node +define SZ_OBJREF 128 # size of a object reference + +define C_OBJID Memi[$1] # object id +define C_REGID Memi[$1+1] # region id +define C_CLASS Memi[$1+2] # object class +define C_DATA Memi[$1+3] # object data ptr +define C_REF Memc[P2C($1+4)] # object reference file + +# Object class definitions. +define IMAGE_CLASS 1 # generic image class +define MEF_CLASS 2 # Mosaic MEF image class +define MULTISPEC_CLASS 3 # multispec data class + +# Class methods. +define LEN_CL 6 # length of class table +define MAX_CL 6 # max supported classes +define SZ_CLNAME 16 # size of a class name + +define CL_INIT cl_table[1,$1] # class initializer +define CL_CACHE cl_table[2,$1] # cache the object +define CL_UNCACHE cl_table[3,$1] # uncache the object +define CL_WCSTRAN cl_table[4,$1] # WCS tranformations +define CL_WCSLIST cl_table[5,$1] # list available WCS +define CL_GETDATA cl_table[6,$1] # get object data +define CL_NAME cl_names[1,$1] # class name + +# Class common. +int cl_nclasses # number of defined functions +int cl_table[LEN_CL,MAX_CL] # class table +char cl_names[SZ_CLNAME,MAX_CL] # class names +common /class_com/ cl_nclasses, cl_table, cl_names + + +# Image class data. +define O_IM Memi[$1+2] # image pointer +define O_MW Memi[$1+3] # image wcs pointer +define O_CO Memi[$1+3] # skywcs transform pointer +define O_CT Memi[$1+4] # mwcs transform pointer +define O_ROT Memr[$1+5] # rotation angle +define O_SCALE Memr[$1+6] # plate scale + + + +-------------------------------------------------------------------------------- +ISM Methods: +-------------------------------------------------------------------------------- + + initialize + cache <objid> <ref> + uncache <objid> + wcstran <objid> <x> <y> [[<region-name> <x> <y>] ["NDC" <x> <y>]] + wcslist <objid> + getheader <objid> <template-list> + + +procedure initialize +begin + for (each object in the cache) + uncache object + send startup req to GUI +end + +procedure cache +begin +end + +procedure uncache +begin +end + +procedure wcstran +begin +end + +procedure wcslist +begin +end + +procedure getheader +begin +end + + +-------------------------------------------------------------------------------- +GUI Callbacks +-------------------------------------------------------------------------------- + +proc ism_msg { param old new } { + + set target [lindex $new 0] ;# name of ism module + + switch [lindex $new 0] { + source { source [lindex $new 1] } ;# source Tcl code + alert { Wexec client [lindex $new 1] } ;# alert from ism client + + deliver { set ism [lindex $new 0] ;# determine ISM name + set argv [lrange $new 1 end] ;# get args + set argc [llength $argv] + ${ism}_msg $argc $argv ;# call module + } + } +} ; send ism_msg addCallback ism_msg + + +proc wpix_msg { argc argv } { + + switch [lindex $argv 0] { + startup { wpix_startup } + shutdown { wpix_shutdown } + cache { .... save image name to GUI cache list + } + uncache { .... remove image name from GUI cache list + } + wcstran { .... parse argv for WCS field and update display + } + pixtab { + } + wcslist { + } + wcstype { set type [lindex $argv 1] ;# Set WCS for a line + set line [lindex $argv 2] + send sysWcs$line set label $type + if {$type == "None"} { + send wpWcs$line set on False + } else { + send wpWcs$line set on True + } + setCoordPanelHeight + } + wcsfmt { set fmt [lindex $argv 1] ;# Set fmt for a line + set line [lindex $argv 2] + send fmtWcs$line set label $fmt + } + header { set type [lindex $argv 1] ;# write header text + set text [lindex $argv 2] + switch $type { + imghdr {send hdrText append $text} + wcshdr {send hdrKGText append $text} + wcsinfo {send hdrIGText append $text} + } + } + } ;# end switch +} + +proc wpix_startup args { + global ismEnabled frameCache + + set ismEnabled 1 ;# initialize buttons + send ismToggle set on True + send imageHeader setSensitive True + setCoordPanelSensitivity + + resizeCoordsBox $up_todo ;# resize wcsbox marker + updateCoordsBox + + foreach c [array names frameCache] { ;# initialize local frame cache + if {$c != "0"} { unset frameCache($c) } + } + + catch { ;# update ISM with GUI settings + send wpix set psize $psize + set wcsfmt [string tolower [send wcsFmtMenu get label]] + send wpix set wcsfmt $wcsfmt + if {[send wcsSysAltWCS get on]} { + setAltSystem + } + } +} + +proc wpix_shutdown args { + global ismEnabled + + set ismEnabled 0 + send ismToggle set on False + send imageHeader setSensitive False + setCoordPanelSensitivity + wcsFmtIValue "" + wcsFmtImWCS "" "" "" + wcsFmtAltWCS "" "" "" + resizeCoordsBox 0 +} + + diff --git a/vendor/x11iraf/ximtool/clients/doc/README b/vendor/x11iraf/ximtool/clients/doc/README new file mode 100644 index 00000000..142c9652 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/doc/README @@ -0,0 +1,3 @@ +# +# This directory contains documentation on the ISM client tasks. +# diff --git a/vendor/x11iraf/ximtool/clients/lib/README b/vendor/x11iraf/ximtool/clients/lib/README new file mode 100644 index 00000000..f91f44ce --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/README @@ -0,0 +1,11 @@ +# +# ISM LIBRARY UTILITIES -- This directory contains various utility +# procedures which may be used by one or more ISM client tasks. +o + + dsppmmap.x -- Opens a pixel mask associated with an image BPM keyword + idxstr.x -- Inverse strdic() function + ism.x -- Low-level ISM communications routines + wcsgterm.x -- Compute the output FITS CRPIX, CRVAL, and CD arrays from + the # MWCS LTERM and WTERM + diff --git a/vendor/x11iraf/ximtool/clients/lib/dspmmap.x b/vendor/x11iraf/ximtool/clients/lib/dspmmap.x new file mode 100644 index 00000000..621f0372 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/dspmmap.x @@ -0,0 +1,244 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <syserr.h> + + +# DS_PMMAP -- Open a pixel mask READ_ONLY. +# +# Open the pixel mask. If a regular image is specified convert it to +# a pixel mask. Match the mask to the reference image based on the +# physical coordinates. A null filename is allowed and returns NULL. + +pointer procedure ds_pmmap (pmname, refim) + +char pmname[ARB] #I Pixel mask name +pointer refim #I Reference image pointer + +pointer im +char fname[SZ_FNAME] +int nowhite(), errcode() +bool streq() +pointer im_pmmap(), ds_pmimmap() +errchk ds_pmimmap, ds_match + +begin + if (nowhite (pmname, fname, SZ_FNAME) == 0) + return (NULL) + if (streq (fname, "EMPTY")) + return (NULL) + if (fname[1] == '!') { + iferr (call imgstr (refim, fname[2], fname, SZ_FNAME)) + fname[1] = EOS + } else if (streq (fname, "BPM")) { + iferr (call imgstr (refim, "BPM", fname, SZ_FNAME)) + return (NULL) + } + + iferr (im = im_pmmap (fname, READ_ONLY, NULL)) { + switch (errcode()) { + case SYS_FOPNNEXFIL, SYS_PLBADSAVEF: + im = ds_pmimmap (fname, refim) + default: + call erract (EA_ERROR) + } + } + + iferr (call ds_match (im, refim)) + call erract (EA_WARN) + + return (im) +end + + +# DS_PMIMMAP -- Open a pixel mask from a non-pixel list image. +# Return error if the image cannot be opened. + +pointer procedure ds_pmimmap (pmname, refim) + +char pmname[ARB] #I Image name +pointer refim #I Reference image pointer + +int i, ndim, npix, val +pointer sp, v1, v2, im_in, im_out, pm, mw, data + +int imgnli() +pointer immap(), pm_newmask(), im_pmmapo(), imgl1i(), mw_openim() +errchk immap, mw_openim + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + + im_in = immap (pmname, READ_ONLY, 0) + pm = pm_newmask (im_in, 27) + + ndim = IM_NDIM(im_in) + npix = IM_LEN(im_in,1) + + while (imgnli (im_in, data, Meml[v1]) != EOF) { + do i = 0, npix-1 { + val = Memi[data+i] + if (val < 0) + Memi[data+i] = 0 + } + call pmplpi (pm, Meml[v2], Memi[data], 0, npix, PIX_SRC) + call amovl (Meml[v1], Meml[v2], ndim) + } + + im_out = im_pmmapo (pm, im_in) + data = imgl1i (im_out) # Force I/O to set header + mw = mw_openim (im_in) # Set WCS + call mw_saveim (mw, im_out) + call mw_close (mw) + + call imunmap (im_in) + call sfree (sp) + return (im_out) +end + + +# DS_MATCH -- Set the pixel mask to match the reference image. +# This matches sizes and physical coordinates and allows the +# original mask to be smaller or larger than the reference image. +# Subsequent use of the pixel mask can then work in the logical +# coordinates of the reference image. The mask values are the maximum +# of the mask values which overlap each reference image pixel. +# A null input returns a null output. + +procedure ds_match (im, refim) + +pointer im #U Pixel mask image pointer +pointer refim #I Reference image pointer + +int i, j, k, l, i1, i2, j1, j2, nc, nl, ncpm, nlpm, nx, val +double x1, x2, y1, y2, lt[6], lt1[6], lt2[6] +long vold[IM_MAXDIM], vnew[IM_MAXDIM] +pointer pm, pmnew, imnew, mw, ctx, cty, bufref, bufpm + +int imstati() +pointer pm_open(), mw_openim(), im_pmmapo(), imgl1i(), mw_sctran() +bool pm_empty(), pm_linenotempty() +errchk pm_open, mw_openim + +begin + if (im == NULL) + return + + # Set sizes. + nc = IM_LEN(refim,1) + nl = IM_LEN(refim,2) + ncpm = IM_LEN(im,1) + nlpm = IM_LEN(im,2) + + # If the mask is empty and the sizes are the same then it does not + # matter if the two are actually matched in physical coordinates. + pm = imstati (im, IM_PMDES) + if (pm_empty(pm) && nc == ncpm && nl == nlpm) + return + + # Compute transformation between reference (logical) coordinates + # and mask (physical) coordinates. + + mw = mw_openim (im) + call mw_gltermd (mw, lt, lt[5], 2) + call mw_close (mw) + + mw = mw_openim (refim) + call mw_gltermd (mw, lt2, lt2[5], 2) + call mw_close (mw) + + # Combine lterms. + call mw_invertd (lt, lt1, 2) + call mw_mmuld (lt1, lt2, lt, 2) + call mw_vmuld (lt, lt[5], lt[5], 2) + lt[5] = lt2[5] - lt[5] + lt[6] = lt2[6] - lt[6] + do i = 1, 6 + lt[i] = nint (1D6 * (lt[i]-int(lt[i]))) / 1D6 + int(lt[i]) + + # Check for a rotation. For now don't allow any rotation. + if (lt[2] != 0. || lt[3] != 0.) + call error (1, "Image and mask have a relative rotation") + + # Check for an exact match. + if (lt[1] == 1D0 && lt[4] == 1D0 && lt[5] == 0D0 && lt[6] == 0D0) + return + + # Set reference to mask coordinates. + mw = mw_openim (im) + call mw_sltermd (mw, lt, lt[5], 2) + ctx = mw_sctran (mw, "logical", "physical", 1) + cty = mw_sctran (mw, "logical", "physical", 2) + + # Create a new pixel mask of the required size and offset. + # Do dummy image I/O to set the header. + pmnew = pm_open (NULL) + call pm_ssize (pmnew, 2, IM_LEN(refim,1), 27) + imnew = im_pmmapo (pmnew, NULL) + bufref = imgl1i (imnew) + + # Compute region of mask overlapping the reference image. + call mw_ctrand (ctx, 1-0.5D0, x1, 1) + call mw_ctrand (ctx, nc+0.5D0, x2, 1) + i1 = max (1, nint(min(x1,x2)+1D-5)) + i2 = min (ncpm, nint(max(x1,x2)-1D-5)) + call mw_ctrand (cty, 1-0.5D0, y1, 1) + call mw_ctrand (cty, nl+0.5D0, y2, 1) + j1 = max (1, nint(min(y1,y2)+1D-5)) + j2 = min (nlpm, nint(max(y1,y2)-1D-5)) + + # Set the new mask values to the maximum of all mask values falling + # within each reference pixel in the overlap region. + if (i1 <= i2 && j1 <= j2) { + nx = i2 - i1 + 1 + call malloc (bufpm, nx, TY_INT) + call malloc (bufref, nc, TY_INT) + vold[1] = i1 + vnew[1] = 1 + do j = 1, nl { + call mw_ctrand (cty, j-0.5D0, y1, 1) + call mw_ctrand (cty, j+0.5D0, y2, 1) + j1 = max (1, nint(min(y1,y2)+1D-5)) + j2 = min (nlpm, nint(max(y1,y2)-1D-5)) + if (j2 < j1) + next + + vnew[2] = j + call aclri (Memi[bufref], nc) + do l = j1, j2 { + vold[2] = l + if (!pm_linenotempty (pm, vold)) + next + call pmglpi (pm, vold, Memi[bufpm], 0, nx, 0) + do i = 1, nc { + call mw_ctrand (ctx, i-0.5D0, x1, 1) + call mw_ctrand (ctx, i+0.5D0, x2, 1) + i1 = max (1, nint(min(x1,x2)+1D-5)) + i2 = min (ncpm, nint(max(x1,x2)-1D-5)) + if (i2 < i1) + next + val = Memi[bufref+i-1] + do k = i1-vold[1], i2-vold[1] + val = max (val, Memi[bufpm+k]) + Memi[bufref+i-1] = val + } + } + call pmplpi (pmnew, vnew, Memi[bufref], 0, nc, PIX_SRC) + } + call mfree (bufref, TY_INT) + call mfree (bufpm, TY_INT) + } + + call mw_close (mw) + call imunmap (im) + im = imnew + call imseti (im, IM_PMDES, pmnew) +end diff --git a/vendor/x11iraf/ximtool/clients/lib/idxstr.x b/vendor/x11iraf/ximtool/clients/lib/idxstr.x new file mode 100644 index 00000000..7b055658 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/idxstr.x @@ -0,0 +1,54 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + + +# IDXSTR -- Search a dictionary string for a given string index number. +# This is the opposite function of strdic(), that returns the index for +# given string. The entries in the dictionary string are separated by +# a delimiter character which is the first character of the dictionary +# string. The index of the string found is returned as the function value. +# Otherwise, if there is no string for that index, a zero is returned. + +int procedure idxstr (index, outstr, maxch, dict) + +int index #i String index +char outstr[ARB] #o Output string as found in dictionary +int maxch #i Maximum length of output string +char dict[ARB] #i Dictionary string + +int i, len, start, count + +int strlen() + +begin + # Clear the output string. + outstr[1] = EOS + + # Return if the dictionary is not long enough. + if (dict[1] == EOS) + return (0) + + # Initialize the counters. + count = 1 + len = strlen (dict) + + # Search the dictionary string. This loop only terminates + # successfully if the index is found. Otherwise the procedure + # returns with and error condition. + for (start = 2; count < index; start = start + 1) { + if (dict[start] == dict[1]) + count = count + 1 + if (start == len) + return (0) + } + + # Extract the output string from the dictionary. + for (i = start; dict[i] != EOS && dict[i] != dict[1]; i = i + 1) { + if (i - start + 1 > maxch) + break + outstr[i - start + 1] = dict[i] + } + outstr[i - start + 1] = EOS + + # Return index for output string. + return (count) +end diff --git a/vendor/x11iraf/ximtool/clients/lib/ism.x b/vendor/x11iraf/ximtool/clients/lib/ism.x new file mode 100644 index 00000000..1d7310cc --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/ism.x @@ -0,0 +1,432 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <config.h> +include <mach.h> +include <xwhen.h> + + +# ISM.X -- Interface routines for client programs to connect to the +# XImtool ISM port on the local socket +# +# status = ism_connect (device, name, mode) +# ism_disconnect (send_quit) +# ism_message (object, message) +# ism_alert (text, ok_action, cancel_action) +# +# ism_write (message, len) +# nread = ism_read (message, len) +# +# Client programs should install an exception handler to first disconnect +# from the device before shutting down. The procedure ism_zxwhen() is +# provided for this purpose. + + +define ISM_DBG FALSE + +define SZ_MESSAGE 2047 + +define ISM_TEXT 1 +define ISM_BINARY 2 + + +# ISM_CONNECT -- Negotiate a connection on the named device. Once +# established we can begin sending and reading messages from the server. + +int procedure ism_connect (device, name, type) + +char device[ARB] #I socket to connect on +char name[ARB] #I module name +char type[ARB] #I requested connection mode + +pointer sp, cmsg, dev, buf +int msglen +char connect[SZ_FNAME] + +int ndopen(), reopen(), strlen() +int ism_read() +bool streq() + +extern ism_onerror() + +include "ismfd.com" # I/O common +include "ismcom.com" # Interrupt handler variables + +# Exception handler variables common. +int ism_errstat +data ism_errstat /OK/ +common /ismecom/ ism_errstat + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call salloc (cmsg, SZ_LINE, TY_CHAR) + call salloc (dev, SZ_FNAME, TY_CHAR) + + # Initialize. + call aclrc (Memc[buf], SZ_LINE) + call aclrc (Memc[cmsg], SZ_LINE) + call aclrc (Memc[dev], SZ_FNAME) + call aclrc (buffer, 2*SZ_MESSAGE+1) + fdin = NULL + fdout = NULL + nbuf = 0 + bp = 0 + ep = 0 + + # Generate the device name. We assume the call was made with either + # a "unix:" or "inet:" prefix, so just append the type and set the + # mode. + + call sprintf (Memc[dev], SZ_FNAME, "%s:%s") + call pargstr (device) + call pargstr (type) + if (streq (type, "text")) + mode = ISM_TEXT + else + mode = ISM_BINARY + + # Open the initial connection + iferr (fdin = ndopen (Memc[dev], READ_WRITE)) { + call sfree (sp) + return (ERR) + } + fdout = reopen (fdin, READ_WRITE) + + # Send the connect request. + call sprintf (Memc[cmsg], SZ_LINE, "connect %s\0") + call pargstr (name) + msglen = strlen (Memc[cmsg]) + call ism_message ("ximtool", Memc[cmsg]) + + # Read the acknowledgement. + if (ism_read (Memc[buf], msglen) == EOF) { + call sfree (sp) + return (ERR) + } + + # Close the original socket. + call close (fdout) + call close (fdin) + + # Get the new device name. + call sprintf (connect, SZ_LINE, "unix:%s:%s\0") + call pargstr (Memc[buf+8]) + call pargstr (type) + + # Open the new channel. + iferr (fdin = ndopen (connect, READ_WRITE)) { + call sfree (sp) + return (ERR) + } + fdout = reopen (fdin, READ_WRITE) + + if (ISM_DBG) { + call eprintf ("Reconnected on '%s'\n"); call pargstr (connect) + } + + # Tell the server we're ready to begin. + call sprintf (Memc[cmsg], SZ_LINE, "ready %s\0") + call pargstr (name) + msglen = strlen (Memc[cmsg]) + call ism_message ("ximtool", Memc[cmsg]) + + + # Post the ism_onerror procedure to be executed upon process shutdown + # to issue a warning to the server in case we don't close normally. + + call onerror (ism_onerror) + + call sfree (sp) + return (OK) +end + + +# ISM_DISCONNECT -- Disconnect from the currect channel. + +procedure ism_disconnect (send_quit) + +int send_quit + +include "ismfd.com" # I/O common + +begin + # Send a QUIT message to the server so we shut down the connection. + if (send_quit == YES) + call ism_message ("ximtool", "quit") + + call close (fdin) # Close the socket connection. + call close (fdout) + fdin = NULL + fdout = NULL +end + + +# ISM_MESSAGE -- Send a message to an XImtool named object. If the object +# is 'ximtool' then just pass the message directly without formatting it. + +procedure ism_message (object, message) + +char object[ARB] #I object name +char message[ARB] #I message to send + +pointer sp, msgbuf +int msglen, olen, mlen, ip + +int strlen() +bool streq() + +begin + # Get the message length plus some extra for the braces and padding. + olen = strlen (object) + mlen = strlen (message) + msglen = olen + mlen + 20 + + # Allocate and clear the message buffer. + call smark (sp) + call salloc (msgbuf, msglen, TY_CHAR) + call aclrc (Memc[msgbuf], msglen) + + if (streq (object, "ximtool")) { + # Just send the message. + call strcpy (message, Memc[msgbuf], msglen) + } else { + # Format the message. We can't use a sprintf here since the + # message may be bigger than that allowed by a pargstr(). + ip = 0 + call amovc ("send ", Memc[msgbuf+ip], 5) ; ip = ip + 5 + call amovc (object, Memc[msgbuf+ip], olen) ; ip = ip + olen + call amovc (" { ", Memc[msgbuf+ip], 3) ; ip = ip + 3 + call amovc (message, Memc[msgbuf+ip], mlen) ; ip = ip + mlen + call amovc (" }\0", Memc[msgbuf+ip], 2) ; ip = ip + 3 + } + msglen = strlen (Memc[msgbuf]) + + # Now send the message. The write routine does the strpak(). + call ism_write (Memc[msgbuf], msglen) + + call sfree (sp) +end + + +# ISM_ALERT -- Send an alert message to XImtool. + +procedure ism_alert (text, ok, cancel) + +char text[ARB] #I warning text +char ok[ARB] #i client OK message +char cancel[ARB] #i client CANCEL message + +pointer sp, msg + +begin + call smark (sp) + call salloc (msg, SZ_LINE, TY_CHAR) + + call sprintf (Memc[msg], SZ_LINE, "{%s} {%s} {%s}") + call pargstr (text) + call pargstr (ok) + call pargstr (cancel) + + call ism_message ("alert", Memc[msg]) + + call sfree (sp) +end + + +# ISM_WRITE -- Low-level write of a message to the socket. Writes exactly +# len bytes to the stream. + +procedure ism_write (message, len) + +char message[ARB] #I message to send +int len #I length of message + +int nleft, n, ip +char msgbuf[SZ_MESSAGE] +int strlen() + +include "ismfd.com" # I/O common + +errchk write, flush + +begin + # Pad message with a NULL to terminate it. + len = strlen (message) + 1 + message[len] = '\0' + + if (mod(len,2) == 1) { + len = len + 1 + message[len] = '\0' + } + + ip = 1 + nleft = len + while (nleft > 0) { + n = min (nleft, SZ_MESSAGE) + call amovc (message[ip], msgbuf, n) + if (mode == ISM_BINARY) { + call achtcb (msgbuf, msgbuf, n) + call write (fdout, msgbuf, n / SZB_CHAR) + } else + call write (fdout, msgbuf, n) + + ip = ip + n + nleft = nleft - n + } + call flush (fdout) + + if (ISM_DBG) { + call eprintf ("ism_write: '%.45s' len=%d mode=%d\n") + call pargstr (message);call pargi (len); call pargi (mode) + } +end + + +# ISM_READ -- Low-level read from the socket. + +int procedure ism_read (message, len) + +char message[ARB] #O message read +int len #O length of message + +int i, n, nleft, read() + +include "ismfd.com" # I/O common +include "ismcom.com" # Interrupt handler variables + +errchk read + +begin + # No data left in the buffer so read from the socket + if (nbuf == 0) { + call aclrc (buffer, SZ_MESSAGE) + #call amovkc (EOF, buffer, SZ_MESSAGE) + nbuf = 0 + + iferr { + n = read (fdin, message, SZ_MESSAGE) + if (n < 0) + return (EOF) + } then { + if (n < 0) + return (EOF) + call xer_reset() + call zdojmp (ism_jmp, X_IPC) + } + + if (mode == ISM_BINARY) { + len = n * SZB_CHAR + call achtbc (message, message, len) + } else + len = n + + # Save the data read to a local buffer. Remove any extra + # EOS padding and append an EOF on the string. + call amovc (message, buffer, len) + if (buffer[len] == EOS && buffer[len-1] == EOS) + nbuf = len + else + nbuf = len + 1 + buffer[nbuf] = EOF + } + + for (i=1; buffer[i] != EOS && buffer[i] != EOF && i <= nbuf; i=i+1) + message[i] = buffer[i] + message[i] = '\0' + len = i # length of the current message + nleft = nbuf - i # nchars left in the buffer + + if (buffer[i] == EOS && buffer[i+1] == EOF) { + # That was the last message, force a new read next time we're + # called. + if (i > 1 && nleft > 1) + call amovc (buffer[i+1], buffer, nleft) + nbuf = 0 + } else { + # More of the message is left in the buffer. + if (nleft > 0) + call amovc (buffer[i+1], buffer, nleft) + nbuf = nleft + } + + if (ISM_DBG) { + message[len] = '\0'; + call eprintf ("ism_read: len=%d msg='%s'\n") + call pargi (len); call pargstr(message) + call eprintf ("ism_read: nbuf=%d nleft=%d buffer='%s'\n") + call pargi (nbuf); call pargi(nleft); call pargstr(buffer) + } + + return (nleft) +end + + +# ISM_INTRHANDLER -- User-callable interrupt handler so the ISM client code +# doesn't need to know about our internals. + +int procedure ism_intrhandler() + +extern ism_zxwhen() + +include "ismcom.com" # Interrupt handler variables + +begin + call zlocpr (ism_zxwhen, ismepa) + call xwhen (X_INT, ismepa, old_onint) + call zsvjmp (ism_jmp, ismstat) + + if (ismstat == OK) + return (OK) + else + return (ERR) +end + + +# ISM_ZXWHEN -- Interrupt handler for the ISM client task. Branches back +# to ZSVJMP in the user routine to permit shutdown without an error message +# after first disconnecting from the socket. + +procedure ism_zxwhen (vex, next_handler) + +int vex # virtual exception +int next_handler # not used + +include "ismcom.com" # Interrupt handler variables + +begin + call ism_disconnect (YES) + call xer_reset() + call zdojmp (ism_jmp, vex) +end + + +# ISM_ONERROR -- Error exit handler for the interface. If this is a normal exit +# the shut down quietly, otherwise notify the server. + +procedure ism_onerror (status) + +int status #i not used (req. for ONEXIT) + +# Exception handler variables common. +int ism_errstat +common /ismecom/ ism_errstat + +int code +char buf[SZ_LINE], errmsg[SZ_LINE] + +int errget() + +include "ismcom.com" # Interrupt handler variables + +begin + if (status != OK) { + code = errget (errmsg, SZ_LINE) + call sprintf (buf, SZ_LINE, "ISM Error, code %d:\n`%s\'") + call pargi (status) + call pargstr (errmsg) + + call ism_alert (buf, "", "") + call ism_disconnect (YES) + } +end diff --git a/vendor/x11iraf/ximtool/clients/lib/ismcom.com b/vendor/x11iraf/ximtool/clients/lib/ismcom.com new file mode 100644 index 00000000..fd2c2939 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/ismcom.com @@ -0,0 +1,4 @@ +# ISM interrupt handler variables common. +int ismepa, ismstat, old_onint, ism_fd, ism_jmp[LEN_JUMPBUF] +common /ismcom/ ism_fd, ism_jmp, ismepa, ismstat, old_onint + diff --git a/vendor/x11iraf/ximtool/clients/lib/ismfd.com b/vendor/x11iraf/ximtool/clients/lib/ismfd.com new file mode 100644 index 00000000..ebb94d9a --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/ismfd.com @@ -0,0 +1,11 @@ +# ISM I/O common. +int fdin # input descriptor +int fdout # output descriptor +int mode # file mode +int nbuf # no. chars in buffer +int bp # begin buffer ptr +int ep # end buffer ptr +char buffer[2*SZ_MESSAGE+1] # text buffer + +common /ismfd/ fdin, fdout, mode, nbuf, buffer, bp, ep + diff --git a/vendor/x11iraf/ximtool/clients/lib/mkpkg b/vendor/x11iraf/ximtool/clients/lib/mkpkg new file mode 100644 index 00000000..896134d4 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/mkpkg @@ -0,0 +1,15 @@ +# Make the ISM Client utility procedures. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: +# dspmmap.x <ctype.h> <error.h> <imhdr.h> <imset.h> \ +# <mach.h> <pmset.h> + idxstr.x + ism.x ismfd.com ismcom.com <config.h> <mach.h> <xwhen.h> + wcsgfterm.x + ; + diff --git a/vendor/x11iraf/ximtool/clients/lib/wcsgfterm.x b/vendor/x11iraf/ximtool/clients/lib/wcsgfterm.x new file mode 100644 index 00000000..ea026f89 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/wcsgfterm.x @@ -0,0 +1,61 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + + +# WCS_GFTERM -- Compute the output FITS CRPIX, CRVAL, and CD arrays from the +# MWCS LTERM and WTERM. Note that the CD matrix terms are still transposed +# from the usual Fortran order. + +procedure wcs_gfterm (mw, crpix, crval, cd, ndim) + +pointer mw #i the input mwcs pointer +double crpix[ndim] #o the output FITS CRPIX array +double crval[ndim] #o the output FITS CRVAL array +double cd[ndim,ndim] #o the output FITS CD matrix +int ndim #i the dimensionality of the wcs + +pointer sp, r, wcd, ltv, ltm, iltm +pointer alert, errmsg +int i, errcode + +int errget() + +errchk mw_gwtermd, mw_gltermd + +begin + call smark (sp) + call salloc (r, ndim, TY_DOUBLE) + call salloc (wcd, ndim * ndim, TY_DOUBLE) + call salloc (ltv, ndim, TY_DOUBLE) + call salloc (ltm, ndim * ndim, TY_DOUBLE) + call salloc (iltm, ndim * ndim, TY_DOUBLE) + + iferr { + call mw_gwtermd (mw, Memd[r], crval, Memd[wcd], ndim) + call mw_gltermd (mw, Memd[ltm], Memd[ltv], ndim) + call mwvmuld (Memd[ltm], Memd[r], crpix, ndim) + call aaddd (crpix, Memd[ltv], crpix, ndim) + call mwinvertd (Memd[ltm], Memd[iltm], ndim) + call mwmmuld (Memd[wcd], Memd[iltm], cd, ndim) + + } then { + call salloc (alert, SZ_LINE, TY_CHAR) + call salloc (errmsg, SZ_LINE, TY_CHAR) + + # Set up a default value. + call aclrd (cd, ndim*ndim) + for (i=1; i <= ndim; i=i+1) { + crpix[i] = 1.0d0 + crval[i] = 1.0d0 + cd[i,i] = 1.0d0 + } + + # Send alert to the GUI. + errcode = errget (Memc[errmsg], SZ_LINE) + call sprintf (Memc[alert], SZ_FNAME, "%s\n\"%s\"") + call pargstr ("Error decoding image WCS:") + call pargstr (Memc[errmsg]) + call ism_alert (Memc[alert], "", "") + } + + call sfree (sp) +end diff --git a/vendor/x11iraf/ximtool/clients/lib/ximtool.x b/vendor/x11iraf/ximtool/clients/lib/ximtool.x new file mode 100644 index 00000000..108b325e --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/lib/ximtool.x @@ -0,0 +1,531 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <config.h> +include <mach.h> +include <xwhen.h> + + +# XIMTOOL.X -- Interface routines for client programs to connect to +# XImtool on the message bus. +# +# status = xim_connect (device, name, mode) +# xim_disconnect (send_quit) +# xim_message (object, message) +# xim_alert (text, ok_action, cancel_action) +# +# xim_write (message, len) +# nread = xim_read (message, len) +# +# Client programs should install an exception handler to first disconnect +# from the device before shutting down. The procedure xim_zxwhen() is +# provided for this purpose. + + +define XIM_DBG FALSE + +define SZ_MESSAGE 2047 + +define XIM_TEXT 1 +define XIM_BINARY 2 + + +# XIM_CONNECT -- Negotiate a connection on the named device. Once +# established we can begin sending and reading messages from the server. + +int procedure xim_connect (device, name, type) + +char device[ARB] #I socket to connect on +char name[ARB] #I module name +char type[ARB] #I requested connection mode + +pointer sp, cmsg, dev, buf +int msglen +char connect[SZ_FNAME] + +int ndopen(), reopen(), strlen() +int xim_read() +bool streq() + +extern xim_onerror() + +# I/O common. +int fdin, fdout, mode, nbuf, nsave, nr, nw +char buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE] +common /ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw + +# Interrupt handler variables common. +int ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF] +common /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint + +# Exception handler variables common. +int xim_errstat +data xim_errstat /OK/ +common /ximecom/ xim_errstat + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call salloc (cmsg, SZ_LINE, TY_CHAR) + call salloc (dev, SZ_FNAME, TY_CHAR) + + # Initialize. + call aclrc (Memc[buf], SZ_LINE) + call aclrc (Memc[cmsg], SZ_LINE) + call aclrc (Memc[dev], SZ_FNAME) + call aclrc (buffer, SZ_MESSAGE) + fdin = NULL + fdout = NULL + nbuf = 0 + nsave = 0 + nr = 0 + nw = 0 + + # Generate the device name. We assume the call was made with either + # a "unix:" or "inet:" prefix, so just append the type and set the + # mode. + + call sprintf (Memc[dev], SZ_FNAME, "%s:%s") + call pargstr (device) + call pargstr (type) + if (streq (type, "text")) + mode = XIM_TEXT + else + mode = XIM_BINARY + + # Open the initial connection + iferr (fdin = ndopen (Memc[dev], READ_WRITE)) { + call sfree (sp) + return (ERR) + } + fdout = reopen (fdin, READ_WRITE) + + # Send the connect request. + call sprintf (Memc[cmsg], SZ_LINE, "connect %s\0") + call pargstr (name) + msglen = strlen (Memc[cmsg]) + call xim_message ("ximtool", Memc[cmsg]) + + # Read the acknowledgement. + if (xim_read (Memc[buf], msglen) == EOF) { + call sfree (sp) + return (ERR) + } + + # Close the original socket. + call close (fdout) + call close (fdin) + + # Get the new device name. + call sprintf (connect, SZ_LINE, "unix:%s:%s\0") + call pargstr (Memc[buf+8]) + call pargstr (type) + + # Open the new channel. + iferr (fdin = ndopen (connect, READ_WRITE)) { + call sfree (sp) + return (ERR) + } + fdout = reopen (fdin, READ_WRITE) + + if (XIM_DBG) { + call eprintf ("Reconnected on '%s'\n"); call pargstr (connect) + } + + # Tell the server we're ready to begin. + call sprintf (Memc[cmsg], SZ_LINE, "ready %s\0") + call pargstr (name) + msglen = strlen (Memc[cmsg]) + call xim_message ("ximtool", Memc[cmsg]) + + + # Post the xim_onerror procedure to be executed upon process shutdown + # to issue a warning to the server in case we don't close normally. + + call onerror (xim_onerror) + + call sfree (sp) + return (OK) +end + + +# XIM_DISCONNECT -- Disconnect from the currect channel. + +procedure xim_disconnect (send_quit) + +int send_quit + +# I/O common. +int fdin, fdout, mode, nbuf, nsave, nr, nw +char buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE] +common /ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw + +begin + # Send a QUIT message to the server so we shut down the connection. + if (send_quit == YES) + call xim_message ("ximtool", "quit") + + call flush (fdout) # Close the socket connection. + call close (fdin) + call close (fdout) + fdin = NULL + fdout = NULL +end + + +# XIM_MESSAGE -- Send a message to an XImtool named object. If the object +# is 'ximtool' then just pass the message directly without formatting it. + +procedure xim_message (object, message) + +char object[ARB] #I object name +char message[ARB] #I message to send + +pointer sp, msgbuf +int msglen, olen, mlen, ip + +int strlen() +bool streq() + +begin + # Get the message length plus some extra for the braces and padding. + olen = strlen (object) + mlen = strlen (message) + msglen = olen + mlen + 20 + + # Allocate and clear the message buffer. + call smark (sp) + call salloc (msgbuf, msglen, TY_CHAR) + call aclrc (Memc[msgbuf], msglen) + + if (streq (object, "ximtool")) { + # Just send the message. + call strcpy (message, Memc[msgbuf], msglen) + } else { + # Format the message. We can't use a sprintf here since the + # message may be bigger than that allowed by a pargstr(). + ip = 0 + call amovc ("send ", Memc[msgbuf+ip], 5) ; ip = ip + 5 + call amovc (object, Memc[msgbuf+ip], olen) ; ip = ip + olen + call amovc (" { ", Memc[msgbuf+ip], 3) ; ip = ip + 3 + call amovc (message, Memc[msgbuf+ip], mlen) ; ip = ip + mlen + call amovc (" }\0", Memc[msgbuf+ip], 2) ; ip = ip + 3 + } + msglen = strlen (Memc[msgbuf]) + + # Now send the message. The write routine does the strpak(). + call xim_write (Memc[msgbuf], msglen) + + call sfree (sp) +end + + +# XIM_ALERT -- Send an alert message to XImtool. + +procedure xim_alert (text, ok, cancel) + +char text[ARB] #I warning text +char ok[ARB] #i client OK message +char cancel[ARB] #i client CANCEL message + +pointer sp, msg + +begin + call smark (sp) + call salloc (msg, SZ_LINE, TY_CHAR) + + call sprintf (Memc[msg], SZ_LINE, "{%s} {%s} {%s}") + call pargstr (text) + call pargstr (ok) + call pargstr (cancel) + + call xim_message ("alert", Memc[msg]) + + call sfree (sp) +end + + +# XIM_WRITE -- Low-level write of a message to the socket. Writes exactly +# len bytes to the stream. + +procedure xim_write (message, len) + +char message[ARB] #I message to send +int len #I length of message + +int nleft, n, ip +char msgbuf[SZ_MESSAGE] +int strlen() + +# I/O common. +int fdin, fdout, mode, nbuf, nsave, nr, nw +char buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE] +common /ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw + +errchk write, flush + +begin + # Pad message with a NULL to terminate it. + len = strlen (message) + 1 + message[len] = '\0' + + if (mod(len,2) == 1) { + len = len + 1 + message[len] = '\0' + } + + ip = 1 + nleft = len + while (nleft > 0) { + n = min (nleft, SZ_MESSAGE) + call amovc (message[ip], msgbuf, n) + if (mode == XIM_BINARY) { + call achtcb (msgbuf, msgbuf, n) + call write (fdout, msgbuf, n / SZB_CHAR) + } else + call write (fdout, msgbuf, n) + + ip = ip + n + nleft = nleft - n + } + nw = nw + len + call flush (fdout) + + if (XIM_DBG) { + call eprintf ("xim_write: '%.45s' len=%d mode=%d tot=%d\n") + call pargstr (message);call pargi (len) + call pargi (mode); call pargi (nw) + } +end + + +# XIM_READ -- Low-level read from the socket. + +int procedure xim_read2 (message, len) + +char message[ARB] #O message read +int len #O length of message + +int i, n, nleft, read() + +# I/O common. +int fdin, fdout, mode, nbuf, nsave, nr, nw +char buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE] +common /ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw + +# Interrupt handler variables common. +int ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF] +common /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint + +errchk read + +begin + if (nbuf == 0) { + clear the message buffer + n = read (fdin, message, SZ_MESSAGE) + if (n < 0) + return (EOF) + + if (mode == XIM_BINARY) + msglen = N * SZ_CHAR + unpack binary data + } else + msglen = N + + if (message[msglen] != EOS) + # Incomplete message so save the partial to a local buffer. + for (i=msglen; message[i] != EOS && i > 0; i=i-1) { + ; + nsave = msglen - i + 1 + call strcpy (message[i+1], bufsave) # save partial + call aclrc (message[i+1], nsave) # clear partial + nbuf = i + } else { + # Complete message. + nbuf = msglen + nsave = 0 + call aclrc (bufsave, SZ_MESSAGE) + } + } + + # Pull out a null-terminated message from the buffer. + for (i=1; buffer[i] != EOS && buffer[i] != EOF && i <= nbuf; i=i+1) + message[i] = buffer[i] + message[i] = '\0' + len = i # length of the current message + nleft = nbuf - i # nchars left in the buffer + nr = nr + len + + if (buffer[i] == EOS && buffer[i+1] == EOF) { + # That was the last message, force a new read next time we're + # called. + if (i > 1 && nleft > 1) + call amovc (buffer[i+1], buffer, nleft) + nbuf = 0 + } else { + # More of the message is left in the buffer. + if (nleft > 0) + call amovc (buffer[i+1], buffer, nleft) + nbuf = nleft + } +end + + +# XIM_READ -- Low-level read from the socket. + +int procedure xim_read (message, len) + +char message[ARB] #O message read +int len #O length of message + +int i, n, nleft, read() + +# I/O common. +int fdin, fdout, mode, nbuf, nsave, nr, nw +char buffer[SZ_MESSAGE], bufsave[SZ_MESSAGE] +common /ximfd/ fdin, fdout, mode, nbuf, buffer, nsave, bufsave, nr, nw + +# Interrupt handler variables common. +int ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF] +common /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint + +errchk read + +begin + # No data left in the buffer so read from the socket + if (nbuf == 0) { + call aclrc (buffer, SZ_MESSAGE) + #call amovkc (EOF, buffer, SZ_MESSAGE) + nbuf = 0 + + iferr { + n = read (fdin, message, SZ_MESSAGE) + if (n < 0) + return (EOF) + } then { + call xer_reset() + call zdojmp (xim_jmp, X_IPC) + } + + if (mode == XIM_BINARY) { + len = n * SZB_CHAR + call achtbc (message, message, len) + } else + len = n + + # Save the data read to a local buffer. Remove any extra + # EOS padding and append an EOF on the string. + call amovc (message, buffer, len) + if (buffer[len] == EOS && buffer[len-1] == EOS) + nbuf = len + else + nbuf = len + 1 + buffer[nbuf] = EOF + } + + for (i=1; buffer[i] != EOS && buffer[i] != EOF && i <= nbuf; i=i+1) + message[i] = buffer[i] + message[i] = '\0' + len = i # length of the current message + nleft = nbuf - i # nchars left in the buffer + nr = nr + len + + if (buffer[i] == EOS && buffer[i+1] == EOF) { + # That was the last message, force a new read next time we're + # called. + if (i > 1 && nleft > 1) + call amovc (buffer[i+1], buffer, nleft) + nbuf = 0 + } else { + # More of the message is left in the buffer. + if (nleft > 0) + call amovc (buffer[i+1], buffer, nleft) + nbuf = nleft + } + + if (XIM_DBG) { + call eprintf ("xim_read: tot=%d len=%d msg='%s'\n") + call pargi(nr); call pargi (len); + call pargstr(message) + call eprintf ("xim_read: nbuf=%d nleft=%d buffer='%s'\n") + call pargi (nbuf); call pargi(nleft); call pargstr(buffer) + } + + return (len) +end + + +# XIM_INTRHANDLER -- User-callable interrupt handler so the ISM client code +# doesn't need to know about our internals. + +int procedure xim_intrhandler() + +extern xim_zxwhen() + +# Interrupt handler variables common. +int ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF] +common /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint + +begin + call zlocpr (xim_zxwhen, ximepa) + call xwhen (X_INT, ximepa, old_onint) + call zsvjmp (xim_jmp, ximstat) + + if (ximstat == OK) + return (OK) + else + return (ERR) +end + + +# XIM_ZXWHEN -- Interrupt handler for the Ximtool client task. Branches back +# to ZSVJMP in the user routine to permit shutdown without an error message +# after first disconnecting from the socket. + +procedure xim_zxwhen (vex, next_handler) + +int vex # virtual exception +int next_handler # not used + +# Interrupt handler variables common. +int ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF] +common /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint + +begin + call xim_disconnect (YES) + call xer_reset() + call zdojmp (xim_jmp, vex) +end + + +# XIM_ONERROR -- Error exit handler for the interface. If this is a normal exit +# the shut down quietly, otherwise notify the server. + +procedure xim_onerror (status) + +int status #i not used (req. for ONEXIT) + +# Exception handler variables common. +int xim_errstat +common /ximecom/ xim_errstat + +int code +char buf[SZ_LINE], errmsg[SZ_LINE] + +int errget() + +# Interrupt handler variables common. +int ximepa, ximstat, old_onint, xim_fd, xim_jmp[LEN_JUMPBUF] +common /ximcom/ xim_fd, xim_jmp, ximepa, ximstat, old_onint + +begin + if (status != OK) { + code = errget (errmsg, SZ_LINE) + call sprintf (buf, SZ_LINE, "ISM Error, code %d:\n`%s\'") + call pargi (status) + call pargstr (errmsg) + + call xim_alert (buf, NULL, NULL) + call xim_disconnect (YES) + } +end diff --git a/vendor/x11iraf/ximtool/clients/mkpkg b/vendor/x11iraf/ximtool/clients/mkpkg new file mode 100644 index 00000000..52fdef97 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/mkpkg @@ -0,0 +1,34 @@ +# Make the ISM Client tasks. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $set LIBS = "-lds -lxtools -liminterp -lslalib" + $update libpkg.a + $omake x_ism.x + $link -z x_ism.o libpkg.a -o ism_wcspix.e $(LIBS) + ; + +debug: + $set LIBS = "-lds -lxtools -lslalib" + $set XFLAGS = "$(XFLAGS) -xqF" + $update libpkg.a + $omake x_ism.x + $link -z -x x_ism.o libpkg.a -o ism_wcspix.e $(LIBS) + ; + +install: + $move ism_wcspix.e ../../bin/ism_wcspix.e + ; + + +libpkg.a: + @lib + @wcspix + ; diff --git a/vendor/x11iraf/ximtool/clients/wcspix/README b/vendor/x11iraf/ximtool/clients/wcspix/README new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/README diff --git a/vendor/x11iraf/ximtool/clients/wcspix/class.com b/vendor/x11iraf/ximtool/clients/wcspix/class.com new file mode 100644 index 00000000..c6116c11 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/class.com @@ -0,0 +1,6 @@ +# Class common. +int cl_nclass # number of defined functions +int cl_table[LEN_CLASS,MAX_CLASSES] # class table +char cl_names[SZ_CLNAME,MAX_CLASSES] # class names +common /class_com/ cl_nclass, cl_table, cl_names + diff --git a/vendor/x11iraf/ximtool/clients/wcspix/mkpkg b/vendor/x11iraf/ximtool/clients/wcspix/mkpkg new file mode 100644 index 00000000..80b80f48 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/mkpkg @@ -0,0 +1,16 @@ +# Make the WCSPIX ISM Client task. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + t_wcspix.x wcspix.h class.com <ctype.h> <time.h> + wcimage.x wcspix.h <ctype.h> <imhdr.h> <imio.h> <math.h> \ + <time.h> <mwset.h> <pkg/skywcs.h> wcspix.h + wcmef.x wcspix.h + wcmspec.x wcspix.h + wcunknown.x wcspix.h <ctype.h> + ; + diff --git a/vendor/x11iraf/ximtool/clients/wcspix/t_wcspix.x b/vendor/x11iraf/ximtool/clients/wcspix/t_wcspix.x new file mode 100644 index 00000000..b0170f5b --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/t_wcspix.x @@ -0,0 +1,792 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <time.h> +include "wcspix.h" + + +# T_WCSPIX -- Entry point for the WCSPIX Image Support Module for XImtool. +# The WCSPIX task is responsible for converting image coordinates and getting +# pixel values from images of various types. Results are returned to the +# GUI directly using ISM messaging. + +procedure t_wcspix () + +pointer wp +real x, y +int len, disconnect, ncmd, objid, regid +char socket[SZ_FNAME], cmd[SZ_FNAME], message[SZ_LINE], buf[SZ_DATE] +char ref[SZ_FNAME], template[SZ_LINE], param[SZ_FNAME] +bool debug + +long clktime() +pointer wp_init() +int envgets(), envgeti(), strdic() + +# Standard declarations for the Ximtool WCSPIX client interface. +int ism_connect(), wp_read(), ism_intrhandler() +errchk wp_read, envgets, envgeti + +begin + # Initialize local storage. + call aclrc (buf, SZ_DATE) + call aclrc (cmd, SZ_FNAME) + call aclrc (ref, SZ_FNAME) + call aclrc (param, SZ_FNAME) + call aclrc (socket, SZ_FNAME) + call aclrc (message, SZ_LINE) + call aclrc (template, SZ_LINE) + + # Get the connection socket name from the environment if defined + # or else use the default socket. + if (envgets ("ISMDEV", socket, SZ_FNAME) <= 0) + call strcpy (WCSPIX_CONNECT, socket, SZ_FNAME) + + # Open the socket connection on a negotiated socket. + if (ism_connect (socket, WCSPIX_NAME, WCSPIX_MODE) == ERR) + return + + # Install an interrupt exception handler so we can exit cleanly. + if (ism_intrhandler() == ERR) + return + + + # Initialize the task data structures. + wp = wp_init () + + # Check for a runtime debug level. + iferr (WP_DBGLEVEL(wp) = envgeti ("WCSPIX_DEBUG")) + WP_DBGLEVEL(wp) = 0 + + # Log the connection. + call wp_cnvdate (clktime(0), buf, SZ_DATE) + call sprintf (message, SZ_LINE, "info { %s: WCSPIX Connect}\n") + call pargstr (buf) + call ism_message ("ism_msg", message) + + # Loop over the commands read on the connection and process. + disconnect = 1 + debug = (WCSPIX_DBG || WP_DBGLEVEL(wp) > 0) + while (wp_read (wp, message, len) != EOF) { + + if (debug) { + message[len] = '\0' + call eprintf("message: '%s' len=%d\n") + call pargstr (message); call pargi (len) + } + if (len <= 0) { + # Server has disconnected. + disconnect = 0 + break + } + + # Scan the command string and get the first word. + call sscan (message) + call gargwrd (cmd, SZ_LINE) + ncmd = strdic (cmd, cmd, SZ_LINE, WCSPIX_CMDS) + + switch (ncmd) { + case QUIT: + # Server wants us to shut down. + disconnect = 0 + break + + case INITIALIZE: + call wp_cnvdate (clktime(0), buf, SZ_DATE) + call sprintf (message, SZ_LINE, + "info { %s: WCSPIX Initialize}\n") + call pargstr (buf) + call wp_initialize (wp) + + case CACHE: + # <ref> <objid> <regid> + call gargwrd (ref, SZ_FNAME) + call gargi (objid) + call gargi (regid) + if (debug) { + call printf ("cache: objid=%d regid=%d ref='%s'\n") + call pargi(objid); call pargi(regid); call pargstr(ref) + } + + # Log the event. + call wp_cnvdate (clktime(0), buf, SZ_DATE) + call sprintf (message, SZ_LINE, + "info { %s: WCSPIX Cache objid=%3d %s}\n") + call pargstr (buf) + call pargi (objid) + call pargstr (ref) + call ism_message ("ism_msg", message) + + call wp_cache (wp, objid, regid, ref) + + case UNCACHE: + # <id> + call gargi (objid) + if (debug) { call printf("uncache: id=%d\n");call pargi(objid) } + + # Log the event. + call wp_cnvdate (clktime(0), buf, SZ_DATE) + call sprintf (message, SZ_LINE, + "info { %s: WCSPIX Uncache objid=%3d}\n") + call pargstr (buf) + call pargi (objid) + call ism_message ("ism_msg", message) + + call wp_uncache (wp, objid) + + case WCSTRAN: + # <id> <x> <y> [[<region> <x> <y>] ["NDC" <x> <y> ]] + call gargi (objid) + call gargr (x) ; call gargr (y) + if (debug) { + call printf ("wcstran: id=%d (%g,%g)\n") + call pargi(objid); call pargr (x); call pargr (y) + } + call wp_wcstran (wp, objid, x, y) + + case WCSLIST: + # <id> + call gargi (objid) + if (debug) { call printf ("wcslist: id=%d\n");call pargi(objid)} + call wp_wcslist (wp, objid) + + case OBJINFO: + # <id> <template_list> + call gargi (objid) + call gargwrd (template, SZ_FNAME) + if (debug) { + call printf ("objinfo: id=%d temp='%s'\n") + call pargi(objid); call pargstr (template); + } + call wp_objinfo (wp, objid, template) + + case SET: + # <param> <value> + call gargwrd (param, SZ_FNAME) + call wp_setpar (wp, param) + + case GET: + # <param> + + case DEBUG: + debug = !(debug) + + default: + if (debug) { + call eprintf ("ISM default: len=%d msg='%s'\n") + call pargi(len); call pargstr(message) + } + } + + # Clear the buffer for the next read. + call aclrc (message, SZ_LINE) + } + + # Disconnect from the server and clean up. + call ism_disconnect (disconnect) + call wp_shutdown (wp) +end + + +# WP_INITIALIZE -- Initialize the WCSPIX, uncache any previously cached images. + +procedure wp_initialize (wp) + +pointer wp #i WCSPIX structure + +pointer cp, wp_id2obj() +int i + +begin + for (i=0; i < SZ_CACHE; i=i+1) { + cp = wp_id2obj (wp, i) + if (cp != NULL && C_OBJID(cp) != NULL) + call wp_uncache (wp, C_OBJID(cp)) + } +end + + +# WP_CACHE -- Associate and object reference with a unique object id. + +procedure wp_cache (wp, objid, regid, ref) + +pointer wp #i WCSPIX structure +int objid #i object id +int regid #i region id +char ref[ARB] #i object ref + +pointer cp +int i, class +char alert[SZ_FNAME] + +int wp_class() + +include "class.com" + +begin + # Find an unused slot in the object cache. + for (i=0; i < SZ_CACHE; i=i+1) { + cp = OBJCACHE(wp,i) + if (C_NREF(cp) == 0) + break + } + + # Get the object class. + class = wp_class (ref) + if (class == ERR) { + # Send alert to the GUI. + call sprintf (alert, SZ_FNAME, "wp_cache: Unable to cache\n%s") + call pargstr (ref) + call ism_alert (alert, "", "") + + # Setup for linear system. + return + } + C_CLASS(cp) = class + + # Initialize the object. + if (class != NULL && CL_INIT(class) != NULL) + call zcall2 (CL_INIT(class), cp, wp) + + # Call the cache function. + if (class != NULL && CL_CACHE(class) != NULL) + call zcall4 (CL_CACHE(class), cp, objid, regid, ref) +end + + +# WP_UNCACHE -- Remove an object from the WCSPIX cache. + +procedure wp_uncache (wp, id) + +pointer wp #i WCSPIX structure +int id #i object id + +pointer cp, wp_id2obj() +int class + +include "class.com" + +begin + cp = wp_id2obj (wp, id) + if (cp == NULL) + return + + # Call the uncache function. + class = C_CLASS(cp) + if (class != NULL && CL_UNCACHE(class) != NULL) + call zcall2 (CL_UNCACHE(class), cp, id) + + C_NREF(cp) = 0 +end + + +# WP_WCSTRAN -- Translate image coords to WCS values. + +procedure wp_wcstran (wp, id, x, y) + +pointer wp #i WCSPIX structure +int id #i object id +real x, y #i image coords + +pointer cp, wp_id2obj() +int class + +include "class.com" + +begin + cp = wp_id2obj (wp, id) + if (cp == NULL) + return + + # Call the uncache function. + class = C_CLASS(cp) + if (class != NULL && CL_WCSTRAN(class) != NULL) + call zcall4 (CL_WCSTRAN(class), cp, id, x, y) +end + + +# WP_WCSLIST -- List the available world coordinate systems for the given +# object. + +procedure wp_wcslist (wp, id) + +pointer wp #i WCSPIX structure +int id #i object id + +pointer cp, wp_id2obj() +int class + +include "class.com" + +begin + cp = wp_id2obj (wp, id) + if (cp == NULL) + return + + # Call the uncache function. + class = C_CLASS(cp) + if (class != NULL && CL_WCSLIST(class) != NULL) + call zcall2 (CL_WCSLIST(class), cp, id) +end + + +# WP_OBJINFO -- Get and image header or keyword templates for the given +# object. + +procedure wp_objinfo (wp, id, template) + +pointer wp #i WCSPIX structure +int id #i object id +char template[ARB] #i keyword template + +pointer cp, wp_id2obj() +int class + +include "class.com" + +begin + cp = wp_id2obj (wp, id) + if (cp == NULL) + return + + # Call the uncache function. + class = C_CLASS(cp) + if (class != NULL && CL_OBJINFO(class) != NULL) + call zcall3 (CL_OBJINFO(class), cp, id, template) +end + + +# WP_SETPAR -- Set the value of a WCSPIX ISM parameter. + +procedure wp_setpar (wp, param) + +pointer wp #i WCSPIX structure pointer +char param[SZ_FNAME] #i WCSPIX param name + +char arg[SZ_PARAM], buf[SZ_PARAM], msg[SZ_PARAM] +int line + +int strdic() + +include "class.com" + +begin + if (WCSPIX_DBG) { call printf ("set: %s = ");call pargstr(param) } + + switch (strdic (param, param, SZ_PARAM, WCSPIX_PARAMS)) { + case PAR_PSIZE: + call gargi (WP_PTABSZ(wp)) + if (WCSPIX_DBG) { call printf ("%d\n");call pargi(WP_PTABSZ(wp)) } + + case PAR_BPM: + call gargi (WP_BPM(wp)) + if (WCSPIX_DBG) { call printf ("%d\n");call pargi(WP_BPM(wp)) } + + case PAR_WCS: + call gargwrd (buf, SZ_FNAME) + call gargi (line) + + call strcpy (buf, arg, SZ_PARAM) + call strlwr (buf) + switch (strdic (buf, buf, SZ_FNAME, WCSPIX_SYSTEMS)) { + case SYS_DISPLAY: SYSTEMS(wp,line) = SYS_DISPLAY + case SYS_LOGICAL: SYSTEMS(wp,line) = SYS_LOGICAL + case SYS_PHYSICAL: SYSTEMS(wp,line) = SYS_PHYSICAL + case SYS_WORLD: SYSTEMS(wp,line) = SYS_WORLD + case SYS_NONE: SYSTEMS(wp,line) = SYS_NONE + case SYS_AMP: SYSTEMS(wp,line) = SYS_AMP + case SYS_CCD: SYSTEMS(wp,line) = SYS_PHYSICAL + case SYS_DETECTOR: SYSTEMS(wp,line) = SYS_DETECTOR + default: SYSTEMS(wp,line) = SYS_SKY + } + call strcpy (buf, WCSNAME(wp,line), LEN_WCSNAME) + + if (WCSPIX_DBG) { + call printf("%s line=%d\n");call pargstr(buf);call pargi(line) } + + call sprintf (msg, SZ_FNAME, "wcstype %s %d") + call pargstr (arg) + call pargi (line) + call wcspix_message (msg) + + case PAR_FMT: + call gargwrd (buf, SZ_FNAME) + call gargi (line) + + call strcpy (buf, arg, SZ_PARAM) + call strlwr (buf) + switch (strdic (buf, buf, SZ_FNAME, WCSPIX_FMT)) { + case FMT_DEFAULT: FORMATS(wp,line) = FMT_DEFAULT + case FMT_HMS: FORMATS(wp,line) = FMT_HMS + case FMT_DEG: FORMATS(wp,line) = FMT_DEG + case FMT_RAD: FORMATS(wp,line) = FMT_RAD + default: FORMATS(wp,line) = FMT_DEFAULT + } + + if (WCSPIX_DBG) { + call printf("%s line=%d\n");call pargstr(buf);call pargi(line) } + + call sprintf (msg, SZ_FNAME, "wcsfmt %s %d") + call pargstr (arg) + call pargi (line) + call wcspix_message (msg) + } +end + + +# WP_GETPAR -- Get the value of a WCSPIX ISM parameter. + +procedure wp_getpar (wp, param) + +pointer wp #i WCSPIX structure pointer +char param[SZ_FNAME] #i WCSPIX param name + +int strdic() + +begin + if (WCSPIX_DBG) { call printf ("set: %s = ");call pargstr(param) } + + switch (strdic (param, param, SZ_PARAM, WCSPIX_PARAMS)) { + case PAR_PSIZE: + case PAR_BPM: + case PAR_WCS: + case PAR_FMT: + } +end + + +################################################################################ +# +# Private procedures. +# +################################################################################ + + +# WP_INIT -- Initialize the WCSPIX task and data structures. + +pointer procedure wp_init () + +pointer wp #r WCSPIX structure pointer +int i + +begin + # Allocate the task structure. + iferr (call calloc (wp, SZ_WCSPIX, TY_STRUCT)) + call error (0, "Error opening WCSPIX task structure.") + + call calloc (WP_SYSTEMS(wp), MAX_WCSLINES, TY_INT) + call calloc (WP_FORMATS(wp), MAX_WCSLINES, TY_INT) + call calloc (WP_WCS(wp), (LEN_WCSNAME*MAX_WCSLINES), TY_CHAR) + for (i=1; i <= MAX_WCSLINES; i=i+1) { + FORMATS(wp,i) = DEF_FMT + SYSTEMS(wp,i) = DEF_SYSTEM + call strcpy ("none", WCSNAME(wp,i), LEN_WCSNAME) + } + + # Allocate the object cache. + call calloc (WP_CPTR(wp), SZ_CACHE, TY_STRUCT) + for (i=0; i < SZ_CACHE; i=i+1) + call calloc (OBJCACHE(wp,i), SZ_CNODE, TY_STRUCT) + + WP_PTABSZ(wp) = 0 + WP_BPM(wp) = DEF_BPM_FLAG + + # Initialize the class modules. + call wp_class_init() + + return (wp) +end + + +# WP_READ -- Read messages from the connection and process them optimally for +# this ISM. This means we segment the messages and handle only the last +# few WCS requests so we can keep up with the server requests. Presumably +# there are more cursor events coming which are no longer valid so some are +# thrown out. + +int procedure wp_read (wp, message, len) + +pointer wp #i WCSPIX structure pointer +char message[ARB] #o message buffer +int len #o length of message + +int nleft + +int ism_read(), strncmp() +errchk ism_read + +begin + while (true) { + nleft = ism_read (message, len) + + # Return EOF if the server hung up on us. + if (nleft == EOF) + return (EOF) + + # In debug mode process all messages. + if (WP_DBGLEVEL(wp) > 0) + break + + # Pass back all non-wcstran messages. + if (strncmp ("wcstran", message, 7) != 0) + break + + # Only pass back the last wcstran messages received (eat the rest). + if (strncmp ("wcstran", message, 7) == 0 && nleft <= 1) + break + } + + return (len) +end + + +# WP_SHUTDOWN -- Shut down the WCSPIX, freeing all storage + +procedure wp_shutdown (wp) + +pointer wp #i WCSPIX structure +int i + +begin + # Free the structures. + call mfree (WP_WCS(wp), TY_CHAR) + call mfree (WP_FORMATS(wp), TY_INT) + call mfree (WP_SYSTEMS(wp), TY_INT) + for (i=0; i < SZ_CACHE; i=i+1) + call mfree (OBJCACHE(wp,i), TY_STRUCT) + + call mfree (WP_CPTR(wp), TY_STRUCT) + call mfree (wp, TY_STRUCT) +end + + +# WP_CLASS -- Determine the object class for the named image/file. + +int procedure wp_class (object) + +char object[ARB] #i object reference + +int n, class +pointer im +char ch, buf[SZ_FNAME] + +int strlen(), stridx() +bool streq() +pointer immap() + +errchk immap + +begin + # The following kludge is necessary to protect against the case + # where dev$pix is used as a test image. The 'object' pathname in + # this case is "node!/path/dev/pix" which lacks the extension + # and causes the task to fail to open because of a conflict with + # the pix.hhh in the same directory. Most IRAF tasks work since + # the imio$iki code treats the string "dev$pix" as a special case. + + call imgimage (object, buf, SZ_FNAME) + n = strlen (buf) - 7 + if (streq (buf[n], "/dev/pix")) { + call strcpy ("dev$pix", buf, SZ_FNAME) + ch = '[' + n = stridx (ch, object) + if (n > 0) + call strcat (object[n], buf, SZ_FNAME) + call strcpy (buf, object, SZ_FNAME) + } + + + # See if we can map the image to get at least an image class. If + # so then check for special subclasses like Mosaic files, spectra, etc. + + class = UNKNOWN_CLASS + ifnoerr (im = immap (object, READ_ONLY, 0)) { + class = IMAGE_CLASS + + # Now check for subclasses. (TBD) + + call imunmap (im) + } + + return (class) +end + + +# WP_ID2OBJ -- Utility routine to convert and object id to the cache pointer. + +pointer procedure wp_id2obj (wp, id) + +pointer wp #i WCSPIX structure +int id #i object id + +int i +pointer cp + +begin + for (i=0; i < SZ_CACHE; i=i+1) { + cp = OBJCACHE(wp,i) + if (C_OBJID(cp) == id) + return (cp) + } + return (NULL) +end + + +# WP_CLASS_INIT -- Initialize the WCSPIX ISM class modules. + +procedure wp_class_init() + +extern img_init(), img_cache(), img_uncache() +extern img_wcstran(), img_wcslist(), img_objinfo() + +extern mef_init(), mef_cache(), mef_uncache() +extern mef_wcstran(), mef_wcslist(), mef_objinfo() + +extern msp_init(), msp_cache(), msp_uncache() +extern msp_wcstran(), msp_wcslist(), msp_objinfo() + +extern unk_init(), unk_cache(), unk_uncache() +extern unk_wcstran(), unk_wcslist(), unk_objinfo() + +include "class.com" +int locpr() + +begin + cl_nclass = 0 + + # Load the class modules. + call wp_load_class ("unknown", + locpr(unk_init), locpr(unk_cache), locpr(unk_uncache), + locpr(unk_wcstran), locpr(unk_wcslist), locpr(unk_objinfo)) + call wp_load_class ("image", + locpr(img_init), locpr(img_cache), locpr(img_uncache), + locpr(img_wcstran), locpr(img_wcslist), locpr(img_objinfo)) + call wp_load_class ("mef", + locpr(mef_init), locpr(mef_cache), locpr(mef_uncache), + locpr(mef_wcstran), locpr(mef_wcslist), locpr(mef_objinfo)) + call wp_load_class ("multispec", + locpr(msp_init), locpr(msp_cache), locpr(msp_uncache), + locpr(msp_wcstran), locpr(msp_wcslist), locpr(msp_objinfo)) +end + + +# WP_LOAD_CLASS -- Load an object class module for the ISM task. + +procedure wp_load_class (name, init, cache, uncache, tran, list, info) + +char name[ARB] #I module name +int init #I initialize procedure +int cache #I cache the object procedure +int uncache #I uncache the object procedure +int tran #I translate WCS procedure +int list #I list WCS proedure +int info #I get header procedure + +errchk syserrs +include "class.com" + +begin + # Get a new driver slot. + if (cl_nclass + 1 > MAX_CLASSES) + return + cl_nclass = cl_nclass + 1 + + # Load the driver. + CL_INIT(cl_nclass) = init + CL_CACHE(cl_nclass) = cache + CL_UNCACHE(cl_nclass) = uncache + CL_WCSTRAN(cl_nclass) = tran + CL_WCSLIST(cl_nclass) = list + CL_OBJINFO(cl_nclass) = info + call strcpy (name, CL_NAME(cl_nclass), SZ_FNAME) +end + + +# WCSPIX_MESSAGE -- Deliver a message to the ISM callback, tagged with +# our name so it can be passed off to the correct code. + +procedure wcspix_message (message) + +char message[ARB] #I message to send + +pointer sp, msgbuf +int msglen, mlen, ip + +int strlen() + +begin + # Get the message length plus some extra for the braces and padding. + mlen = strlen (message) + msglen = mlen + 64 + + # Allocate and clear the message buffer. + call smark (sp) + call salloc (msgbuf, msglen, TY_CHAR) + call aclrc (Memc[msgbuf], msglen) + + ip = 0 + call amovc ("deliver wcspix { ", Memc[msgbuf], 17) ; ip = ip + 17 + call amovc (message, Memc[msgbuf+ip], mlen) ; ip = ip + mlen + call amovc (" }\0", Memc[msgbuf+ip], 2) ; ip = ip + 2 + + call ism_message ("ism_msg", Memc[msgbuf]) + + call sfree (sp) +end + + +define SZ_WEEKDAY 3 +define SZ_MONTH 3 + +# WP_CNVDATE -- Convert a time in integer seconds since midnight on Jan 1, 1980 +# into a short string such as "5/15 18:24". + +procedure wp_cnvdate (ltime, outstr, maxch) + +long ltime # seconds since 00:00:00 10-Jan-1980 +char outstr[ARB] +int maxch + +int tm[LEN_TMSTRUCT] + +begin + call brktime (ltime, tm) + +# call sprintf (outstr, maxch, "%2d/%2d %2d:%02d") +# call pargi (TM_MONTH(tm)) +# call pargi (TM_MDAY(tm)) +# call pargi (TM_HOUR(tm)) +# call pargi (TM_MIN(tm)) + +# call sprintf (outstr, maxch, "%2d:%02d") +# call pargi (TM_HOUR(tm)) +# call pargi (TM_MIN(tm)) + + call sprintf (outstr, maxch, "%2d:%02d:%02d") + call pargi (TM_HOUR(tm)) + call pargi (TM_MIN(tm)) + call pargi (TM_SEC(tm)) +end + + + +#---------------- +# DEBUG ROUTINES. +#---------------- +procedure dbg_printcache (wp, buf) +pointer wp +char buf[ARB] +pointer cp, wp_id2obj() +int i +begin + call printf ("%s\n") ; call pargstr (buf) + for (i=0; i < SZ_CACHE; i=i+1) { + cp = wp_id2obj (wp, i) + if (C_DATA(cp) != NULL) { + call printf ("%3d: id=%d ref='%s'\n") + call pargi(i) + call pargi(C_OBJID(cp)) + call pargstr(C_REF(cp)) + } + } +end diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x b/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x new file mode 100644 index 00000000..4a27af46 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x @@ -0,0 +1,1465 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include <imio.h> +include <imhdr.h> +include <time.h> +include <ctype.h> +include <mwset.h> +include <pkg/skywcs.h> +include "wcspix.h" + + +# Image class data. +define LEN_IMGDATA 15 +define IMG_WP Memi[$1 ] # wcspix back-pointer +define IMG_IM Memi[$1+1] # image pointer +define IMG_BPM Memi[$1+2] # bad pixel mask pointer +define IMG_MW Memi[$1+3] # image wcs pointer +define IMG_CO Memi[$1+4] # skywcs transform pointer +define IMG_CTW Memi[$1+5] # mwcs log->world transform ptr +define IMG_CTP Memi[$1+6] # mwcs log->phys transform ptr +define IMG_CTA Memi[$1+7] # mwcs log->amplifier transform +define IMG_CTD Memi[$1+8] # mwcs log->detector transform +define IMG_ROT Memr[$1+9] # rotation angle +define IMG_SCALE Memr[$1+10] # plate scale +define IMG_LINEAR Memi[$1+11] # linear coords + + +define IMG_DEBUG FALSE + + +# IMG_INIT -- Initialize the object structure. + +procedure img_init (cp, wp) + +pointer cp #i cache pointer +pointer wp #i WCSPIX structure + +pointer img # data pointer + +begin + if (IMG_DEBUG) call printf ("img_init: \n") + + # Allocate the image data structure if not previously allocated. + if (C_DATA(cp) == NULL) { + iferr (call calloc (C_DATA(cp), LEN_IMGDATA, TY_STRUCT)) + return + } + + img = C_DATA(cp) + IMG_WP(img) = wp + IMG_IM(img) = NULL + IMG_BPM(img) = NULL + IMG_MW(img) = NULL + IMG_CO(img) = NULL + IMG_CTW(img) = NULL + IMG_CTP(img) = NULL + IMG_CTA(img) = NULL + IMG_CTD(img) = NULL + IMG_ROT(img) = 0.0 + IMG_SCALE(img) = 0.0 + IMG_LINEAR(img) = YES +end + + +# IMG_CACHE -- Cache an image in the object cache. + +procedure img_cache (cp, objid, regid, ref) + +pointer cp #i cache pointer +int objid #i object id +int regid #i region id +char ref[ARB] #i object reference + +pointer img, im, wp, co +int stat, i1, i2 +char alert[SZ_LINE] + +pointer immap(), ds_pmmap(), mw_sctran() +pointer img_amp_wcs(), img_det_wcs() +int imaccf(), sk_decim() + +errchk immap, ds_pmmap, mw_sctran, sk_decim, sk_setd + +begin + if (IMG_DEBUG) call printf ("img_cache: \n") + + # Now map the image and WCS. + img = C_DATA(cp) + wp = IMG_WP(img) + + iferr (IMG_IM(img) = immap (ref, READ_ONLY, 0)) { + # Send alert to the GUI. + call sprintf (alert, SZ_FNAME, "Unable to cache\n%s") + call pargstr (ref) + call ism_alert (alert, "", "") + return + } + im = IMG_IM(img) + + IMG_CO(img) = NULL + IMG_CTW(img) = NULL + IMG_CTP(img) = NULL + IMG_CTA(img) = NULL + IMG_CTD(img) = NULL + iferr { + stat = sk_decim (IMG_IM(img), "world", IMG_MW(img), IMG_CO(img)) + if (IMG_DEBUG) { + call eprintf ("img_cache - decim: stat=%d mw=%d co=%d \n") + call pargi(stat);call pargi(IMG_MW(img)) + call pargi(IMG_CO(img)); + } + if (stat == ERR || IMG_MW(img) == NULL) { + IMG_LINEAR(img) = YES + + co = IMG_CO(img) + i1 = IM_VMAP(im,1) + i2 = IM_VMAP(im,2) + call sk_setd (co, S_VXOFF, double(IM_VOFF(im,i1))) + call sk_setd (co, S_VYOFF, double(IM_VOFF(im,i2))) + call sk_setd (co, S_VXSTEP, double(IM_VSTEP(im,i1))) + call sk_setd (co, S_VYSTEP, double(IM_VSTEP(im,i2))) + + IMG_MW(img) = NULL + IMG_LINEAR(img) = YES + } + + if (IMG_MW(img) != NULL) { + IMG_CTW(img) = mw_sctran (IMG_MW(img), "logical", "world", 03B) + IMG_CTP(img) = mw_sctran (IMG_MW(img), "logical", "physical", + 03B) + + # Get the amplifier transformation values if present. + if (imaccf(im,"ATM1_1") == YES && + imaccf(im,"ATM2_2") == YES && + imaccf(im,"ATV1") == YES && + imaccf(im,"ATV2") == YES) + IMG_CTA(img) = img_amp_wcs (im, IMG_MW(img)) + + if (imaccf(im,"DTM1_1") == YES && + imaccf(im,"DTM2_2") == YES && + imaccf(im,"DTV1") == YES && + imaccf(im,"DTV2") == YES) + IMG_CTD(img) = img_det_wcs (im, IMG_MW(img)) + } + + } then { + # Send alert to the GUI. + call sprintf (alert, SZ_FNAME, "Unable to decode image WCS\n%s") + call pargstr (ref) + call ism_alert (alert, "", "") + IMG_LINEAR(img) = YES + } + + + # See if we can find a bad pixel mask. + IMG_BPM(img) = NULL + if (WP_BPM(wp) == YES) { + iferr (IMG_BPM(img) = ds_pmmap ("BPM", IMG_IM(img))) + IMG_BPM(img) = NULL + } + + C_OBJID(cp) = objid + C_REGID(cp) = regid + C_NREF(cp) = C_NREF(cp) + 1 + call strcpy (ref, C_REF(cp), 128) +end + + +# IMG_UNCACHE -- Uncache an image in the object cache. + +procedure img_uncache (cp, id) + +pointer cp #i cache pointer +int id #i image id + +pointer img + +begin + if (IMG_DEBUG) call printf ("img_uncache: \n") + + C_OBJID(cp) = NULL + C_NREF(cp) = 0 + call strcpy ("", C_REF(cp), SZ_FNAME) + + img = C_DATA(cp) + if (IMG_MW(img) != NULL) + call mw_close (IMG_MW(img)) + if (IMG_BPM(img) != NULL) + call imunmap (IMG_BPM(img)) + if (IMG_IM(img) != NULL) + call imunmap (IMG_IM(img)) + + IMG_IM(img) = NULL + IMG_BPM(img) = NULL + IMG_MW(img) = NULL + IMG_CTW(img) = NULL + IMG_CTP(img) = NULL + IMG_CTA(img) = NULL + IMG_CTD(img) = NULL + IMG_CO(img) = NULL + IMG_ROT(img) = 0.0 + IMG_SCALE(img) = 0.0 + IMG_LINEAR(img) = NO + + call mfree (C_DATA(cp), TY_STRUCT) + C_DATA(cp) = NULL +end + + +# IMG_WCSTRAN -- Translate object source (x,y) coordinates to the +# desired output WCSs. Message is returned as something like: +# +# set value { +# { object <objid> } { region <regionid> } +# { pixval <pixel_value> [<units>] } +# { bpm <bpm_pixel_value> } +# { coord <wcsname> <x> <y> [<xunits> <yunits>] } +# { coord <wcsname> <x> <y> [<xunits> <yunits>] } +# : +# } + + +procedure img_wcstran (cp, id, x, y) + +pointer cp #i cache pointer +int id #i image id +real x, y #i source coords + +pointer img, im, wp, co +double dx, dy, wx, wy +real rx, ry, pixval +int i, bpm + +# Use static storage to avoid allocation overhead. +char buf[SZ_LINE] +char msg[SZ_LINE], wcs[LEN_WCSNAME], xc[LEN_WCSNAME], yc[LEN_WCSNAME] +char xunits[LEN_WCSNAME], yunits[LEN_WCSNAME] + +double sk_statd() + +begin + if (IMG_DEBUG) call printf ("img_wcstran: \n") + + img = C_DATA(cp) # initialize + co = IMG_CO(img) + wp = IMG_WP(img) + im = IMG_IM(img) + + # Get the translation to the image section. + dx = (double(x) - sk_statd(co,S_VXOFF)) / sk_statd(co,S_VXSTEP) + dy = (double(y) - sk_statd(co,S_VYOFF)) / sk_statd(co,S_VYSTEP) + rx = dx + ry = dy + + # Read the pixel data. + call img_get_data (cp, id, rx, ry, pixval, bpm) + + # Begin formatting the message. + call aclrc (msg, SZ_LINE) + call sprintf (msg, SZ_LINE, "wcstran { object %d } { region %d } ") + call pargi (C_OBJID(cp)) + call pargi (C_REGID(cp)) + + call sprintf (buf, SZ_LINE, "{ pixval %9.9g } { bpm %d }\n") + call pargr (pixval) + call pargi (bpm) + call strcat (buf, msg, SZ_LINE) + + # Now loop over the requested systems and generate a coordinate + # for each. + for (i=1; i <= MAX_WCSLINES; i=i+1) { + + # Get the coordinate value. + call img_get_coord (img, dx, dy, SYSTEMS(wp,i), WCSNAME(wp,i), + wx, wy) + + # Get the system name, labels, and formats strings for the WCS. + call img_coord_labels (cp, i, wcs, xunits, yunits) + + # Format the values as requested. + call img_coord_fmt (cp, i, wx, wy, xc, yc) + + # Format the coord buffer and append it to the message. + call sprintf (buf, SZ_LINE, + "{coord {%9s} {%12s} {%12s} {%4s} {%4s}}\n") + call pargstr (wcs) + call pargstr (xc) + call pargstr (yc) + call pargstr (xunits) + call pargstr (yunits) + call strcat (buf, msg, SZ_LINE) + } + + # Now send the completed message. + call wcspix_message (msg); +end + + +# IMG_WCSLIST -- List the WCSs available for the given image. + +procedure img_wcslist (cp, id) + +pointer cp #i cache pointer +int id #i image id + +pointer img, im, mw +char msg[SZ_LINE] + +begin + if (IMG_DEBUG) call printf ("img_wcslist: \n") + + img = C_DATA(cp) # initialize + mw = IMG_MW(img) + im = IMG_IM(img) + + call strcpy ("wcslist {None Display Logical World Physical line ", + msg, SZ_LINE) + + # See if we can do amplifier/detector coords by checking for ATM/ATV + # and DTM/DTV keywords. + + if (IMG_CTA(img) != NULL) + call strcat (" Amplifier ", msg, SZ_LINE) + if (IMG_CTD(img) != NULL) + call strcat (" Detector ", msg, SZ_LINE) + if (IMG_CTA(img) != NULL || IMG_CTD(img) != NULL) + call strcat (" CCD ", msg, SZ_LINE) + + # If we have a MWCS pointer list the sky projections. + if (mw != NULL) { + call strcat (" line ", msg, SZ_LINE) + call strcat (SKYPROJ, msg, SZ_LINE) + } + + # Close the message. + call strcat ("}", msg, SZ_LINE) + + call wcspix_message (msg) +end + + +# IMG_GET_DATA -- Get data from the image. + +procedure img_get_data (cp, id, x, y, pixval, bpm_pix) + +pointer cp #i cache pointer +int id #i image id +real x, y #i source coords +real pixval #o central pixel value +int bpm_pix #o bad pixel mask value + +pointer img, wp, im, bpm, pix, sp, msg, buf +int nl, nc, ix, iy, s2 +int size, x1, x2, y1, y2 + +long clktime() +pointer imgs2r(), imgs2i(), ds_pmmap() +errchk ds_pmmap + +begin + + img = C_DATA(cp) + wp = IMG_WP(img) + im = IMG_IM(img) + bpm = IMG_BPM(img) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) +# size = WP_PTABSZ(wp) + size = min(min(nc,nl),WP_PTABSZ(wp)) + + if (IMG_DEBUG) { + call printf ("img_get_data: \n") + call eprintf ("\tx: %g y: %g nc: %d nl: %d\n") + call pargr(x); call pargr(y); call pargi(nc); call pargi(nl) + } + + # Sanity check on the cursor image position. + if (x < 0.0 || y < 0.0 || x > (nc+0.5) || y > (nl+0.5)) + return + + # Bounds checking. Rather than deal with out of bounds pixels we'll + # adjust the center pixel so we get the same size raster up to each + # boundary. + + ix = int (x + 0.5) ; iy = int (y + 0.5) + ix = min (ix, (nc-(size/2)-1)) ; iy = min (iy, (nl-(size/2)-1)) + ix = max (size/2+1, ix) ; iy = max (size/2+1, iy) + + # Compute the box offset given the center and size. + x1 = ix - size / 2 + 0.5 + x2 = ix + size / 2 + 0.5 + y1 = iy - size / 2 + 0.5 + y2 = iy + size / 2 + 0.5 + + if (IMG_DEBUG) { + call printf ("img_get_data: \n") + call eprintf ("\tix: %d iy: %g size: %d\n") + call pargi(ix); call pargi(iy); call pargi(size) + call eprintf ("\tx1: %d y1: %d x2: %d y2: %d\n") + call pargi(x1); call pargi(y1); + call pargi(x2); call pargi(y2); + } + + x1 = max (1, x1) + x2 = min (nc, x2) + y1 = max (1, y1) + y2 = min (nl, y2) + + if (IMG_DEBUG) { + call eprintf ("\tx1: %d y1: %d x2: %d y2: %d\n") + call pargi(x1); call pargi(y1); + call pargi(x2); call pargi(y2); + } + + # Get the image pixels + pix = imgs2r (im, int(x1), int(x2), int(y1), int(y2)) + + if (WP_BPM(wp) == YES) { + if (bpm != NULL) { + bpm_pix = Memi[imgs2i (bpm, ix, ix, iy, iy)] + } else { + # See if we can find a bad pixel mask. The option is enabled + # but we haven't mappend the mask yet. + + # Log the event. + call smark (sp) + call salloc (msg, SZ_LINE, TY_CHAR) + call salloc (buf, SZ_LINE, TY_CHAR) + call wp_cnvdate (clktime(0), Memc[buf], SZ_DATE) + call sprintf (Memc[msg], SZ_LINE, + "info { %s: WCSPIX BPM map objid=%3d %s}\n") + call pargstr (Memc[buf]) + call pargi (C_OBJID(cp)) + call pargstr (C_REF(cp)) + call ism_message ("ism_msg", Memc[msg]) + + iferr (IMG_BPM(img) = ds_pmmap ("BPM", im)) { + IMG_BPM(img) = NULL + bpm_pix = 0 + + # Send alert to the GUI. + call sprintf (Memc[buf], SZ_FNAME, + "Unable to map BPM image for\n%s") + call pargstr (C_REF(cp)) + call ism_alert (Memc[buf], "", "") + } else + bpm_pix = Memi[imgs2i (IMG_BPM(img), ix, ix, iy, iy)] + + call sfree (sp) + } + } else + bpm_pix = 0 + + # See if we're near an edge... + s2 = size / 2 + if (int(x)<s2 || int(x)>(nl-s2-1) || int(y)<s2 || int(x)>(nc-s2-1)) { + # Compute the image pixel associated with the requested coords. + ix = int (x + 0.5) + iy = int (y + 0.5) + pixval = Memr[imgs2r(im, ix, ix, iy, iy)] + } else { + pixval = Memr[pix + ((size/2)*size) + (size/2)] + } + + # Send the pixel table. + if (WP_PTABSZ(wp) > 1) + call img_send_pixtab (Memr[pix], WP_PTABSZ(wp), x1, x2, y1, y2) + + if (IMG_DEBUG) { + call printf ("img_get_data: pixval=%g\n") ; call pargr (pixval) + } +end + + +# IMG_OBJINFO -- Get header information from the image. + +procedure img_objinfo (cp, id, template) + +pointer cp #i cache pointer +int id #i image id +char template[ARB] #i keyword template + +pointer im, img + +define WCS_TEMPLATE "WCSDIM,CTYPE*,CRPIX*,CRVAL*,CD*,CROTA2,LTV*,LTM*,WSV*,WAT*,RA*,DEC*,EQUINOX,EPOCH,MJD*,DATE-OBS" + +begin + if (IMG_DEBUG) call printf ("img_objinfo: \n") + + # Send the full header (or keyword filtered header), only the WCS + # keywords, and a plain-text explanation of the WCS. + + img = C_DATA(cp) + im = IMG_IM(img) + + call img_send_header (im, "imghdr", template) + call img_send_header (im, "wcshdr", WCS_TEMPLATE) + call img_send_wcsinfo (im, cp) + call img_send_compass (im, cp) +end + + + +#============================================================================== + +# IMG_SEND_HEADER -- Send an image header to the named GUI object. Keywords +# are filtered according to a specified template + +procedure img_send_header (im, object, template) + +pointer im #i image descriptor +char object[ARB] #i object for the message +char template[ARB] #i keyword template + +pointer sp, hdr, lbuf, line, field, keyw, dict +pointer ip, lp, list +int nlines, in, out, i, hdr_size +bool keyw_filter + +int stropen(), getline(), stridx(), imgnfn(), strdic() +pointer imofnlu() +bool streq() +errchk stropen, getline, putci, putline, imgnfn, imofnlu, strdic + +define USER_AREA Memc[($1+IMU-1)*SZ_STRUCT + 1] +define SZ_KEYW 8 + +begin + hdr_size = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1 + hdr_size = hdr_size + SZ_LINE + + call smark (sp) + call salloc (hdr, hdr_size, TY_CHAR) + call salloc (dict, hdr_size, TY_CHAR) + call salloc (field, SZ_LINE, TY_CHAR) + call salloc (lbuf, SZ_LINE, TY_CHAR) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (keyw, SZ_KEYW, TY_CHAR) + + in = stropen (USER_AREA(im), hdr_size, READ_ONLY) + out = stropen (Memc[hdr], hdr_size, WRITE_ONLY) + call fprintf (out, "%s {") + call pargstr (object) + + # Build up a dictionary of header keywords based on the template. + keyw_filter = (!streq (template, "*")) + if (keyw_filter) { + list = imofnlu (im, template) + call strcpy ("|", Memc[dict], hdr_size) + while (imgnfn (list, Memc[field], SZ_FNAME) != EOF) { + call strcat (Memc[field], Memc[dict], hdr_size) + call strcat ("|", Memc[dict], hdr_size) + } + call imcfnl (list) + } + + + # Copy header records to the output, stripping any trailing + # whitespace and clipping at the right margin. We also filter + # against the keyword dictionary found above. + + nlines = 0 + while (getline (in, Memc[lbuf]) != EOF) { + + call aclrc (Memc[line], SZ_LINE) + + # Escape any brackets passed to the Tcl. + ip = lbuf + lp = line + while (Memc[ip] != EOS && Memc[ip] != '\n') { + if (stridx (Memc[ip], "[{") > 0) { + Memc[lp] = '\\' + lp = lp + 1 + } + Memc[lp] = Memc[ip] + ip = ip + 1 + lp = lp + 1 + } + Memc[lp] = '\n' + Memc[lp+1] = EOS + + # See whether the line matches a keyword we want to output. + if (keyw_filter) { + for (i=0; i < SZ_KEYW && !IS_WHITE(Memc[line+i]); i=i+1) + Memc[keyw+i] = Memc[line+i] + Memc[keyw+i] = '\0' + + # If not in the dictionary skip to the next line. + if (strdic (Memc[keyw], Memc[keyw], SZ_KEYW, Memc[dict]) == 0) + next + } + + call putci (out, ' ') + call putline (out, Memc[line]) + + # Send the header in small chunks so we don't overflow the + # message buffer. + nlines = nlines + 1 + if (mod(nlines,10) == 0) { + call fprintf (out, "}") + call close (out) + call wcspix_message (Memc[hdr]); + call aclrc (Memc[hdr], hdr_size) + out = stropen (Memc[hdr], hdr_size, WRITE_ONLY) + call fprintf (out, "%s {") + call pargstr (object) + } + } + call fprintf (out, "}") + + call close (in) + call close (out) + + # Send the final message. + call wcspix_message (Memc[hdr]) + + # Pad a few lines for the GUI + call sprintf (Memc[hdr], SZ_LINE, "%d { \n\n\n }") + call pargstr (object) + call wcspix_message (Memc[hdr]) + + call sfree (sp) +end + + +# IMG_SEND_COMPASS -- Send information about the image WCS in a plain-english +# string. + +procedure img_send_compass (im, cp) + +pointer im #i image descriptor +pointer cp #i cache element pointer + +pointer sp, buf, img, co, mw +double r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM] +int i, j +long axis[IM_MAXDIM], lv[IM_MAXDIM], pv1[IM_MAXDIM], pv2[IM_MAXDIM] + +real north[2], east[2] + +int mw_stati(), sk_stati() + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call aclrc (Memc[buf], SZ_LINE) + + # Get the data pointer. + img = C_DATA(cp) + co = IMG_CO(img) + + # Get world coords at the image corners. + if (IMG_CTW(img) != NULL) { + + # Get the CD matrix for the image. + mw = IMG_MW(img) + call wcs_gfterm (mw, r, w, cd, mw_stati(mw, MW_NPHYSDIM)) + + # Compute a Nort and East vector for the CD matrix. + call img_cvectors (cd, 1.0, north, east) + + } else { + # Determine the logical to physical mapping by evaluating two + # points and determining the axis reduction if any. pv1 will be + # the offset and pv2-pv1 will be the scale. + + lv[1] = 0; lv[2] = 0; call imaplv (im, lv, pv1, 2) + lv[1] = 1; lv[2] = 1; call imaplv (im, lv, pv2, 2) + + i = 1 + axis[1] = 1; axis[2] = 2 + do j = 1, IM_MAXDIM { + if (pv1[j] != pv2[j]) { + axis[i] = j + i = i + 1 + } + } + north[1] = 0.0 + north[2] = (pv2[axis[2]] - pv1[axis[2]]) + east[1] = -(pv2[axis[1]] - pv1[axis[1]]) + east[2] = 0.0 + } + + call sprintf (Memc[buf], SZ_LINE, "compass %d %g %g %g %g %g %d %s\0") + call pargi (C_OBJID(cp)) + call pargr (IMG_ROT(img)) + call pargr (north[1]) + call pargr (north[2]) + call pargr (east[1]) + call pargr (east[2]) + if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) + call pargi (1) # transposed image + else + call pargi (0) + if (IMG_MW(img) != NULL) + call pargstr ("E N") + else + call pargstr ("X Y") + + call wcspix_message (Memc[buf]) + + call sfree (sp) +end + + +# IMG_CVECTORS -- Get north and east vectors for the compass + +procedure img_cvectors (cd, length, north, east) + +double cd[2,2] #i CD matrix +real length #i length of vectors +real north[2] #o vector pointing north +real east[2] #o vector pointing east + +double d # determinant of CD matrix +double x, y # scratch for vector components +double l # length of a vector + +begin + d = cd[1,1] * cd[2,2] - cd[1,2] * cd[2,1] + if (d == 0.d0) + call error (1, "CD matrix is singular") + + # North. + x = -cd[1,2] / d + y = cd[1,1] / d + + # Normalize by the length and copy to output. + l = sqrt (x**2 + y**2) + north[1] = x * length / l + north[2] = y * length / l + + # East. + x = cd[2,2] / d + y = -cd[2,1] / d + l = sqrt (x**2 + y**2) + east[1] = x * length / l + east[2] = y * length / l +end + + +# IMG_SEND_WCSINFO -- Send information about the image WCS in a plain-english +# string. + +procedure img_send_wcsinfo (im, cp) + +pointer im #i image descriptor +pointer cp #i cache element pointer + +pointer sp, co, img, mw +pointer buf, proj, radecstr +int fd, radecsys, ctype, wtype, ndim +double crpix1, crpix2, crval1, crval2, cval1, cval2 +double xscale, yscale, xrot, yrot +double r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM], + +int idxstr(), sk_stati(), stropen(), mw_stati() +double sk_statd(), sl_epj(), sl_epb() +bool fp_equald() + +errchk stropen + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call salloc (proj, SZ_FNAME, TY_CHAR) + call salloc (radecstr, SZ_FNAME, TY_CHAR) + + # Open a string on a file. + fd = stropen (Memc[buf], SZ_LINE, WRITE_ONLY) + + # Get the data pointer. + img = C_DATA(cp) + + # Get the coordinate transform descriptor. + co = IMG_CO(img) + radecsys = sk_stati (co, S_RADECSYS) + ctype = sk_stati (co, S_CTYPE) + wtype = sk_stati (co, S_WTYPE) + + mw = IMG_MW(img) + if (mw != NULL) { + # Now get the mwcs Rterm (CRPIXi), Wterm (CRVALi), and CD matrix. + ndim = mw_stati (mw, MW_NPHYSDIM) + call wcs_gfterm (mw, r, w, cd, ndim) + crpix1 = r[1] + crpix2 = r[2] + crval1 = w[1] + crval2 = w[2] + + xscale = sqrt (cd[1,1]**2 + cd[2,1]**2) * 3600.0d0 + yscale = sqrt (cd[1,2]**2 + cd[2,2]**2) * 3600.0d0 + xrot = 0.0 + yrot = 0.0 + if (!fp_equald (cd[1,1], 0.0d0)) + xrot = DRADTODEG(atan ( cd[2,1] / cd[1,1])) + if (!fp_equald (cd[2,2], 0.0d0)) + yrot = DRADTODEG(atan (-cd[1,2] / cd[2,2])) + } else { + ndim = 2 + xscale = 1.0 + yscale = 1.0 + xrot = 0.0 + yrot = 0.0 + } + + if (IMG_DEBUG) { + call printf("WCS Info:\n=========\n") + call printf("R term: %g %g\n"); call pargd(r[1]); call pargd(r[2]) + call printf("W term: %g %g\n"); call pargd(w[1]); call pargd(w[2]) + call printf(" cd: %g %g\n %g %g\n") + call pargd(cd[1,1]); call pargd(cd[1,2]) + call pargd(cd[2,1]); call pargd(cd[2,2]) + call printf(" scale: %g %g\n");call pargd(xscale);call pargd(yscale) + call printf(" rot: %g %g\n");call pargd(xrot);call pargd(yrot) + } + + IMG_SCALE(img) = (xscale + yscale) / 2.0d0 + #IMG_ROT(img) = (xrot + yrot) / 2.0d0 + IMG_ROT(img) = xrot + + + # Now format a WCS text panel such as + # + # Projection: TAN System: Equatorial FK5 + # Ra/Dec axes: 1/2 Dimensions: 512 x 512 + # + # Center Pos: RA: 13:29:52.856 Dec: +47:11:40.39 + # Reference Pos: RA: 13:29:52.856 Dec: +47:11:40.39 + # Ref pixel coord: X: 250.256 Y: 266.309 + # Plate Scale: 0.765194 Rot Angle: 1.02939 + # Equinox: J2000.000 Epoch: J1987.25775240 + # MJD: 46890.39406 + + # Get some preliminary values. + if (idxstr (radecsys, Memc[radecstr], SZ_FNAME, EQTYPE_LIST) <= 0) + call strcpy ("FK5", Memc[radecstr], SZ_FNAME) + call strupr (Memc[radecstr]) + + if (idxstr (wtype, Memc[proj], SZ_FNAME, WTYPE_LIST) <= 0) + call strcpy ("logical", Memc[proj], SZ_FNAME) + call strupr (Memc[proj]) + + call fprintf (fd, "wcsinfo {\n") + + call fprintf (fd, + " Projection: %-6s\t System: %s %s\n") + call pargstr (Memc[proj]) + switch (ctype) { + case CTYPE_EQUATORIAL: + call pargstr ("Equatorial") + call pargstr (Memc[radecstr]) + case CTYPE_ECLIPTIC: + call pargstr ("Ecliptic") + call pargstr ("") + case CTYPE_GALACTIC: + call pargstr ("Galactic") + call pargstr ("") + case CTYPE_SUPERGALACTIC: + call pargstr ("SuperGalactic") + call pargstr ("") + default: + call pargstr ("Linear") + call pargstr ("") + } + + call fprintf (fd, " Ra/Dec axes: %d/%d") + call pargi (sk_stati (co, S_PLNGAX)) + call pargi (sk_stati (co, S_PLATAX)) + call fprintf (fd, " Dimensions: %d x %d\n\n") + call pargi (IM_LEN(im,1)) + call pargi (IM_LEN(im,2)) + + call fprintf (fd, + " Center Pos: %3s: %-12H %3s: %-12h\n") + if (ctype == CTYPE_EQUATORIAL) + call pargstr (" RA") + else + call pargstr ("Lon") + call pargd (cval1) + if (ctype == CTYPE_EQUATORIAL) + call pargstr ("Dec") + else + call pargstr ("Lat") + call pargd (cval2) + + call fprintf (fd, + " Reference Pos: %3s: %-12H %3s: %-12h\n") + if (ctype == CTYPE_EQUATORIAL) + call pargstr (" RA") + else + call pargstr ("Lon") + call pargd (crval1) + if (ctype == CTYPE_EQUATORIAL) + call pargstr ("Dec") + else + call pargstr ("Lat") + call pargd (crval2) + + call fprintf (fd, + " Reference Pixel: X: %-9.4f Y: %-9.4f\n") + call pargd (crpix1) + call pargd (crpix2) + + call fprintf (fd, + " Plate Scale: %-8f Rot Angle: %-8f\n") + call pargr (IMG_SCALE(img)) + call pargr (IMG_ROT(img)) + + call fprintf (fd, + " Equinox: %s%8f Epoch: %s%.6f\n") + switch (radecsys) { + case EQTYPE_FK5, EQTYPE_ICRS: + call pargstr ("J") ; call pargd (sk_statd(co,S_EQUINOX)) + call pargstr ("J") ; call pargd (sl_epj(sk_statd(co,S_EPOCH))) + default: + if (IMG_LINEAR(img) == YES) { + call pargstr (" ") ; call pargd (INDEFD) + call pargstr (" ") ; call pargd (INDEFD) + } else { + call pargstr ("B") + call pargd (sk_statd(co,S_EQUINOX)) + call pargstr ("B") + call pargd (sl_epb(sk_statd(co,S_EPOCH))) + } + } + + call fprintf (fd, " MJD: %.6f\n") + call pargd (sk_statd(co,S_EPOCH)) + + call fprintf (fd, "}\n \n \n") + + # Close the formatted string and send the message. + call close (fd) + call wcspix_message (Memc[buf]) + + call sfree (sp) +end + + +# IMG_SEND_PIXTAB -- Send a 'pixtab' message. Format of the message is +# +# pixtab { +# { {pix} {pix} ... } # pixel table values +# { {x1} {x2} ... } # column label values +# { {y1} {y2} ... } # row label values +# { <mean> <stdev> } # pixtab statistics +# } +# + +procedure img_send_pixtab (pixtab, size, x1, x2, y1, y2) + +real pixtab[ARB] #i pixtab array +int size #i pixtab size +int x1, x2, y1, y2 #i raster boundaries + +pointer sp, buf, el +int i, j, npix +real pix, sum, sum2, mean, var, stdev, x, y + +define SZ_PIXTAB (6*SZ_LINE) + +begin + call smark (sp) + call salloc (buf, SZ_PIXTAB, TY_CHAR) + call salloc (el, SZ_FNAME, TY_CHAR) + + # Begin the pixtab message. + call strcpy ("pixtab {\n{\ntable {\n", Memc[buf], SZ_PIXTAB) + + # Format the pixels into a table for presentation. Do the y-flip + # here so the pixels are in order for the List widget in the GUI. + # Accumulate the pixel statistics so we don't have to do it in the + # GUI where it's slower. + + sum = 0.0 + sum2 = 0.0 + npix = size * size + + for (i=size - 1; i >= 0; i=i-1) { + for (j=1; j <= size; j=j+1) { + pix = pixtab[(i * size) + j] + sum = sum + pix + sum2 = sum2 + (pix * pix) + + call sprintf (Memc[el], SZ_FNAME, " {%10.1f}") + call pargr (pix) + + call strcat (Memc[el], Memc[buf], SZ_PIXTAB) + } + call strcat ("\n", Memc[buf], SZ_PIXTAB) + } + call strcat ("}\n}\n", Memc[buf], SZ_PIXTAB) + + + # Do the row and column label parts of the message. + call strcat ("{", Memc[buf], SZ_PIXTAB) + for (x = x1; x <= x2; x = x + 1.) { + call sprintf (Memc[el], SZ_FNAME, " {%10.1f}") + call pargr (x) + call strcat (Memc[el], Memc[buf], SZ_PIXTAB) + } + call strcat ("}\n", Memc[buf], SZ_PIXTAB) + + call strcat ("{", Memc[buf], SZ_PIXTAB) + for (y = y2; y >= y1; y = y - 1.) { + call sprintf (Memc[el], SZ_FNAME, " {%10.1f}") + call pargr (y) + call strcat (Memc[el], Memc[buf], SZ_PIXTAB) + } + call strcat ("}\n", Memc[buf], SZ_PIXTAB) + + + # Compute the statistics for the raster. + mean = sum / real(npix) + var = (sum2 - sum * mean) / real(npix - 1) + if (var <= 0) + stdev = 0.0 + else + stdev = sqrt (var) + + call sprintf (Memc[el], SZ_FNAME, " { %10.2f %10.4f }\n") + call pargr (mean) + call pargr (stdev) + call strcat (Memc[el], Memc[buf], SZ_PIXTAB) + + + # Close the message. + call strcat ("}", Memc[buf], SZ_PIXTAB) + + if (IMG_DEBUG) { + call eprintf ("pixtab: %s\n");call pargstr(Memc[buf]) + } + + # Send the formatted message. + call wcspix_message (Memc[buf]) + + call sfree (sp) +end + + +# IMG_AMP_WCS -- Create a WCS transformation for the amplifier coordinates. + +pointer procedure img_amp_wcs (im, mw) + +pointer im #i image pointer +pointer mw #i MWCS descriptor + +pointer ct +double r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM] + +double imgetd() +pointer mw_sctran() + +begin + r[1] = 0.0d0 + r[2] = 0.0d0 + w[1] = imgetd (im, "ATV1") + w[2] = imgetd (im, "ATV2") + cd[1,1] = imgetd (im, "ATM1_1") + cd[1,2] = 0.0d0 + cd[2,1] = 0.0d0 + cd[2,2] = imgetd (im, "ATM2_2") + + # Create a new named system. + call mw_newsystem (mw, "amplifier", 2) + + # Set the new Wterm for the system. + call mw_swtermd (mw, r, w, cd, 2) + + # Set up the transform. + ct = mw_sctran (mw, "logical", "amplifier", 03B) + + # Reset the default world system. + call mw_sdefwcs (mw) + + return (ct) +end + + +# IMG_DET_WCS -- Create a WCS transformation for the detector coordinates. + +pointer procedure img_det_wcs (im, mw) + +pointer im #i image pointer +pointer mw #i MWCS descriptor + +pointer ct +double r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM] + +double imgetd() +pointer mw_sctran() + +begin + r[1] = 0.0d0 + r[2] = 0.0d0 + w[1] = imgetd (im, "DTV1") + w[2] = imgetd (im, "DTV2") + cd[1,1] = imgetd (im, "DTM1_1") + cd[1,2] = 0.0d0 + cd[2,1] = 0.0d0 + cd[2,2] = imgetd (im, "DTM2_2") + + # Create a new named system. + call mw_newsystem (mw, "detector", 2) + + # Set the new Wterm for the system. + call mw_swtermd (mw, r, w, cd, 2) + + # Set up the transform. + ct = mw_sctran (mw, "logical", "detector", 03B) + + # Reset the default world system. + call mw_sdefwcs (mw) + + return (ct) +end + + +# IMG_COORD_LABELS -- Get the WCS name, coord labels and format strings for +# the specified object. + +procedure img_coord_labels (cp, line, wcsname, xunits, yunits) + +pointer cp #i cache pointer +pointer line #i WCS output line +char wcsname[ARB] #o WCS name string +char xunits[ARB], yunits[ARB] #o WCS coord labels + +pointer img, co, wp +pointer sp, proj, radecstr + +int strcmp(), sk_stati(), idxstr() + +begin + img = C_DATA(cp) # initialize ptrs + co = IMG_CO(img) + wp = IMG_WP(img) + + if (SYSTEMS(wp,line) == SYS_WORLD) { + switch (sk_stati(co,S_CTYPE)) { + case CTYPE_EQUATORIAL: + call strcpy (" RA", xunits, LEN_WCSNAME) + call strcpy (" Dec", yunits, LEN_WCSNAME) + case CTYPE_ECLIPTIC: + call strcpy ("ELon", xunits, LEN_WCSNAME) + call strcpy ("ELat", yunits, LEN_WCSNAME) + case CTYPE_GALACTIC: + call strcpy ("GLon", xunits, LEN_WCSNAME) + call strcpy ("GLat", yunits, LEN_WCSNAME) + case CTYPE_SUPERGALACTIC: + call strcpy ("SLon", xunits, LEN_WCSNAME) + call strcpy ("SLat", yunits, LEN_WCSNAME) + } + } else if (SYSTEMS(wp,line) == SYS_SKY) { + call strcpy (WCSNAME(wp,line), wcsname, LEN_WCSNAME) + call strlwr (wcsname) + if (strcmp (wcsname,"ecliptic") == 0) { + call strcpy ("ELon", xunits, LEN_WCSNAME) + call strcpy ("ELat", yunits, LEN_WCSNAME) + } else if (strcmp (wcsname,"galactic") == 0) { + call strcpy ("GLon", xunits, LEN_WCSNAME) + call strcpy ("GLat", yunits, LEN_WCSNAME) + } else if (strcmp (wcsname,"supergalactic") == 0) { + call strcpy ("SLon", xunits, LEN_WCSNAME) + call strcpy ("SLat", yunits, LEN_WCSNAME) + } else { + call strcpy (" RA", xunits, LEN_WCSNAME) + call strcpy (" Dec", yunits, LEN_WCSNAME) + } + } else { + call strcpy ("X", xunits, LEN_WCSNAME) + call strcpy ("Y", yunits, LEN_WCSNAME) + } + + + # Now get the format strings. For systems other than the image + # default just use the WCS string as the name, otherwise format a + # string giving more information about the system. + if (SYSTEMS(wp,line) != SYS_WORLD) + call strcpy (WCSNAME(wp,line), wcsname, LEN_WCSNAME) + + else { + call smark (sp) + call salloc (radecstr, SZ_FNAME, TY_CHAR) + call salloc (proj, SZ_FNAME, TY_CHAR) + + call sprintf (wcsname, LEN_WCSNAME, "%s-%s-%s") + + switch (sk_stati(co,S_CTYPE)) { + case CTYPE_EQUATORIAL: call pargstr ("EQ") + case CTYPE_ECLIPTIC: call pargstr ("ECL") + case CTYPE_GALACTIC: call pargstr ("GAL") + case CTYPE_SUPERGALACTIC: call pargstr ("SGAL") + default: call pargstr ("UNKN") + } + + if (sk_stati(co,S_CTYPE) == CTYPE_EQUATORIAL) { + if (idxstr(sk_stati(co,S_RADECSYS), Memc[radecstr], + SZ_FNAME, EQTYPE_LIST) <= 0) + call strcpy ("FK5", Memc[radecstr], SZ_FNAME) + call strupr (Memc[radecstr]) + call pargstr (Memc[radecstr]) + } else { + if (sk_stati(co,S_CTYPE) == CTYPE_SUPERGALACTIC) + call pargstr ("-") + else + call pargstr ("--") + } + + if (idxstr(sk_stati(co,S_WTYPE), Memc[proj], SZ_FNAME, + WTYPE_LIST) <= 0) + call strcpy ("linear", Memc[proj], SZ_FNAME) + call strupr (Memc[proj]) + call pargstr (Memc[proj]) + + call sfree (sp) + } + + # Now fix up the WCS system name. + if (strcmp (wcsname, "fk4") == 0 || + strcmp (wcsname, "fk5") == 0 || + strcmp (wcsname, "icrs") == 0 || + strcmp (wcsname, "gappt") == 0 || + strcmp (wcsname, "fk4-no-e") == 0) { + call strupr (wcsname) + + } else if (IS_LOWER(wcsname[1])) + wcsname[1] = TO_UPPER(wcsname[1]) +end + + +# IMG_COORD_FMT -- Format the coordinate strings. + +procedure img_coord_fmt (cp, line, xval, yval, xc, yc) + +pointer cp #i object cache pointer +int line #i output line number +double xval, yval #i input coords +char xc[ARB], yc[ARB] #o formatted coord strings + +pointer img, co, wp +char xfmt[LEN_WCSNAME], yfmt[LEN_WCSNAME] +int ctype + +int sk_stati() +bool streq() + +begin + img = C_DATA(cp) # initialize ptrs + co = IMG_CO(img) + wp = IMG_WP(img) + + + ctype = sk_stati (co, S_CTYPE) + + # Convert coords to the requested format. + if (FORMATS(wp,line) == FMT_DEFAULT) { + if (IMG_MW(img) == NULL) { + call strcpy ("%10.2f", xfmt, LEN_WCSNAME) + call strcpy ("%10.2f", yfmt, LEN_WCSNAME) + } else { + if (SYSTEMS(wp,line) == SYS_WORLD || + SYSTEMS(wp,line) == SYS_SKY) { + + if (streq(WCSNAME(wp,line),"ecliptic") || + streq(WCSNAME(wp,line),"galactic") || + streq(WCSNAME(wp,line),"supergalactic")) + call strcpy ("%h", xfmt, LEN_WCSNAME) + else { + if (sk_stati(co, S_CTYPE) == CTYPE_EQUATORIAL) + call strcpy ("%.2H", xfmt, LEN_WCSNAME) + else + call strcpy ("%.2h", xfmt, LEN_WCSNAME) + } + call strcpy ("%.1h", yfmt, LEN_WCSNAME) + } else { + call strcpy ("%10.2f", xfmt, LEN_WCSNAME) + call strcpy ("%10.2f", yfmt, LEN_WCSNAME) + } + } + + } else if (FORMATS(wp,line) == FMT_HMS) { + if (sk_stati(co, S_CTYPE) == CTYPE_EQUATORIAL) + call strcpy ("%.2H", xfmt, LEN_WCSNAME) + else + call strcpy ("%.1h", xfmt, LEN_WCSNAME) + call strcpy ("%h", yfmt, LEN_WCSNAME) + } else { + call strcpy ("%10.2f", xfmt, LEN_WCSNAME) + call strcpy ("%10.2f", yfmt, LEN_WCSNAME) + } + + # Convert the value to the requested format + call sprintf (xc, LEN_WCSNAME, xfmt) + if (FORMATS(wp,line) != FMT_RAD) + call pargd (xval) + else + call pargd (DEGTORAD(xval)) + + call sprintf (yc, LEN_WCSNAME, yfmt) + if (FORMATS(wp,line) != FMT_RAD) + call pargd (yval) + else + call pargd (DEGTORAD(yval)) +end + + +# IMG_GET_COORD -- Given an x,y position in the image return the coordinate in +# the given system. + +procedure img_get_coord (img, x, y, system, wcsname, wx, wy) + +pointer img #i IMG struct pointer +double x, y #i input image position +int system #i coordinate system requested +char wcsname[ARB] #i desired WCS name +double wx, wy #o output coordinates + +double ox, oy, tmp +real epoch +pointer im, co, nco +char buf[SZ_LINE] +int stat + +real imgetr() +int imaccf(), sk_stati(), sk_decwstr() +bool streq() + +errchk imgetr + +begin + im = IMG_IM(img) + co = IMG_CO(img) + + wx = x # fallback values + wy = y + + switch (system) { + case SYS_NONE: + wx = x + wy = y + case SYS_DISPLAY: + call img_ltov (im, x, y, wx, wy) + #wx = x + #wy = y + case SYS_PHYSICAL: + if (IMG_CTP(img) != NULL) + call mw_c2trand (IMG_CTP(img), x, y, wx, wy) + case SYS_WORLD: + if (IMG_CTW(img) != NULL) { + call mw_c2trand (IMG_CTW(img), x, y, wx, wy) + + # Check for transposed image. + if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) { + tmp = wx + wx = wy + wy = tmp + } + } + case SYS_AMP: + if (IMG_CTA(img) != NULL) + call mw_c2trand (IMG_CTA(img), x, y, wx, wy) + case SYS_CCD: + if (IMG_CTD(img) != NULL) + call mw_c2trand (IMG_CTD(img), x, y, wx, wy) + case SYS_DETECTOR: + if (IMG_CTD(img) != NULL) + call mw_c2trand (IMG_CTD(img), x, y, wx, wy) + case SYS_SKY: + # Note Ecliptic/GAPPT coords need an epoch value. + if (imaccf (im, "EPOCH") == YES) { + epoch = imgetr (im, "EPOCH") + if (epoch == 0.0 || IS_INDEFR(epoch)) + epoch = 1950.0 + } else + epoch = 1950.0 + + if (streq (wcsname, "ecliptic") || streq (wcsname, "gappt")) { + call sprintf (buf, SZ_LINE, "%s %.1f") + if (streq (wcsname, "gappt")) + call pargstr ("apparent") + else + call pargstr (wcsname) + call pargr (epoch) + } else { + call sprintf (buf, SZ_LINE, "%s") + if (streq(wcsname,"gappt")) + call pargstr ("apparent") + else if (streq(wcsname,"fk4-no-e")) + call pargstr ("noefk4") + else + call pargstr (wcsname) + } + + stat = sk_decwstr (buf, nco, co) + if (stat != ERR) { + if (IMG_CTW(img) != NULL) + call mw_c2trand (IMG_CTW(img), x, y, ox, oy) + call sk_lltran (co, nco, DEGTORAD(ox), DEGTORAD(oy), + INDEFD, INDEFD, 0.0d0, 0.0d0, wx, wy) + if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) { + wx = RADTODEG(wy) # transposed image + wy = RADTODEG(wx) + } else { + wx = RADTODEG(wx) # regular image + wy = RADTODEG(wy) + } + } else { + wx = x + wy = y + } + case SYS_OTHER: + ; # TBD + + default: # default coords + wx = x + wy = y + } +end + + +# IMG_LTOV -- Convert coordinate from the logical coordinate system to the +# output coordinate system. + +procedure img_ltov (im, xin, yin, xout, yout) + +pointer im # the input image descriptor +double xin # the input x coordinate +double yin # the input y coordinate +double xout # the output x coordinate +double yout # the output y coordinate + +int index1, index2 + +begin + index1 = IM_VMAP(im,1) + index2 = IM_VMAP(im,2) + + xout = xin * IM_VSTEP(im,index1) + IM_VOFF(im,index1) + yout = yin * IM_VSTEP(im,index2) + IM_VOFF(im,index2) +end + + +# IMG_VTOL -- Convert coordinate from the tv coordinate system to the +# logical coordinate system. + +procedure img_vtol (im, xin, yin, xout, yout) + +pointer im # the input image descriptor +double xin # the input x coordinate +double yin # the input y coordinate +double xout # the output x coordinate +double yout # the output y coordinate + +int index1, index2 + +begin + index1 = IM_VMAP(im,1) + index2 = IM_VMAP(im,2) + + xout = (xin - IM_VOFF(im,index1)) / IM_VSTEP(im,index1) + yout = (yin - IM_VOFF(im,index2)) / IM_VSTEP(im,index2) +end diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x.bak b/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x.bak new file mode 100644 index 00000000..87a12a39 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/wcimage.x.bak @@ -0,0 +1,1515 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <math.h> +include <imio.h> +include <imhdr.h> +include <time.h> +include <ctype.h> +include <mwset.h> +include <pkg/skywcs.h> +include "wcspix.h" + + +# Image class data. +define LEN_IMGDATA 15 +define IMG_WP Memi[$1 ] # wcspix back-pointer +define IMG_IM Memi[$1+1] # image pointer +define IMG_BPM Memi[$1+2] # bad pixel mask pointer +define IMG_MW Memi[$1+3] # image wcs pointer +define IMG_CO Memi[$1+4] # skywcs transform pointer +define IMG_CTW Memi[$1+5] # mwcs log->world transform ptr +define IMG_CTP Memi[$1+6] # mwcs log->phys transform ptr +define IMG_CTA Memi[$1+7] # mwcs log->amplifier transform +define IMG_CTD Memi[$1+8] # mwcs log->detector transform +define IMG_ROT Memr[$1+9] # rotation angle +define IMG_SCALE Memr[$1+10] # plate scale +define IMG_LINEAR Memi[$1+11] # linear coords + + +define IMG_DEBUG FALSE + + +# IMG_INIT -- Initialize the object structure. + +procedure img_init (cp, wp) + +pointer cp #i cache pointer +pointer wp #i WCSPIX structure + +pointer img # data pointer + +begin + if (IMG_DEBUG) call printf ("img_init: \n") + + # Allocate the image data structure if not previously allocated. + if (C_DATA(cp) == NULL) { + iferr (call calloc (C_DATA(cp), LEN_IMGDATA, TY_STRUCT)) + return + } + + img = C_DATA(cp) + IMG_WP(img) = wp + IMG_IM(img) = NULL + IMG_BPM(img) = NULL + IMG_MW(img) = NULL + IMG_CO(img) = NULL + IMG_CTW(img) = NULL + IMG_CTP(img) = NULL + IMG_CTA(img) = NULL + IMG_CTD(img) = NULL + IMG_ROT(img) = 0.0 + IMG_SCALE(img) = 0.0 + IMG_LINEAR(img) = YES +end + + +# IMG_CACHE -- Cache an image in the object cache. + +procedure img_cache (cp, objid, regid, ref) + +pointer cp #i cache pointer +int objid #i object id +int regid #i region id +char ref[ARB] #i object reference + +pointer img, im, wp, co +int stat, i1, i2 +char alert[SZ_LINE] + +pointer immap(), ds_pmmap(), mw_sctran() +pointer img_amp_wcs(), img_det_wcs() +int imaccf(), sk_decim() + +errchk immap, ds_pmmap, mw_sctran, sk_decim, sk_setd + +begin + if (IMG_DEBUG) call printf ("img_cache: \n") + + # Now map the image and WCS. + img = C_DATA(cp) + wp = IMG_WP(img) + + iferr (IMG_IM(img) = immap (ref, READ_ONLY, 0)) { + # Send alert to the GUI. + call sprintf (alert, SZ_FNAME, "Unable to cache\n%s") + call pargstr (ref) + call ism_alert (alert, "", "") + return + } + im = IMG_IM(img) + + IMG_CO(img) = NULL + IMG_CTW(img) = NULL + IMG_CTP(img) = NULL + IMG_CTA(img) = NULL + IMG_CTD(img) = NULL + iferr { + stat = sk_decim (IMG_IM(img), "world", IMG_MW(img), IMG_CO(img)) + if (IMG_DEBUG) { + call eprintf ("img_cache - decim: stat=%d mw=%d co=%d \n") + call pargi(stat);call pargi(IMG_MW(img)) + call pargi(IMG_CO(img)); + } + if (stat == ERR || IMG_MW(img) == NULL) { + IMG_LINEAR(img) = YES + + co = IMG_CO(img) + i1 = IM_VMAP(im,1) + i2 = IM_VMAP(im,2) + call sk_setd (co, S_VXOFF, double(IM_VOFF(im,i1))) + call sk_setd (co, S_VYOFF, double(IM_VOFF(im,i2))) + call sk_setd (co, S_VXSTEP, double(IM_VSTEP(im,i1))) + call sk_setd (co, S_VYSTEP, double(IM_VSTEP(im,i2))) + + IMG_MW(img) = NULL + IMG_LINEAR(img) = YES + } + + if (IMG_MW(img) != NULL) { + IMG_CTW(img) = mw_sctran (IMG_MW(img), "logical", "world", 03B) + IMG_CTP(img) = mw_sctran (IMG_MW(img), "logical", "physical", + 03B) + + # Get the amplifier transformation values if present. + if (imaccf(im,"ATM1_1") == YES && + imaccf(im,"ATM2_2") == YES && + imaccf(im,"ATV1") == YES && + imaccf(im,"ATV2") == YES) + IMG_CTA(img) = img_amp_wcs (im, IMG_MW(img)) + + if (imaccf(im,"DTM1_1") == YES && + imaccf(im,"DTM2_2") == YES && + imaccf(im,"DTV1") == YES && + imaccf(im,"DTV2") == YES) + IMG_CTD(img) = img_det_wcs (im, IMG_MW(img)) + } + + } then { + # Send alert to the GUI. + call sprintf (alert, SZ_FNAME, "Unable to decode image WCS\n%s") + call pargstr (ref) + call ism_alert (alert, "", "") + IMG_LINEAR(img) = YES + } + + + # See if we can find a bad pixel mask. + IMG_BPM(img) = NULL + if (WP_BPM(wp) == YES) { + iferr (IMG_BPM(img) = ds_pmmap ("BPM", IMG_IM(img))) + IMG_BPM(img) = NULL + } + + C_OBJID(cp) = objid + C_REGID(cp) = regid + C_NREF(cp) = C_NREF(cp) + 1 + call strcpy (ref, C_REF(cp), 128) +end + + +# IMG_UNCACHE -- Uncache an image in the object cache. + +procedure img_uncache (cp, id) + +pointer cp #i cache pointer +int id #i image id + +pointer img + +begin + if (IMG_DEBUG) call printf ("img_uncache: \n") + + C_OBJID(cp) = NULL + C_NREF(cp) = 0 + call strcpy ("", C_REF(cp), SZ_FNAME) + + img = C_DATA(cp) + if (IMG_MW(img) != NULL) + call mw_close (IMG_MW(img)) + if (IMG_BPM(img) != NULL) + call imunmap (IMG_BPM(img)) + if (IMG_IM(img) != NULL) + call imunmap (IMG_IM(img)) + + IMG_IM(img) = NULL + IMG_BPM(img) = NULL + IMG_MW(img) = NULL + IMG_CTW(img) = NULL + IMG_CTP(img) = NULL + IMG_CTA(img) = NULL + IMG_CTD(img) = NULL + IMG_CO(img) = NULL + IMG_ROT(img) = 0.0 + IMG_SCALE(img) = 0.0 + IMG_LINEAR(img) = NO + + call mfree (C_DATA(cp), TY_STRUCT) + C_DATA(cp) = NULL +end + + +# IMG_WCSTRAN -- Translate object source (x,y) coordinates to the +# desired output WCSs. Message is returned as something like: +# +# set value { +# { object <objid> } { region <regionid> } +# { pixval <pixel_value> [<units>] } +# { bpm <bpm_pixel_value> } +# { coord <wcsname> <x> <y> [<xunits> <yunits>] } +# { coord <wcsname> <x> <y> [<xunits> <yunits>] } +# : +# } + + +procedure img_wcstran (cp, id, x, y) + +pointer cp #i cache pointer +int id #i image id +real x, y #i source coords + +pointer img, im, wp, co +double dx, dy, wx, wy +real rx, ry, pixval +int i, bpm + +# Use static storage to avoid allocation overhead. +char buf[SZ_LINE] +char msg[SZ_LINE], wcs[LEN_WCSNAME], xc[LEN_WCSNAME], yc[LEN_WCSNAME] +char xunits[LEN_WCSNAME], yunits[LEN_WCSNAME] + +double sk_statd() + +begin + if (IMG_DEBUG) call printf ("img_wcstran: \n") + + img = C_DATA(cp) # initialize + co = IMG_CO(img) + wp = IMG_WP(img) + im = IMG_IM(img) + + # Get the translation to the image section. + dx = (double(x) - sk_statd(co,S_VXOFF)) / sk_statd(co,S_VXSTEP) + dy = (double(y) - sk_statd(co,S_VYOFF)) / sk_statd(co,S_VYSTEP) + rx = dx + ry = dy + + # Read the pixel data. + call img_get_data (cp, id, rx, ry, pixval, bpm) + + # Begin formatting the message. + call aclrc (msg, SZ_LINE) + call sprintf (msg, SZ_LINE, "wcstran { object %d } { region %d } ") + call pargi (C_OBJID(cp)) + call pargi (C_REGID(cp)) + + call sprintf (buf, SZ_LINE, "{ pixval %9.9g } { bpm %d }\n") + call pargr (pixval) + call pargi (bpm) + call strcat (buf, msg, SZ_LINE) + + # Now loop over the requested systems and generate a coordinate + # for each. + for (i=1; i <= MAX_WCSLINES; i=i+1) { + + # Get the coordinate value. + call img_get_coord (img, dx, dy, SYSTEMS(wp,i), WCSNAME(wp,i), + wx, wy) + + # Get the system name, labels, and formats strings for the WCS. + call img_coord_labels (cp, i, wcs, xunits, yunits) + + # Format the values as requested. + call img_coord_fmt (cp, i, wx, wy, xc, yc) + + # Format the coord buffer and append it to the message. + call sprintf (buf, SZ_LINE, + "{coord {%9s} {%12s} {%12s} {%4s} {%4s}}\n") + call pargstr (wcs) + call pargstr (xc) + call pargstr (yc) + call pargstr (xunits) + call pargstr (yunits) + call strcat (buf, msg, SZ_LINE) + } + + # Now send the completed message. + call wcspix_message (msg); +end + + +# IMG_WCSLIST -- List the WCSs available for the given image. + +procedure img_wcslist (cp, id) + +pointer cp #i cache pointer +int id #i image id + +pointer img, im, mw +char msg[SZ_LINE] + +begin + if (IMG_DEBUG) call printf ("img_wcslist: \n") + + img = C_DATA(cp) # initialize + mw = IMG_MW(img) + im = IMG_IM(img) + + call strcpy ("wcslist {None Display Logical World Physical line ", + msg, SZ_LINE) + + # See if we can do amplifier/detector coords by checking for ATM/ATV + # and DTM/DTV keywords. + + if (IMG_CTA(img) != NULL) + call strcat (" Amplifier ", msg, SZ_LINE) + if (IMG_CTD(img) != NULL) + call strcat (" Detector ", msg, SZ_LINE) + if (IMG_CTA(img) != NULL || IMG_CTD(img) != NULL) + call strcat (" CCD ", msg, SZ_LINE) + + # If we have a MWCS pointer list the sky projections. + if (mw != NULL) { + call strcat (" line ", msg, SZ_LINE) + call strcat (SKYPROJ, msg, SZ_LINE) + } + + # Close the message. + call strcat ("}", msg, SZ_LINE) + + call wcspix_message (msg) +end + + +# IMG_GET_DATA -- Get data from the image. + +procedure img_get_data (cp, id, x, y, pixval, bpm_pix) + +pointer cp #i cache pointer +int id #i image id +real x, y #i source coords +real pixval #o central pixel value +int bpm_pix #o bad pixel mask value + +pointer img, wp, im, bpm, pix, sp, msg, buf +int nl, nc, ix, iy, s2 +int size, x1, x2, y1, y2 + +long clktime() +pointer imgs2r(), imgs2i(), ds_pmmap() +errchk ds_pmmap + +begin + + img = C_DATA(cp) + wp = IMG_WP(img) + im = IMG_IM(img) + bpm = IMG_BPM(img) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) +# size = WP_PTABSZ(wp) + size = min(min(nc,nl),WP_PTABSZ(wp)) + + if (IMG_DEBUG) { + call printf ("img_get_data: \n") + call eprintf ("\tx: %g y: %g nc: %d nl: %d\n") + call pargr(x); call pargr(y); call pargi(nc); call pargi(nl) + } + + # Sanity check on the cursor image position. + if (x < 0.0 || y < 0.0 || x > (nc+0.5) || y > (nl+0.5)) + return + + # Bounds checking. Rather than deal with out of bounds pixels we'll + # adjust the center pixel so we get the same size raster up to each + # boundary. + + ix = int (x + 0.5) ; iy = int (y + 0.5) + ix = min (ix, (nc-(size/2)-1)) ; iy = min (iy, (nl-(size/2)-1)) + ix = max (size/2+1, ix) ; iy = max (size/2+1, iy) + + # Compute the box offset given the center and size. + x1 = ix - size / 2 + 0.5 + x2 = ix + size / 2 + 0.5 + y1 = iy - size / 2 + 0.5 + y2 = iy + size / 2 + 0.5 + + if (IMG_DEBUG) { + call printf ("img_get_data: \n") + call eprintf ("\tix: %d iy: %g size: %d\n") + call pargi(ix); call pargi(iy); call pargi(size) + call eprintf ("\tx1: %d y1: %d x2: %d y2: %d\n") + call pargi(x1); call pargi(y1); + call pargi(x2); call pargi(y2); + } + + x1 = max (1, x1) + x2 = min (nc, x2) + y1 = max (1, y1) + y2 = min (nl, y2) + + if (IMG_DEBUG) { + call eprintf ("\tx1: %d y1: %d x2: %d y2: %d\n") + call pargi(x1); call pargi(y1); + call pargi(x2); call pargi(y2); + } + + # Get the image pixels + pix = imgs2r (im, int(x1), int(x2), int(y1), int(y2)) + + if (WP_BPM(wp) == YES) { + if (bpm != NULL) { + bpm_pix = Memi[imgs2i (bpm, ix, ix, iy, iy)] + } else { + # See if we can find a bad pixel mask. The option is enabled + # but we haven't mappend the mask yet. + + # Log the event. + call smark (sp) + call salloc (msg, SZ_LINE, TY_CHAR) + call salloc (buf, SZ_LINE, TY_CHAR) + call wp_cnvdate (clktime(0), Memc[buf], SZ_DATE) + call sprintf (Memc[msg], SZ_LINE, + "info { %s: WCSPIX BPM map objid=%3d %s}\n") + call pargstr (Memc[buf]) + call pargi (C_OBJID(cp)) + call pargstr (C_REF(cp)) + call ism_message ("ism_msg", Memc[msg]) + + iferr (IMG_BPM(img) = ds_pmmap ("BPM", im)) { + IMG_BPM(img) = NULL + bpm_pix = 0 + + # Send alert to the GUI. + call sprintf (Memc[buf], SZ_FNAME, + "Unable to map BPM image for\n%s") + call pargstr (C_REF(cp)) + call ism_alert (Memc[buf], "", "") + } else + bpm_pix = Memi[imgs2i (IMG_BPM(img), ix, ix, iy, iy)] + + call sfree (sp) + } + } else + bpm_pix = 0 + + # See if we're near an edge... + s2 = size / 2 + if (int(x)<s2 || int(x)>(nl-s2-1) || int(y)<s2 || int(x)>(nc-s2-1)) { + # Compute the image pixel associated with the requested coords. + ix = int (x + 0.5) + iy = int (y + 0.5) + pixval = Memr[imgs2r(im, ix, ix, iy, iy)] + } else { + pixval = Memr[pix + ((size/2)*size) + (size/2)] + } + + # Send the pixel table. + if (WP_PTABSZ(wp) > 1) + call img_send_pixtab (Memr[pix], WP_PTABSZ(wp), x1, x2, y1, y2) + + if (IMG_DEBUG) { + call printf ("img_get_data: pixval=%g\n") ; call pargr (pixval) + } +end + + +# IMG_OBJINFO -- Get header information from the image. + +procedure img_objinfo (cp, id, template) + +pointer cp #i cache pointer +int id #i image id +char template[ARB] #i keyword template + +pointer im, img + +define WCS_TEMPLATE "WCSDIM,CTYPE*,CRPIX*,CRVAL*,CD*,CROTA2,LTV*,LTM*,WSV*,WAT*,RA*,DEC*,EQUINOX,EPOCH,MJD*,DATE-OBS" + +begin + if (IMG_DEBUG) call printf ("img_objinfo: \n") + + # Send the full header (or keyword filtered header), only the WCS + # keywords, and a plain-text explanation of the WCS. + + img = C_DATA(cp) + im = IMG_IM(img) + + call img_send_header (im, "imghdr", template) + call img_send_header (im, "wcshdr", WCS_TEMPLATE) + call img_send_wcsinfo (im, cp) + call img_send_compass (im, cp) +end + + + +#============================================================================== + +# IMG_SEND_HEADER -- Send an image header to the named GUI object. Keywords +# are filtered according to a specified template + +procedure img_send_header (im, object, template) + +pointer im #i image descriptor +char object[ARB] #i object for the message +char template[ARB] #i keyword template + +pointer sp, hdr, lbuf, line, field, keyw, dict +pointer ip, lp, list +int nlines, in, out, i, hdr_size +bool keyw_filter + +int stropen(), getline(), stridx(), imgnfn(), strdic() +pointer imofnlu() +bool streq() +errchk stropen, getline, putci, putline, imgnfn, imofnlu, strdic + +define USER_AREA Memc[($1+IMU-1)*SZ_STRUCT + 1] +define SZ_KEYW 8 + +begin + hdr_size = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1 + hdr_size = hdr_size + SZ_LINE + + call smark (sp) + call salloc (hdr, hdr_size, TY_CHAR) + call salloc (dict, hdr_size, TY_CHAR) + call salloc (field, SZ_LINE, TY_CHAR) + call salloc (lbuf, SZ_LINE, TY_CHAR) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (keyw, SZ_KEYW, TY_CHAR) + + in = stropen (USER_AREA(im), hdr_size, READ_ONLY) + out = stropen (Memc[hdr], hdr_size, WRITE_ONLY) + call fprintf (out, "%s {") + call pargstr (object) + + # Build up a dictionary of header keywords based on the template. + keyw_filter = (!streq (template, "*")) + if (keyw_filter) { + list = imofnlu (im, template) + call strcpy ("|", Memc[dict], hdr_size) + while (imgnfn (list, Memc[field], SZ_FNAME) != EOF) { + call strcat (Memc[field], Memc[dict], hdr_size) + call strcat ("|", Memc[dict], hdr_size) + } + call imcfnl (list) + } + + + # Copy header records to the output, stripping any trailing + # whitespace and clipping at the right margin. We also filter + # against the keyword dictionary found above. + + nlines = 0 + while (getline (in, Memc[lbuf]) != EOF) { + + call aclrc (Memc[line], SZ_LINE) + + # Escape any brackets passed to the Tcl. + ip = lbuf + lp = line + while (Memc[ip] != EOS && Memc[ip] != '\n') { + if (stridx (Memc[ip], "[{") > 0) { + Memc[lp] = '\\' + lp = lp + 1 + } + Memc[lp] = Memc[ip] + ip = ip + 1 + lp = lp + 1 + } + Memc[lp] = '\n' + Memc[lp+1] = EOS + + # See whether the line matches a keyword we want to output. + if (keyw_filter) { + for (i=0; i < SZ_KEYW && !IS_WHITE(Memc[line+i]); i=i+1) + Memc[keyw+i] = Memc[line+i] + Memc[keyw+i] = '\0' + + # If not in the dictionary skip to the next line. + if (strdic (Memc[keyw], Memc[keyw], SZ_KEYW, Memc[dict]) == 0) + next + } + + call putci (out, ' ') + call putline (out, Memc[line]) + + # Send the header in small chunks so we don't overflow the + # message buffer. + nlines = nlines + 1 + if (mod(nlines,10) == 0) { + call fprintf (out, "}") + call close (out) + call wcspix_message (Memc[hdr]); + call aclrc (Memc[hdr], hdr_size) + out = stropen (Memc[hdr], hdr_size, WRITE_ONLY) + call fprintf (out, "%s {") + call pargstr (object) + } + } + call fprintf (out, "}") + + call close (in) + call close (out) + + # Send the final message. + call wcspix_message (Memc[hdr]) + + # Pad a few lines for the GUI + call sprintf (Memc[hdr], SZ_LINE, "%d { \n\n\n }") + call pargstr (object) + call wcspix_message (Memc[hdr]) + + call sfree (sp) +end + + +# IMG_SEND_COMPASS -- Send information about the image WCS in a plain-english +# string. + +procedure img_send_compass (im, cp) + +pointer im #i image descriptor +pointer cp #i cache element pointer + +pointer sp, buf, img, co, mw +double cx, cy, cx1, cy1, dx, dy, x1, y1 +double cosa, sina, angle +double r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM] +int i, j, comp_x, comp_y +long axis[IM_MAXDIM], lv[IM_MAXDIM], pv1[IM_MAXDIM], pv2[IM_MAXDIM] +bool fp_equalr() + +real length, north[2], east[2] + +int mw_stati(), sk_stati() + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call aclrc (Memc[buf], SZ_LINE) + + # Get the data pointer. + img = C_DATA(cp) + co = IMG_CO(img) + + # Get world coords at the image corners. + if (IMG_CTW(img) != NULL) { + + if (fp_equalr(IMG_ROT(img),0.0)) + angle = -IMG_ROT(img) + else if (IMG_ROT(img) > 0.0) + angle = -IMG_ROT(img) + else + angle = IMG_ROT(img) + 360.0 + cosa = cos (DEGTORAD(angle)) + sina = sin (DEGTORAD(angle)) +call eprintf ("compass: angle = %g sina=%g cosa=%g\n") +call pargd(angle); call pargd(sina); call pargd(cosa) + + # Image center position + cx = IM_LEN(im,1) / 2.0d0 + cy = IM_LEN(im,2) / 2.0d0 + call mw_c2trand (IMG_CTW(img), cx, cy, cx1, cy1) + + # Extend a unit vector up from the center assuming it's North + # and rotate it by the wcs angle. + dx = cx + ( 10.0 * sina) + dy = cy + ( 10.0 * cosa) + call mw_c2trand (IMG_CTW(img), dx, dy, x1, y1) + + # Check new point Y value relative to the center position. + if (y1 >= cy1) + comp_y = 1 # North is up + else + comp_y = -1 # North is down +call eprintf ("compass: y1=%g cy1=%g \n");call pargd(y1);call pargd(cy1) + + # Extend a unit vector left from the center assuming it's East + # and rotate it by the wcs angle. + dx = cx + (-10.0 * cosa) + dy = cy + ( 10.0 * sina) + call mw_c2trand (IMG_CTW(img), dx, dy, x1, y1) + + # Check new point X value relative to the center position. + if (x1 >= cx1) + comp_x = 1 # East is left and we have a WCS + else + comp_x = -1 # East is right +call eprintf ("compass: x1=%g cx1=%g \n");call pargd(x1);call pargd(cx1) + +#------------------------------ +# New compass algorithm +#------------------------------ + + # Get the CD matrix for the image. + mw = IMG_MW(img) + call wcs_gfterm (mw, r, w, cd, mw_stati(mw, MW_NPHYSDIM)) + call img_cvectors (cd, 1.0, north, east) + + if (y1 >= 0.0) + comp_y = 1 # North is up + else + comp_y = -1 # North is down + + if (x1 >= 0.0) + comp_x = 1 # East is left + else + comp_x = -1 # East is right + + } else { + # Determine the logical to physical mapping by evaluating two + # points and determining the axis reduction if any. pv1 will be + # the offset and pv2-pv1 will be the scale. + + lv[1] = 0; lv[2] = 0; call imaplv (im, lv, pv1, 2) + lv[1] = 1; lv[2] = 1; call imaplv (im, lv, pv2, 2) + + i = 1 + axis[1] = 1; axis[2] = 2 + do j = 1, IM_MAXDIM { + if (pv1[j] != pv2[j]) { + axis[i] = j + i = i + 1 + } + } + comp_x = - (pv2[axis[1]] - pv1[axis[1]]) + comp_y = (pv2[axis[2]] - pv1[axis[2]]) + } + + call sprintf (Memc[buf], SZ_LINE, "compass %d %g %d %d %d %s\0") + call pargi (C_OBJID(cp)) + call pargr (IMG_ROT(img)) + call pargi (comp_x) + call pargi (comp_y) + if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) + call pargi (1) # transposed image + else + call pargi (0) + if (IMG_MW(img) != NULL) + call pargstr ("E N") + else + call pargstr ("X Y") +call eprintf ("msg: '%s'\n");call pargstr(Memc[buf]) + + call wcspix_message (Memc[buf]) + call sfree (sp) +end + + +# IMG_CVECTORS -- Get north and east vectors for the compass + +procedure img_cvectors (cd, length, north, east) + +double cd[2,2] #i CD matrix +real length #i length of vectors +real north[2] #o vector pointing north +real east[2] #o vector pointing east + +double d # determinant of CD matrix +double x, y # scratch for vector components +double l # length of a vector + +begin + d = cd[1,1] * cd[2,2] - cd[1,2] * cd[2,1] + if (d == 0.d0) + call error (1, "CD matrix is singular") + + # North. + x = -cd[1,2] / d + y = cd[1,1] / d + + # Normalize by the length and copy to output. + l = sqrt (x**2 + y**2) + north[1] = x * length / l + north[2] = y * length / l + + # East. + x = cd[2,2] / d + y = -cd[2,1] / d + l = sqrt (x**2 + y**2) + east[1] = x * length / l + east[2] = y * length / l + +call eprintf ("new: north (%g,%g) east (%g,%g)\n") +call pargr(north[1]);call pargr(north[2]) +call pargr(east[1]) ;call pargr(east[2]) +end + + + +# IMG_SEND_WCSINFO -- Send information about the image WCS in a plain-english +# string. + +procedure img_send_wcsinfo (im, cp) + +pointer im #i image descriptor +pointer cp #i cache element pointer + +pointer sp, co, img, mw +pointer buf, proj, radecstr +int fd, radecsys, ctype, wtype, ndim +double crpix1, crpix2, crval1, crval2, cval1, cval2 +double xscale, yscale, xrot, yrot +double r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM], + +int idxstr(), sk_stati(), stropen(), mw_stati() +double sk_statd(), sl_epj(), sl_epb() +bool fp_equald() + +errchk stropen + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call salloc (proj, SZ_FNAME, TY_CHAR) + call salloc (radecstr, SZ_FNAME, TY_CHAR) + + # Open a string on a file. + fd = stropen (Memc[buf], SZ_LINE, WRITE_ONLY) + + # Get the data pointer. + img = C_DATA(cp) + + # Get the coordinate transform descriptor. + co = IMG_CO(img) + radecsys = sk_stati (co, S_RADECSYS) + ctype = sk_stati (co, S_CTYPE) + wtype = sk_stati (co, S_WTYPE) + + mw = IMG_MW(img) + if (mw != NULL) { + # Now get the mwcs Rterm (CRPIXi), Wterm (CRVALi), and CD matrix. + ndim = mw_stati (mw, MW_NPHYSDIM) + call wcs_gfterm (mw, r, w, cd, ndim) + crpix1 = r[1] + crpix2 = r[2] + crval1 = w[1] + crval2 = w[2] + + xscale = sqrt (cd[1,1]**2 + cd[2,1]**2) * 3600.0d0 + yscale = sqrt (cd[1,2]**2 + cd[2,2]**2) * 3600.0d0 + xrot = 0.0 + yrot = 0.0 + if (!fp_equald (cd[1,1], 0.0d0)) + xrot = DRADTODEG(atan ( cd[2,1] / cd[1,1])) + if (!fp_equald (cd[2,2], 0.0d0)) + yrot = DRADTODEG(atan (-cd[1,2] / cd[2,2])) + } else { + ndim = 2 + xscale = 1.0 + yscale = 1.0 + xrot = 0.0 + yrot = 0.0 + } + + if (IMG_DEBUG) { + call printf("WCS Info:\n=========\n") + call printf("R term: %g %g\n"); call pargd(r[1]); call pargd(r[2]) + call printf("W term: %g %g\n"); call pargd(w[1]); call pargd(w[2]) + call printf(" cd: %g %g\n %g %g\n") + call pargd(cd[1,1]); call pargd(cd[1,2]) + call pargd(cd[2,1]); call pargd(cd[2,2]) + call printf(" scale: %g %g\n");call pargd(xscale);call pargd(yscale) + call printf(" rot: %g %g\n");call pargd(xrot);call pargd(yrot) + } + + IMG_SCALE(img) = (xscale + yscale) / 2.0d0 + #IMG_ROT(img) = (xrot + yrot) / 2.0d0 + IMG_ROT(img) = xrot + + + # Now format a WCS text panel such as + # + # Projection: TAN System: Equatorial FK5 + # Ra/Dec axes: 1/2 Dimensions: 512 x 512 + # + # Center Pos: RA: 13:29:52.856 Dec: +47:11:40.39 + # Reference Pos: RA: 13:29:52.856 Dec: +47:11:40.39 + # Ref pixel coord: X: 250.256 Y: 266.309 + # Plate Scale: 0.765194 Rot Angle: 1.02939 + # Equinox: J2000.000 Epoch: J1987.25775240 + # MJD: 46890.39406 + + # Get some preliminary values. + if (idxstr (radecsys, Memc[radecstr], SZ_FNAME, EQTYPE_LIST) <= 0) + call strcpy ("FK5", Memc[radecstr], SZ_FNAME) + call strupr (Memc[radecstr]) + + if (idxstr (wtype, Memc[proj], SZ_FNAME, WTYPE_LIST) <= 0) + call strcpy ("logical", Memc[proj], SZ_FNAME) + call strupr (Memc[proj]) + + call fprintf (fd, "wcsinfo {\n") + + call fprintf (fd, + " Projection: %-6s\t System: %s %s\n") + call pargstr (Memc[proj]) + switch (ctype) { + case CTYPE_EQUATORIAL: + call pargstr ("Equatorial") + call pargstr (Memc[radecstr]) + case CTYPE_ECLIPTIC: + call pargstr ("Ecliptic") + call pargstr ("") + case CTYPE_GALACTIC: + call pargstr ("Galactic") + call pargstr ("") + case CTYPE_SUPERGALACTIC: + call pargstr ("SuperGalactic") + call pargstr ("") + default: + call pargstr ("Linear") + call pargstr ("") + } + + call fprintf (fd, " Ra/Dec axes: %d/%d") + call pargi (sk_stati (co, S_PLNGAX)) + call pargi (sk_stati (co, S_PLATAX)) + call fprintf (fd, " Dimensions: %d x %d\n\n") + call pargi (IM_LEN(im,1)) + call pargi (IM_LEN(im,2)) + + call fprintf (fd, + " Center Pos: %3s: %-12H %3s: %-12h\n") + if (ctype == CTYPE_EQUATORIAL) + call pargstr (" RA") + else + call pargstr ("Lon") + call pargd (cval1) + if (ctype == CTYPE_EQUATORIAL) + call pargstr ("Dec") + else + call pargstr ("Lat") + call pargd (cval2) + + call fprintf (fd, + " Reference Pos: %3s: %-12H %3s: %-12h\n") + if (ctype == CTYPE_EQUATORIAL) + call pargstr (" RA") + else + call pargstr ("Lon") + call pargd (crval1) + if (ctype == CTYPE_EQUATORIAL) + call pargstr ("Dec") + else + call pargstr ("Lat") + call pargd (crval2) + + call fprintf (fd, + " Reference Pixel: X: %-9.4f Y: %-9.4f\n") + call pargd (crpix1) + call pargd (crpix2) + + call fprintf (fd, + " Plate Scale: %-8f Rot Angle: %-8f\n") + call pargr (IMG_SCALE(img)) + call pargr (IMG_ROT(img)) + + call fprintf (fd, + " Equinox: %s%8f Epoch: %s%.6f\n") + switch (radecsys) { + case EQTYPE_FK5, EQTYPE_ICRS: + call pargstr ("J") ; call pargd (sk_statd(co,S_EQUINOX)) + call pargstr ("J") ; call pargd (sl_epj(sk_statd(co,S_EPOCH))) + default: + if (IMG_LINEAR(img) == YES) { + call pargstr (" ") ; call pargd (INDEFD) + call pargstr (" ") ; call pargd (INDEFD) + } else { + call pargstr ("B") + call pargd (sk_statd(co,S_EQUINOX)) + call pargstr ("B") + call pargd (sl_epb(sk_statd(co,S_EPOCH))) + } + } + + call fprintf (fd, " MJD: %.6f\n") + call pargd (sk_statd(co,S_EPOCH)) + + call fprintf (fd, "}\n \n \n") + + # Close the formatted string and send the message. + call close (fd) + call wcspix_message (Memc[buf]) + + call sfree (sp) +end + + +# IMG_SEND_PIXTAB -- Send a 'pixtab' message. Format of the message is +# +# pixtab { +# { {pix} {pix} ... } # pixel table values +# { {x1} {x2} ... } # column label values +# { {y1} {y2} ... } # row label values +# { <mean> <stdev> } # pixtab statistics +# } +# + +procedure img_send_pixtab (pixtab, size, x1, x2, y1, y2) + +real pixtab[ARB] #i pixtab array +int size #i pixtab size +int x1, x2, y1, y2 #i raster boundaries + +pointer sp, buf, el +int i, j, npix +real pix, sum, sum2, mean, var, stdev, x, y + +define SZ_PIXTAB (6*SZ_LINE) + +begin + call smark (sp) + call salloc (buf, SZ_PIXTAB, TY_CHAR) + call salloc (el, SZ_FNAME, TY_CHAR) + + # Begin the pixtab message. + call strcpy ("pixtab {\n{\ntable {\n", Memc[buf], SZ_PIXTAB) + + # Format the pixels into a table for presentation. Do the y-flip + # here so the pixels are in order for the List widget in the GUI. + # Accumulate the pixel statistics so we don't have to do it in the + # GUI where it's slower. + + sum = 0.0 + sum2 = 0.0 + npix = size * size + + for (i=size - 1; i >= 0; i=i-1) { + for (j=1; j <= size; j=j+1) { + pix = pixtab[(i * size) + j] + sum = sum + pix + sum2 = sum2 + (pix * pix) + + call sprintf (Memc[el], SZ_FNAME, " {%10.1f}") + call pargr (pix) + + call strcat (Memc[el], Memc[buf], SZ_PIXTAB) + } + call strcat ("\n", Memc[buf], SZ_PIXTAB) + } + call strcat ("}\n}\n", Memc[buf], SZ_PIXTAB) + + + # Do the row and column label parts of the message. + call strcat ("{", Memc[buf], SZ_PIXTAB) + for (x = x1; x <= x2; x = x + 1.) { + call sprintf (Memc[el], SZ_FNAME, " {%10.1f}") + call pargr (x) + call strcat (Memc[el], Memc[buf], SZ_PIXTAB) + } + call strcat ("}\n", Memc[buf], SZ_PIXTAB) + + call strcat ("{", Memc[buf], SZ_PIXTAB) + for (y = y2; y >= y1; y = y - 1.) { + call sprintf (Memc[el], SZ_FNAME, " {%10.1f}") + call pargr (y) + call strcat (Memc[el], Memc[buf], SZ_PIXTAB) + } + call strcat ("}\n", Memc[buf], SZ_PIXTAB) + + + # Compute the statistics for the raster. + mean = sum / real(npix) + var = (sum2 - sum * mean) / real(npix - 1) + if (var <= 0) + stdev = 0.0 + else + stdev = sqrt (var) + + call sprintf (Memc[el], SZ_FNAME, " { %10.2f %10.4f }\n") + call pargr (mean) + call pargr (stdev) + call strcat (Memc[el], Memc[buf], SZ_PIXTAB) + + + # Close the message. + call strcat ("}", Memc[buf], SZ_PIXTAB) + + if (IMG_DEBUG) { + call eprintf ("pixtab: %s\n");call pargstr(Memc[buf]) + } + + # Send the formatted message. + call wcspix_message (Memc[buf]) + + call sfree (sp) +end + + +# IMG_AMP_WCS -- Create a WCS transformation for the amplifier coordinates. + +pointer procedure img_amp_wcs (im, mw) + +pointer im #i image pointer +pointer mw #i MWCS descriptor + +pointer ct +double r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM] + +double imgetd() +pointer mw_sctran() + +begin + r[1] = 0.0d0 + r[2] = 0.0d0 + w[1] = imgetd (im, "ATV1") + w[2] = imgetd (im, "ATV2") + cd[1,1] = imgetd (im, "ATM1_1") + cd[1,2] = 0.0d0 + cd[2,1] = 0.0d0 + cd[2,2] = imgetd (im, "ATM2_2") + + # Create a new named system. + call mw_newsystem (mw, "amplifier", 2) + + # Set the new Wterm for the system. + call mw_swtermd (mw, r, w, cd, 2) + + # Set up the transform. + ct = mw_sctran (mw, "logical", "amplifier", 03B) + + # Reset the default world system. + call mw_sdefwcs (mw) + + return (ct) +end + + +# IMG_DET_WCS -- Create a WCS transformation for the detector coordinates. + +pointer procedure img_det_wcs (im, mw) + +pointer im #i image pointer +pointer mw #i MWCS descriptor + +pointer ct +double r[IM_MAXDIM], w[IM_MAXDIM], cd[IM_MAXDIM,IM_MAXDIM] + +double imgetd() +pointer mw_sctran() + +begin + r[1] = 0.0d0 + r[2] = 0.0d0 + w[1] = imgetd (im, "DTV1") + w[2] = imgetd (im, "DTV2") + cd[1,1] = imgetd (im, "DTM1_1") + cd[1,2] = 0.0d0 + cd[2,1] = 0.0d0 + cd[2,2] = imgetd (im, "DTM2_2") + + # Create a new named system. + call mw_newsystem (mw, "detector", 2) + + # Set the new Wterm for the system. + call mw_swtermd (mw, r, w, cd, 2) + + # Set up the transform. + ct = mw_sctran (mw, "logical", "detector", 03B) + + # Reset the default world system. + call mw_sdefwcs (mw) + + return (ct) +end + + +# IMG_COORD_LABELS -- Get the WCS name, coord labels and format strings for +# the specified object. + +procedure img_coord_labels (cp, line, wcsname, xunits, yunits) + +pointer cp #i cache pointer +pointer line #i WCS output line +char wcsname[ARB] #o WCS name string +char xunits[ARB], yunits[ARB] #o WCS coord labels + +pointer img, co, wp +pointer sp, proj, radecstr + +int strcmp(), sk_stati(), idxstr() + +begin + img = C_DATA(cp) # initialize ptrs + co = IMG_CO(img) + wp = IMG_WP(img) + + if (SYSTEMS(wp,line) == SYS_WORLD) { + switch (sk_stati(co,S_CTYPE)) { + case CTYPE_EQUATORIAL: + call strcpy (" RA", xunits, LEN_WCSNAME) + call strcpy (" Dec", yunits, LEN_WCSNAME) + case CTYPE_ECLIPTIC: + call strcpy ("ELon", xunits, LEN_WCSNAME) + call strcpy ("ELat", yunits, LEN_WCSNAME) + case CTYPE_GALACTIC: + call strcpy ("GLon", xunits, LEN_WCSNAME) + call strcpy ("GLat", yunits, LEN_WCSNAME) + case CTYPE_SUPERGALACTIC: + call strcpy ("SLon", xunits, LEN_WCSNAME) + call strcpy ("SLat", yunits, LEN_WCSNAME) + } + } else if (SYSTEMS(wp,line) == SYS_SKY) { + call strcpy (WCSNAME(wp,line), wcsname, LEN_WCSNAME) + call strlwr (wcsname) + if (strcmp (wcsname,"ecliptic") == 0) { + call strcpy ("ELon", xunits, LEN_WCSNAME) + call strcpy ("ELat", yunits, LEN_WCSNAME) + } else if (strcmp (wcsname,"galactic") == 0) { + call strcpy ("GLon", xunits, LEN_WCSNAME) + call strcpy ("GLat", yunits, LEN_WCSNAME) + } else if (strcmp (wcsname,"supergalactic") == 0) { + call strcpy ("SLon", xunits, LEN_WCSNAME) + call strcpy ("SLat", yunits, LEN_WCSNAME) + } else { + call strcpy (" RA", xunits, LEN_WCSNAME) + call strcpy (" Dec", yunits, LEN_WCSNAME) + } + } else { + call strcpy ("X", xunits, LEN_WCSNAME) + call strcpy ("Y", yunits, LEN_WCSNAME) + } + + + # Now get the format strings. For systems other than the image + # default just use the WCS string as the name, otherwise format a + # string giving more information about the system. + if (SYSTEMS(wp,line) != SYS_WORLD) + call strcpy (WCSNAME(wp,line), wcsname, LEN_WCSNAME) + + else { + call smark (sp) + call salloc (radecstr, SZ_FNAME, TY_CHAR) + call salloc (proj, SZ_FNAME, TY_CHAR) + + call sprintf (wcsname, LEN_WCSNAME, "%s-%s-%s") + + switch (sk_stati(co,S_CTYPE)) { + case CTYPE_EQUATORIAL: call pargstr ("EQ") + case CTYPE_ECLIPTIC: call pargstr ("ECL") + case CTYPE_GALACTIC: call pargstr ("GAL") + case CTYPE_SUPERGALACTIC: call pargstr ("SGAL") + default: call pargstr ("UNKN") + } + + if (sk_stati(co,S_CTYPE) == CTYPE_EQUATORIAL) { + if (idxstr(sk_stati(co,S_RADECSYS), Memc[radecstr], + SZ_FNAME, EQTYPE_LIST) <= 0) + call strcpy ("FK5", Memc[radecstr], SZ_FNAME) + call strupr (Memc[radecstr]) + call pargstr (Memc[radecstr]) + } else { + if (sk_stati(co,S_CTYPE) == CTYPE_SUPERGALACTIC) + call pargstr ("-") + else + call pargstr ("--") + } + + if (idxstr(sk_stati(co,S_WTYPE), Memc[proj], SZ_FNAME, + WTYPE_LIST) <= 0) + call strcpy ("linear", Memc[proj], SZ_FNAME) + call strupr (Memc[proj]) + call pargstr (Memc[proj]) + + call sfree (sp) + } + + # Now fix up the WCS system name. + if (strcmp (wcsname, "fk4") == 0 || + strcmp (wcsname, "fk5") == 0 || + strcmp (wcsname, "icrs") == 0 || + strcmp (wcsname, "gappt") == 0 || + strcmp (wcsname, "fk4-no-e") == 0) { + call strupr (wcsname) + + } else if (IS_LOWER(wcsname[1])) + wcsname[1] = TO_UPPER(wcsname[1]) +end + + +# IMG_COORD_FMT -- Format the coordinate strings. + +procedure img_coord_fmt (cp, line, xval, yval, xc, yc) + +pointer cp #i object cache pointer +int line #i output line number +double xval, yval #i input coords +char xc[ARB], yc[ARB] #o formatted coord strings + +pointer img, co, wp +char xfmt[LEN_WCSNAME], yfmt[LEN_WCSNAME] + +int sk_stati() +bool streq() + +begin + img = C_DATA(cp) # initialize ptrs + co = IMG_CO(img) + wp = IMG_WP(img) + + # Convert coords to the requested format. + if (FORMATS(wp,line) == FMT_DEFAULT) { + if (IMG_MW(img) == NULL) { + call strcpy ("%10.2f", xfmt, LEN_WCSNAME) + call strcpy ("%10.2f", yfmt, LEN_WCSNAME) + } else { + if (SYSTEMS(wp,line) == SYS_WORLD || + SYSTEMS(wp,line) == SYS_SKY) { + + if (streq(WCSNAME(wp,line),"ecliptic") || + streq(WCSNAME(wp,line),"galactic") || + streq(WCSNAME(wp,line),"supergalactic")) + call strcpy ("%h", xfmt, LEN_WCSNAME) + else + call strcpy ("%.2H", xfmt, LEN_WCSNAME) + call strcpy ("%.1h", yfmt, LEN_WCSNAME) + } else { + call strcpy ("%10.2f", xfmt, LEN_WCSNAME) + call strcpy ("%10.2f", yfmt, LEN_WCSNAME) + } + } + + } else if (FORMATS(wp,line) == FMT_HMS) { + if (sk_stati(co, S_CTYPE) == CTYPE_EQUATORIAL) + call strcpy ("%.2H", xfmt, LEN_WCSNAME) + else + call strcpy ("%.1h", xfmt, LEN_WCSNAME) + call strcpy ("%h", yfmt, LEN_WCSNAME) + } else { + call strcpy ("%10.2f", xfmt, LEN_WCSNAME) + call strcpy ("%10.2f", yfmt, LEN_WCSNAME) + } + + # Convert the value to the requested format + call sprintf (xc, LEN_WCSNAME, xfmt) + if (FORMATS(wp,line) != FMT_RAD) + call pargd (xval) + else + call pargd (DEGTORAD(xval)) + + call sprintf (yc, LEN_WCSNAME, yfmt) + if (FORMATS(wp,line) != FMT_RAD) + call pargd (yval) + else + call pargd (DEGTORAD(yval)) +end + + +# IMG_GET_COORD -- Given an x,y position in the image return the coordinate in +# the given system. + +procedure img_get_coord (img, x, y, system, wcsname, wx, wy) + +pointer img #i IMG struct pointer +double x, y #i input image position +int system #i coordinate system requested +char wcsname[ARB] #i desired WCS name +double wx, wy #o output coordinates + +double ox, oy, tmp +real epoch +pointer im, co, nco +char buf[SZ_LINE] +int stat + +real imgetr() +int imaccf(), sk_stati(), sk_decwstr() +bool streq() + +errchk imgetr + +begin + im = IMG_IM(img) + co = IMG_CO(img) + + wx = x # fallback values + wy = y + + switch (system) { + case SYS_NONE: + wx = x + wy = y + case SYS_DISPLAY: + call img_ltov (im, x, y, wx, wy) + #wx = x + #wy = y + case SYS_PHYSICAL: + if (IMG_CTP(img) != NULL) + call mw_c2trand (IMG_CTP(img), x, y, wx, wy) + case SYS_WORLD: + if (IMG_CTW(img) != NULL) { + call mw_c2trand (IMG_CTW(img), x, y, wx, wy) + + # Check for transposed image. + if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) { + tmp = wx + wx = wy + wy = tmp + } + } + case SYS_AMP: + if (IMG_CTA(img) != NULL) + call mw_c2trand (IMG_CTA(img), x, y, wx, wy) + case SYS_CCD: + if (IMG_CTD(img) != NULL) + call mw_c2trand (IMG_CTD(img), x, y, wx, wy) + case SYS_DETECTOR: + if (IMG_CTD(img) != NULL) + call mw_c2trand (IMG_CTD(img), x, y, wx, wy) + case SYS_SKY: + # Note Ecliptic/GAPPT coords need an epoch value. + if (imaccf (im, "EPOCH") == YES) { + epoch = imgetr (im, "EPOCH") + if (epoch == 0.0 || IS_INDEFR(epoch)) + epoch = 1950.0 + } else + epoch = 1950.0 + + if (streq (wcsname, "ecliptic") || streq (wcsname, "gappt")) { + call sprintf (buf, SZ_LINE, "%s %.1f") + if (streq (wcsname, "gappt")) + call pargstr ("apparent") + else + call pargstr (wcsname) + call pargr (epoch) + } else { + call sprintf (buf, SZ_LINE, "%s") + if (streq(wcsname,"gappt")) + call pargstr ("apparent") + else if (streq(wcsname,"fk4-no-e")) + call pargstr ("noefk4") + else + call pargstr (wcsname) + } + + stat = sk_decwstr (buf, nco, co) + if (stat != ERR) { + if (IMG_CTW(img) != NULL) + call mw_c2trand (IMG_CTW(img), x, y, ox, oy) + call sk_lltran (co, nco, DEGTORAD(ox), DEGTORAD(oy), + INDEFD, INDEFD, 0.0d0, 0.0d0, wx, wy) + if (sk_stati(co,S_PLATAX) < sk_stati(co,S_PLNGAX)) { + wx = RADTODEG(wy) # transposed image + wy = RADTODEG(wx) + } else { + wx = RADTODEG(wx) # regular image + wy = RADTODEG(wy) + } + } else { + wx = x + wy = y + } + case SYS_OTHER: + ; # TBD + + default: # default coords + wx = x + wy = y + } +end + + +# IMG_LTOV -- Convert coordinate from the logical coordinate system to the +# output coordinate system. + +procedure img_ltov (im, xin, yin, xout, yout) + +pointer im # the input image descriptor +double xin # the input x coordinate +double yin # the input y coordinate +double xout # the output x coordinate +double yout # the output y coordinate + +int index1, index2 + +begin + index1 = IM_VMAP(im,1) + index2 = IM_VMAP(im,2) + + xout = xin * IM_VSTEP(im,index1) + IM_VOFF(im,index1) + yout = yin * IM_VSTEP(im,index2) + IM_VOFF(im,index2) +end + + +# IMG_VTOL -- Convert coordinate from the tv coordinate system to the +# logical coordinate system. + +procedure img_vtol (im, xin, yin, xout, yout) + +pointer im # the input image descriptor +double xin # the input x coordinate +double yin # the input y coordinate +double xout # the output x coordinate +double yout # the output y coordinate + +int index1, index2 + +begin + index1 = IM_VMAP(im,1) + index2 = IM_VMAP(im,2) + + xout = (xin - IM_VOFF(im,index1)) / IM_VSTEP(im,index1) + yout = (yin - IM_VOFF(im,index2)) / IM_VSTEP(im,index2) +end diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcmef.x b/vendor/x11iraf/ximtool/clients/wcspix/wcmef.x new file mode 100644 index 00000000..050e5596 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/wcmef.x @@ -0,0 +1,50 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "wcspix.h" + + +# MEF Image class data. + + +# MEF_INIT -- Initialize the MEF Class module. + +procedure mef_init () +begin +end + + +# MEF_CACHE -- Cache an image in the object cache. + +procedure mef_cache () +begin +end + + +# MEF_UNCACHE -- Uncache an image in the object cache. + +procedure mef_uncache () +begin +end + + +# MEF_WCSTRAN -- Translate object source (x,y) coordinates to the +# desired output WCSs. + +procedure mef_wcstran () +begin +end + + +# MEF_WCSLIST -- List the WCSs available for the given image. + +procedure mef_wcslist () +begin +end + + +# MEF_OBJINFO -- Get header information from the image. + +procedure mef_objinfo () +begin +end + diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcmspec.x b/vendor/x11iraf/ximtool/clients/wcspix/wcmspec.x new file mode 100644 index 00000000..64198d69 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/wcmspec.x @@ -0,0 +1,50 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "wcspix.h" + + +# Multispec image class data. + + +# MSP_INIT -- Initialize the Image Class module. + +procedure msp_init () +begin +end + + +# MSP_CACHE -- Cache an image in the object cache. + +procedure msp_cache () +begin +end + + +# MSP_UNCACHE -- Uncache an image in the object cache. + +procedure msp_uncache () +begin +end + + +# MSP_WCSTRAN -- Translate object source (x,y) coordinates to the +# desired output WCSs. + +procedure msp_wcstran () +begin +end + + +# MSP_WCSLIST -- List the WCSs available for the given image. + +procedure msp_wcslist () +begin +end + + +# MSP_OBJINFO -- Get header information from the image. + +procedure msp_objinfo () +begin +end + diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcspix.h b/vendor/x11iraf/ximtool/clients/wcspix/wcspix.h new file mode 100644 index 00000000..0233ff21 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/wcspix.h @@ -0,0 +1,112 @@ +# WCSPIX.H -- Include file for the WCS/Pixel value ISM task + +define WCSPIX_NAME "wcspix" +define WCSPIX_MODE "text" +define WCSPIX_CONNECT "unix:/tmp/.ISM%d" + +define WCSPIX_DBG FALSE + +# Main task data structures. +define MAX_WCSLINES 4 # max WCS output lines +define LEN_PIXTAB 81 # size of pixel table +define LEN_WCSNAME 32 # size of a WCS name + +define SZ_WCSPIX 7 +define WP_CPTR Memi[$1 ] # object cache pointer +define WP_PTABSZ Memi[$1+1] # pixel table size +define WP_BPM Memi[$1+2] # get BPM data +define WP_SYSTEMS Memi[$1+3] # WCS readout systems +define WP_WCS Memi[$1+4] # WCS system string +define WP_FORMATS Memi[$1+5] # WCS readout formats +define WP_DBGLEVEL Memi[$1+6] # debug level + +define OBJCACHE Memi[WP_CPTR($1)+$2] # object cache +define SYSTEMS Memi[WP_SYSTEMS($1)+$2-1] +define FORMATS Memi[WP_FORMATS($1)+$2-1] +define WCSNAME Memc[WP_WCS($1)+(LEN_WCSNAME*($2-1))] + + +# Element of an object cache. +define SZ_CACHE 256 # size of object cache +define SZ_CNODE 135 # size of a cache node +define SZ_OBJREF 128 # size of a object reference + +define C_OBJID Memi[$1] # object id +define C_REGID Memi[$1+1] # region id +define C_CLASS Memi[$1+2] # object class +define C_DATA Memi[$1+3] # object data ptr +define C_NREF Memi[$1+4] # no. times object referenced +define C_REF Memc[P2C($1+6)] # object reference file + + +# WCSPIX ISM task methods. +define WCSPIX_CMDS "|set|get|quit|initialize|cache|uncache\ + |wcstran|wcslist|objinfo|debug" + +define SET 1 +define GET 2 +define QUIT 3 +define INITIALIZE 4 +define CACHE 5 +define UNCACHE 6 +define WCSTRAN 7 +define WCSLIST 8 +define OBJINFO 9 +define DEBUG 10 + +# Parameters definable from the GUI +define SZ_PARAM 32 # size of a parameter string + +define WCSPIX_SYSTEMS "|none|display|logical|physical|world|sky\ + |amplifier|ccd|detector|other|" +define SYS_NONE 1 # no coords requested +define SYS_DISPLAY 2 # image display coords +define SYS_LOGICAL 3 # logical coords +define SYS_PHYSICAL 4 # physical coords +define SYS_WORLD 5 # world coords +define SYS_SKY 6 # sky coords +define SYS_AMP 7 # amplifier coords +define SYS_CCD 8 # CCD coords +define SYS_DETECTOR 9 # detector coords +define SYS_OTHER 10 # ??? coords + +define SKYPROJ "FK5 FK4 ICRS GAPPT FK4-NO-E Ecliptic Galactic Supergalactic" + + +define WCSPIX_PARAMS "|psize|bpm|wcs|format|" +define PAR_PSIZE 1 # pixel table size +define PAR_BPM 2 # get BPM data +define PAR_WCS 3 # WCS system +define PAR_FMT 4 # WCS format + +define WCSPIX_FMT "|default|hms|degrees|radians|" +define FMT_DEFAULT 1 # no formatting +define FMT_HMS 2 # covert to sexigesimal +define FMT_DEG 3 # output degrees +define FMT_RAD 4 # output radians + +define DEF_PTABSZ 0 # default pixtable size +define DEF_FMT FMT_DEFAULT # default output format +define DEF_SYSTEM SYS_LOGICAL # default coord system +define DEF_BPM_FLAG NO # default get-BPM-data flag + + +# Object class definitions. +define UNKNOWN_CLASS 1 # unknown class +define IMAGE_CLASS 2 # generic image class +define MEF_CLASS 3 # Mosaic MEF image class +define MULTISPEC_CLASS 4 # multispec data class + +# Class methods. +define LEN_CLASS 6 # length of class table +define MAX_CLASSES 16 # max supported classes +define SZ_CLNAME 32 # size of a class name + +define CL_INIT cl_table[1,$1] # class initializer +define CL_CACHE cl_table[2,$1] # cache the object +define CL_UNCACHE cl_table[3,$1] # uncache the object +define CL_WCSTRAN cl_table[4,$1] # WCS tranformations +define CL_WCSLIST cl_table[5,$1] # list available WCS +define CL_OBJINFO cl_table[6,$1] # get object header +define CL_NAME cl_names[1,$1] # class name + diff --git a/vendor/x11iraf/ximtool/clients/wcspix/wcunknown.x b/vendor/x11iraf/ximtool/clients/wcspix/wcunknown.x new file mode 100644 index 00000000..86e5e6d8 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/wcspix/wcunknown.x @@ -0,0 +1,185 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include "wcspix.h" + + +# Unknown class data. +define LEN_UNKDATA 1 +define UNK_WP Memi[$1 ] # wcspix back-pointer + + +# UNK_INIT -- Initialize the object structure. + +procedure unk_init (cp, wp) + +pointer cp #i cache pointer +pointer wp #i WCSPIX structure + +begin + # Allocate the image data structure if not previously allocated. + if (C_DATA(cp) == NULL) { + iferr (call calloc (C_DATA(cp), LEN_UNKDATA, TY_STRUCT)) + return + } + + UNK_WP(C_DATA(cp)) = wp +end + + +# UNK_CACHE -- Cache an image in the object cache. Since we don't know +# what this is we simply setup so that a query to the object id will still +# return a result of some kind rather than ignore it. In most cases this +# just means the input arguments are echoed back (e.g. coords), or default +# values such as a rotation value can be retrieved. + +procedure unk_cache (cp, objid, regid, ref) + +pointer cp #i cache pointer +int objid #i object id +int regid #i region id +char ref[ARB] #i object reference + +begin + C_OBJID(cp) = objid + C_REGID(cp) = regid + C_NREF(cp) = C_NREF(cp) + 1 + call strcpy (ref, C_REF(cp), 128) +end + + +# UNK_UNCACHE -- Uncache an unknown image in the object cache. + +procedure unk_uncache (cp, id) + +pointer cp #i cache pointer +int id #i image id + +begin + C_OBJID(cp) = NULL + C_NREF(cp) = 0 + call strcpy ("", C_REF(cp), SZ_FNAME) + + call mfree (C_DATA(cp), TY_STRUCT) + C_DATA(cp) = NULL +end + + +# UNK_WCSTRAN -- Translate object source (x,y) coordinates to the +# desired output WCSs. Message is returned as something like: +# +# set value { +# { object <objid> } { region <regionid> } +# { pixval <pixelvalue> [<units>] } +# { coord <wcsname> <x> <y> [<xunits> <yunits>] } +# { coord <wcsname> <x> <y> [<xunits> <yunits>] } +# } + + +procedure unk_wcstran (cp, id, x, y) + +pointer cp #i cache pointer +int id #i image id +real x, y #i source coords + +pointer wp +int i + +# Use static storage to avoid allocation overhead. +char buf[SZ_LINE], msg[SZ_LINE] + +begin + wp = UNK_WP(C_DATA(cp)) + + # Begin formatting the message. + call aclrc (msg, SZ_LINE) + call sprintf (msg, SZ_LINE, "wcstran { object %d } { region %d } ") + call pargi (C_OBJID(cp)) + call pargi (C_REGID(cp)) + call strcat ("{ pixval 0.0 } { bpm 0 } \n", msg, SZ_LINE) + + + # Now loop over the requested systems and generate a coordinate + # for each. + for (i=1; i <= MAX_WCSLINES; i=i+1) { + + # Format the coord buffer and append it to the message. + call sprintf (buf, SZ_LINE, "{coord {%9s} {%12g} {%12g} {X} {Y}}\n") + call pargstr ("UNKN") + call pargr (x) + call pargr (y) + call strcat (buf, msg, SZ_LINE) + } + + # Now send the completed message. + call wcspix_message (msg) +end + + +# UNK_WCSLIST -- List the WCSs available for the given image. + +procedure unk_wcslist (cp, id) + +pointer cp #i cache pointer +int id #i image id + +begin + #call wcspix_message ("wcslist {None Logical}") +end + + +# UNK_GETDATA -- Get data from the image. + +procedure unk_getdata (cp, id, x, y, pixval) + +pointer cp #i cache pointer +int id #i image id +real x, y #i source coords +real pixval #o central pixel value + +pointer wp, pix +int size, x1, x2, y1, y2 + +begin + wp = UNK_WP(C_DATA(cp)) + size = WP_PTABSZ(wp) + + # Compute the box offset given the center and size. + x1 = x - size / 2 + 0.5 + x2 = x + size / 2 + 0.5 + y1 = y - size / 2 + 0.5 + y2 = y + size / 2 + 0.5 + + pixval = 0.0 + + # Send the pixel table. + if (size > 1) { + call calloc (pix, size * size, TY_REAL) + call img_send_pixtab (Memr[pix], size, x1, x2, y1, y2) + call mfree (pix, TY_REAL) + } +end + + +# UNK_OBJINFO -- Get header information from the image. + +procedure unk_objinfo (cp, id, template) + +pointer cp #i cache pointer +int id #i image id +char template[ARB] #i keyword template + +pointer sp, buf + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + # Send a default (X,Y) compass indicator. + call aclrc (Memc[buf], SZ_LINE) + call sprintf (Memc[buf], SZ_LINE, "compass %d 0.0 -1 1 0 X Y\0") + call pargi (C_OBJID(cp)) + call wcspix_message (Memc[buf]) + + call sfree (sp) +end diff --git a/vendor/x11iraf/ximtool/clients/x_ism.x b/vendor/x11iraf/ximtool/clients/x_ism.x new file mode 100644 index 00000000..8f401873 --- /dev/null +++ b/vendor/x11iraf/ximtool/clients/x_ism.x @@ -0,0 +1 @@ +task wcspix = t_wcspix |