saods9 7.5+repack1-2 / usr / share / saods9 / library / catned.tcl

#  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 CATNED {varname} {
    upvar #0 $varname var
    global $varname
    global pcat

    global debug
    if {$debug(tcl,cat)} {
	puts stderr "CATNED $varname"
    }

    # parser
    if {$pcat(vot)} {
	set var(proc,parser) VOTParse
    } else {
	set var(proc,reader) CATNEDReader
    }

    # query
    switch $var(skyformat) {
	degrees {
	    set xx $var(x)
	    set yy $var(y)
	}
	sexagesimal {
	    switch -- $var(sky) {
		fk4 -
		fk5 -
		icrs {set xx [h2d [Sex2H $var(x)]]}
		galactic -
		ecliptic {set xx [Sex2D $var(x)]}
	    }
	    set yy [Sex2D $var(y)]
	}
    }

    switch -- $var(rformat) {
	degrees {
	    set ww $var(width)
	    set hh $var(height)
	}
	arcmin {
	    set ww [expr $var(width)/60.]
	    set hh [expr $var(height)/60.]
	}
	arcsec {
	    set ww [expr $var(width)/60./60.]
	    set hh [expr $var(height)/60./60.]
	}
    }
    set rr [expr sqrt($ww*$ww+$hh*$hh)/2.]

    if {$pcat(vot)} {
	set out "xml_main"
    } else {
	set out "ascii_tab"
    }

    switch -- $var(sky) {
	fk4 {
	    set sky "Equatorial"
	    set eq "B1950.0"
	}
	fk5 -
	icrs {
	    set sky "Equatorial"
	    set eq "J2000.0"
	}
	galactic {
	    set sky "Galactic"
	    set eq {}
	}
	ecliptic {
	    set sky "Ecliptic"
	    set eq {}
	}
    }
    switch -- $var(psky) {
	fk4 {
	    set psky "Equatorial"
	    set peq "B1950.0"
	}
	fk5 -
	icrs {
	    set psky "Equatorial"
	    set peq "J2000.0"
	}
	galactic {
	    set psky "Galactic"
	    set peq {}
	}
	ecliptic {
	    set psky "Ecliptic"
	    set peq {}
	}
    }

    # url
    set var(query) {}
    set query [http::formatQuery search_type "Near Position Search" RA $xx DEC $yy SR $rr of $out in_csys $sky in_equinox $eq out_csys $psky out_equinox $peq]
    set var(url) "http://ned.ipac.caltech.edu/cgi-bin/nph-objsearch?$query"

    if {$pcat(vot)} {
	CATLoad $varname
    } else {
	CATLoadIncr $varname
    }
}

proc CATNEDReader {t sock token} {
    upvar #0 $t T
    global $t

    set result 0

    if { ![info exists ${t}(state)]  } {
	set T(state) 0
    }

    switch -- $T(state) {
	0 {
	    # init db
	    fconfigure $sock -blocking 1
	    set T(Nrows) 0
	    set T(Ncols) 0
	    set T(Header) {}
	    set T(HLines) 0

	    set T(state) 1
	}

	1 {
	    # process header
	    if {[gets $sock line] == -1} {
		set T(Nrows) 0
		set T(Ncols) 0
		set T(Header) {}
		set T(HLines) 0

		set T(state) -1
		return $result
	    }

	    set result [string length "$line"]

	    # start of data?
	    if {[string range $line 0 2] == {No.}} {
		# cols
		incr ${t}(HLines)
		set n $T(HLines)
		set T(H_$n) $line
		set T(Header) [split $T(H_$n) "\t"]

		# dashes
		set T(Dashes) [regsub -all {[A-Za-z0-9]} $T(H_$n) {-}]
		set T(Ndshs) [llength $T(Dashes)]
		starbase_colmap $t

		set T(state) 2
	    }
	}

	2 { 
	    # process table
	    if {[gets $sock line] == -1} {
		set T(state) 0
	    } else {
		set result [string length "$line"]
		set line [string trim $line]

		if {$line != {}} {
		    # ok, save it
		    incr ${t}(Nrows)
		    set r $T(Nrows)

		    set NCols [starbase_ncols $t]
		    set c 1
		    foreach val [split $line "\t"] {
			set T($r,$c) $val
			incr c
		    }
		    for {} {$c <= $NCols} {incr c} {
			set T($r,$c) {}
		    }
		}
	    }
	}
    }

    return $result
}

proc CATNEDAck {varname} {
    upvar #0 $varname var
    global $varname

    set msg {Acknowledgments for NED

This research has made use of the NASA/IPAC Extragalactic Database (NED)
which is operated by the Jet Propulsion Laboratory, California Institute
of Technology, under contract with the National Aeronautics and Space
Administration.
    }

    SimpleTextDialog ${varname}ack [msgcat::mc {Acknowledgment}] \
	80 10 insert top $msg
}