summaryrefslogtreecommitdiffstats
path: root/ds9/library/sia.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'ds9/library/sia.tcl')
-rw-r--r--ds9/library/sia.tcl499
1 files changed, 499 insertions, 0 deletions
diff --git a/ds9/library/sia.tcl b/ds9/library/sia.tcl
new file mode 100644
index 0000000..d992ccb
--- /dev/null
+++ b/ds9/library/sia.tcl
@@ -0,0 +1,499 @@
+# Copyright (C) 1999-2016
+# Smithsonian Astrophysical Observatory, Cambridge, MA, USA
+# For conditions of distribution and use, see copyright notice in "copyright"
+
+package provide DS9 1.0
+
+proc SIADef {} {
+ global sia
+ global isia
+ global psia
+ global wcs
+
+ set isia(sias) {}
+
+ set isia(rformat) arcmin
+ set isia(width) 15
+ set isia(height) 15
+
+ set isia(minrows) 20
+ set isia(mincols) 10
+
+ set isia(mode) new
+ set isia(save) 0
+
+ set isia(def) { \
+ {{2MASS (NASA/IPAC)} \
+ sia2mass \
+ {http://irsa.ipac.caltech.edu/cgi-bin/2MASS/IM/nph-im_sia}\
+ {} \
+ post \
+ } \
+ {{AKARI (ISAS/JAXA)} \
+ siaakari \
+ {http://jvo.nao.ac.jp/skynode/do/siap/akari/fis_image_v1/1.0}\
+ {} \
+ post \
+ } \
+ {{Astro-Wise} \
+ siaastrowise \
+ {http://vo.astro-wise.org/SIAP}\
+ {VERB=2&FORM=VOTable&PROJECT=ALL&INSTRUMENT=ALL&} \
+ post \
+ } \
+ {{CADC} \
+ siacadc \
+ {http://www1.cadc-ccda.hia-iha.nrc-cnrc.gc.ca/sia/query}\
+ {} \
+ post \
+ } \
+ {{Chandra (NASA/CXC)} \
+ siacxc \
+ {http://cda.harvard.edu/cxcsiap/queryImages}\
+ {} \
+ post \
+ } \
+ {{MAST (STSCI)} siamast \
+ {http://archive.stsci.edu/siap/search.php}\
+ {} \
+ post \
+ } \
+ {{SDSS DR12} \
+ siasdss \
+ {http://skyserver.sdss.org/SkyserverWS/dr12/SIAP/getSIAP}\
+ {} \
+ get \
+ } \
+ {{SkyView (NASA/HEASARC)} \
+ siaskyview \
+ {http://skyview.gsfc.nasa.gov/cgi-bin/vo/sia.pl}\
+ {} \
+ post \
+ } \
+ {{TGSSADR (GMRT)} \
+ siatgssadr \
+ {http://vo.astron.nl/tgssadr/q_fits/imgs/siap.xml}\
+ {} \
+ post \
+ } \
+ }
+
+# {{NASA/CXC Chandra} \
+# siacxc \
+# {http://cda.harvard.edu/cxcsiap/queryImages}\
+# {} \
+# post \
+# } \
+# {{MPE/MPG ROSAT} siarosat \
+# {http://gavo.mpe.mpg.de/rosat/SIAP} \
+# {action=queryImage&siap=siap.service.rosat&} \
+# get \
+# } \
+}
+
+proc SIAAnalysisMenu {mb} {
+ global isia
+ global ds9
+
+ foreach ff $isia(def) {
+ set title [lindex $ff 0]
+ set vars [lindex $ff 1]
+ set url [lindex $ff 2]
+ set opts [lindex $ff 3]
+ set method [lindex $ff 4]
+
+ $mb add command -label $title \
+ -command [list SIADialog $vars $title $url $opts $method apply]
+ }
+}
+
+proc SIAGetURL {varname url2} {
+ upvar #0 $varname var
+ global $varname
+
+ global debug
+ if {$debug(tcl,sia)} {
+ puts stderr "SIAGetURL $varname $var(method) $url2?$var(query2)"
+ }
+
+ ARStatus $varname [msgcat::mc {Loading}]
+
+ # geturl --method does not work
+ switch $var(method) {
+ get {
+ set url $url2?$var(query2)
+ set query {}
+ }
+ default {
+ set url $url2
+ set query $var(query2)
+ }
+ }
+
+ global ihttp
+ if {$var(sync)} {
+ if {![catch {set var(token) [http::geturl $url \
+ -query $query \
+ -timeout $ihttp(timeout) \
+ -headers "[ProxyHTTP]"]
+
+
+ }]} {
+ # reset errorInfo (may be set in http::geturl)
+ global errorInfo
+ set errorInfo {}
+
+ set var(active) 1
+ SIAGetURLFinish $varname $var(token)
+ } else {
+ SIAError $varname "[msgcat::mc {Unable to locate URL}] $url2"
+ }
+ } else {
+ if {![catch {set var(token) [http::geturl $url \
+ -query $query \
+ -timeout $ihttp(timeout) \
+ -command \
+ [list SIAGetURLFinish $varname] \
+ -headers "[ProxyHTTP]"]
+ }]} {
+ # reset errorInfo (may be set in http::geturl)
+ global errorInfo
+ set errorInfo {}
+
+ set var(active) 1
+ } else {
+ SIAError $varname "[msgcat::mc {Unable to locate URL}] $url2"
+ }
+ }
+}
+
+proc SIAGetURLFinish {varname token} {
+ upvar #0 $varname var
+ global $varname
+
+ global debug
+ if {$debug(tcl,sia)} {
+ puts stderr "SIAGetURLFinish $varname"
+ }
+
+ if {!($var(active))} {
+ SIACancelled $varname
+ return
+ }
+
+ upvar #0 $token t
+
+ # Code
+ set code [http::ncode $token]
+
+ # Meta
+ set meta $t(meta)
+
+ # Log it
+ HTTPLog $token
+
+ # Result?
+ switch -- $code {
+ {} -
+ 200 -
+ 203 -
+ 404 -
+ 503 {
+ VOTParse $var(tbldb) $token
+ SIADone $varname
+ SIALoadDone $varname
+ }
+
+ 201 -
+ 300 -
+ 301 -
+ 302 -
+ 303 -
+ 305 -
+ 307 {
+ foreach {name value} $meta {
+ if {[regexp -nocase ^location$ $name]} {
+ global debug
+ if {$debug(tcl,sia)} {
+ puts stderr "SIAGetURLFinish redirect $code to $value"
+ }
+ # clean up and resubmit
+ http::cleanup $token
+ unset var(token)
+
+ SIAGetURL $varname $value
+ }
+ }
+ }
+
+ default {
+ SIAError $varname "[msgcat::mc {Error code was returned}] $code"
+ }
+ }
+}
+
+proc SIALoad {varname} {
+ upvar #0 $varname var
+ global $varname
+
+ # clear previous db
+ global $var(tbldb)
+ if {[info exists $var(tbldb)]} {
+ unset $var(tbldb)
+ }
+
+ global debug
+ if {$debug(tcl,sia)} {
+ puts stderr "SIALoad $varname $var(url2)?$var(query2)"
+ }
+
+ SIAGetURL $varname $var(url2)
+ return
+}
+
+proc SIALoadDone {varname} {
+ upvar #0 $varname var
+ global $varname
+
+ global debug
+ if {$debug(tcl,sia)} {
+ puts stderr "SIALoadDone $varname"
+ }
+
+ SIATable $varname
+
+ SIADialogUpdate $varname
+}
+
+proc SIAOff {varname} {
+ upvar #0 $varname var
+ global $varname
+
+ global $var(tbldb)
+ if {[info exists $var(tbldb)]} {
+ unset $var(tbldb)
+ }
+ set db $var(tbldb)
+ set ${db}(Nrows) {}
+
+ $var(tbl) selection clear all
+
+ SIADialogUpdate $varname
+}
+
+proc SIATable {varname} {
+ upvar #0 $varname var
+ global $varname
+ global $var(tbldb)
+ global isia
+
+ global debug
+ if {$debug(tcl,sia)} {
+ puts stderr "SIATable $varname"
+ }
+
+ if {![CATValidDB $var(tbldb)]} {
+ return
+ }
+
+ # clear the selection
+ $var(tbl) selection clear all
+
+ global $var(tbldb)
+ $var(found) configure -textvariable ${var(tbldb)}(Nrows)
+
+# starbase_writefp $var(tbldb) stdout
+
+ if {[starbase_nrows $var(tbldb)] == 0} {
+ ARStatus $varname [msgcat::mc {No Items Found}]
+ return
+ }
+
+ set nc [starbase_ncols $var(tbldb)]
+ if { $nc > $isia(mincols)} {
+ $var(tbl) configure -cols $nc
+ } else {
+ $var(tbl) configure -cols $isia(mincols)
+ }
+
+ # add header
+ set nr [expr [starbase_nrows $var(tbldb)]+1]
+ if {$nr > $isia(minrows)} {
+ $var(tbl) configure -rows $nr
+ } else {
+ $var(tbl) configure -rows $isia(minrows)
+ }
+}
+
+# Process Cmds
+
+proc ProcessSIACmd {varname iname} {
+ upvar $varname var
+ upvar $iname i
+
+ global isia
+
+ # we need to be realized
+ ProcessRealizeDS9
+
+ set item [string tolower [lindex $var $i]]
+ switch -- $item {
+ cancel -
+ clear -
+ close -
+ coordinate -
+ crosshair -
+ export -
+ name -
+ print -
+ retreive -
+ retrieve -
+ save -
+ size -
+ sky -
+ skyformat -
+ system -
+ update {ProcessSIA $varname $iname [lindex $isia(sias) end]}
+
+ default {
+ # existing sia or load new one?
+ set ref $item
+
+ incr i
+ set item [string tolower [lindex $var $i]]
+ switch -- $item {
+ cancel -
+ clear -
+ close -
+ coordinate -
+ crosshair -
+ export -
+ name -
+ print -
+ retreive -
+ retrieve -
+ save -
+ size -
+ sky -
+ skyformat -
+ system -
+ update {ProcessSIA $varname $iname sia${ref}}
+
+ default {
+ # ok, new sia
+ incr i -1
+ set item [string tolower [lindex $var $i]]
+
+ # see if its from our list of sias
+ foreach mm $isia(def) {
+ set title [lindex $mm 0]
+ set vars [lindex $mm 1]
+ set url [lindex $mm 2]
+ set opts [lindex $mm 3]
+ set method [lindex $mm 4]
+
+ if {$title != {-} && "sia${item}" == $vars} {
+ SIADialog $vars $title $url $opts $method sync
+ return
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
+proc ProcessSIA {varname iname cvarname} {
+ upvar 2 $varname var
+ upvar 2 $iname i
+
+ global isia
+ global psia
+ global current
+
+ # we should have a sia now
+ global $cvarname
+ upvar #0 $cvarname cvar
+
+ if {![info exists cvar(top)]} {
+ Error "[msgcat::mc {Unable to find SIAP window}] $cvarname"
+ return
+ }
+ if {![winfo exists $cvar(top)]} {
+ Error "[msgcat:: mc {Unable to find SIAP window}] $cvarname"
+ return
+ }
+
+ # now, process it
+ set item [string tolower [lindex $var $i]]
+ switch -- $item {
+ cancel {ARCancel $cvarname}
+ clear {SIAOff $cvarname}
+ close {SIADestroy $cvarname}
+ coordinate {
+ incr i
+ set cvar(x) [lindex $var $i]
+ incr i
+ set cvar(y) [lindex $var $i]
+ incr i
+ set cvar(sky) [lindex $var $i]
+ }
+ crosshair {IMGSVRCrosshair $cvarname}
+ export -
+ save {
+ incr i
+ set writer VOTWrite
+ switch -- [lindex $var $i] {
+ xml -
+ vot {incr i; set writer VOTWrite}
+ sb -
+ starbase {incr i; set writer starbase_write}
+ csv -
+ tsv {incr i; set writer TSVWrite}
+ }
+
+ set fn [lindex $var $i]
+ CATSaveFn $cvarname $fn $writer
+ FileLast catfbox $fn
+ }
+ name {
+ incr i
+ set cvar(name) [lindex $var $i]
+ }
+ print {CATPrint $cvarname}
+ retrieve -
+ retreive {SIAApply $cvarname 1}
+ size {
+ incr i
+ set cvar(width) [lindex $var $i]
+ incr i
+ set cvar(height) [lindex $var $i]
+ incr i
+ set cvar(rformat) [lindex $var $i]
+ set cvar(rformat,msg) $cvar(rformat)
+ }
+ sky {
+ incr i
+ set cvar(sky) [lindex $var $i]
+ CoordMenuButtonCmd $cvarname system sky \
+ [list SIAWCSMenuUpdate $cvarname]
+ }
+ skyformat {
+ incr i
+ set cvar(skyformat) [lindex $var $i]
+ }
+ system {
+ incr i
+ set cvar(system) [lindex $var $i]
+ CoordMenuButtonCmd $cvarname system sky \
+ [list SIAWCSMenuUpdate $cvarname]
+ }
+ update {IMGSVRUpdate $cvarname}
+ }
+}
+
+proc ProcessSendSIACmd {proc id param sock fn} {
+ global isia
+
+ $proc $id "$isia(sias)\n"
+}
generated by cgit v0.12 at 2024-08-29 00:42:51 (GMT)