Initial commit

1 files changed, 464 insertions, 0 deletions

diff --git a/vendor/x11iraf/ximtool/gui.bak/wcs.tcl b/vendor/x11iraf/ximtool/gui.bak/wcs.tcl
new file mode 100644
index 00000000..8b14db4f
--- /dev/null
+++ b/vendor/x11iraf/ximtool/gui.bak/wcs.tcl
@@ -0,0 +1,464 @@
+
+################################################################################
+#  Coords Panel Callbacks.
+################################################################################
+
+# In case we need to change the values....
+#global wcsPHeight wcsPTxtHeight wcsPGrHeight wcsPOptHeight
+#set wcsPHeight		267
+#set wcsPTxtHeight	132
+#set wcsPGrHeight	175
+#set wcsPOptHeight	233
+#setCoordPanelHeight
+
+set wcsPHeight		267		;# full panel no options
+set wcsPTxtHeight	132		;# size of text area box
+set wcsPGrHeight	175		;# size of text area group
+set wcsPOptHeight	233		;# extra height for opts boxes
+
+# Set the WCS readout panel sensitivity depending on whether the ISM
+# is currently enabled.
+proc setCoordPanelSensitivity args \
+{
+    set widgets { 
+	wpWcs2 wpWcs3 wpWcs4 
+	wiWcs2 wiWcs3 wiWcs4 
+	wlWcs2 wlWcs3 wlWcs4
+	sysWcs2 sysWcs3 sysWcs4 
+	fmtWcs2 fmtWcs3 fmtWcs4
+    }
+
+    send sysWcs1 set label "Display"
+    send fmtWcs1 set label "Default"
+
+    for {set i 2} {$i <= 4} {incr i} {
+        send sysWcs$i set label "None" ; send fmtWcs$i set label "Default"
+        send wpWcs$i  set on False     ; send wiWcs$i  set on False
+        send wtWcs$i  set height 4
+    }
+
+    if {[send ismToggle get on]} {
+        send sysWcs2 set label "World" ; send fmtWcs2 set label "Default"
+	send wpWcs2  set on True       ; send wiWcs2  set on True
+        send wtWcs2  set height 17
+
+        foreach w $widgets { send $w setSensitive True }
+    } else {
+        foreach w $widgets { send $w setSensitive False }
+    }
+}
+
+
+# Set the Coords Panel height  depending on the option settings.
+proc setCoordPanelHeight args \
+{
+    global wcsPHeight wcsPOptHeight wcsPTxtHeight wcsPGrHeight
+    global tabTop
+
+    if {$tabTop != "wcs_panel"} \
+	return
+
+    # Get the height of the text area
+    set panel_h $wcsPHeight
+    set shrinkage 0
+    foreach w { wpWcs1 wpWcs2 wpWcs3 wpWcs4 woptFBinfo } {
+	if {[send $w get on] == 0} {
+	    incr shrinkage 13
+	}
+    }
+    if {[send woptTitles get on] == 0} {
+	incr shrinkage 26
+    }
+
+    set ph [expr ($wcsPHeight - $shrinkage)]
+    if {[send wcsOptions get on] == 1} {
+	incr ph $wcsPOptHeight
+    }
+
+    send wcsGroup set height [ expr ($wcsPGrHeight - $shrinkage) ]
+    send wcsFrame set height [ expr ($wcsPTxtHeight - $shrinkage) ]
+    send panel    set height $ph
+}
+
+# Toggle the options display for the panel.
+proc wcsOptToggle { widget type state args } \
+{
+    global wcsPOptHeight
+    set h [ send panel get height ] 
+    if {$state == 1} {
+	send panel set height [ expr ($h + $wcsPOptHeight) ]
+    } else { 
+	send panel set height [ expr ($h - $wcsPOptHeight) ]
+    }
+} ; send wcsOptions addCallback wcsOptToggle
+
+# Handle the panel display toggles.
+proc wcsCoordsCB { widget type state args } \
+{
+
+    set hght [ expr (($state == 1) ? 17 : 4)]
+    switch $widget {
+    wpWcs1	{ send wtWcs1 set height $hght	}
+    wpWcs2	{ send wtWcs2 set height $hght	}
+    wpWcs3	{ send wtWcs3 set height $hght	}
+    wpWcs4	{ send wtWcs4 set height $hght	}
+    woptFBinfo	{ send wtFBCfg set height $hght }
+    woptTitles	{ send wtName set height $hght ; send wtTitle set height $hght }
+    }
+    setCoordPanelHeight                 
+}
+set wcValues { wpWcs1 wpWcs2 wpWcs3 wpWcs4 woptFBinfo woptTitles }
+foreach w $wcValues { send $w addCallback wcsCoordsCB }
+
+
+# Handle WCS label string options.
+set wcsLabels 1
+proc wcsLabelsCB { widget type state args } \
+{
+    global up_todo wcsLabels
+    set wcsLabels $state
+    #resizeCoordsBox 0
+    resizeCoordsBox $up_todo
+    updateCoordsBox
+} ; send woptLabels addCallback wcsLabelsCB
+
+
+# Toggle the BPM tracking state.
+proc wcsBPMCB { widget type state args } \
+{
+    global ism_enable
+    if ($ism_enable) { catch { send wcspix set bpm $state } }
+} ; send woptBPM addCallback wcsBPMCB
+
+
+# Procedures to format lines in the wcsText box.
+proc wcsFmtImname { name } \
+{
+    send wtName    set string [format "     Name:  %s" [string trimleft $name]]
+}
+
+proc wcsFmtImtitle { title } \
+{
+    send wtTitle   set string [format "    Title:  %s" [string trimleft $title]]
+}
+
+proc wcsFmtFBConfig args \
+{
+    global frameWidth frameHeight frame nframes
+    set buf [ format "%5d x %-5d" $frameWidth $frameHeight ]
+    set line [ format "Frame Buf:  %-13s             Frame:  %d of %d" \
+	[string trimleft $buf] $frame $nframes ]
+    send wtFBCfg set string $line
+}
+
+proc wcsFmtIValue { value } \
+{
+    global coord
+    set line [ format " Pixel:  %.11s" $value ]
+    send wtIPixval set string $line
+    if {[info exists coord(ival)]} {
+        set coord(ival) $value
+        updateCoordsBox
+    }
+}
+
+proc wcsFmtSValue { value } \
+{
+    global coord
+    set line [ format " Scaled:  %.8s" $value ]
+    send wtSPixval set string $line
+    set coord(sval) [format "%s" $value]
+}
+
+proc wcsFmtBValue { value } \
+{
+    global coord
+
+    if { [send woptBPM get on] } {
+        set line [ format " BPM:  %s" $value ]
+        set color [expr { ($value == 0) ? "black" : "red" } ]
+        set msg [format "set string \{%s\}; set background %s" $line $color ]
+        set coord(bval) [format "%s" $value]
+    } else {
+        set line [ format " BPM:  (off)" ]
+        set msg [format "set string \{%s\}" $line]
+    }
+    send wtBPixval $msg
+}
+
+proc wcsFmtWcs { num wcsname x y xunit yunit args } \
+{ 
+    global coord coordLab wcsLabels
+
+    if {$wcsLabels} {
+        set line [ format "%4s: %12s  %4s: %12s  WCS: %s" \
+            $xunit $x $yunit $y [string trimleft $wcsname] ]
+    } else {
+        set line [ format "%4s  %12s  %4s  %12s       %s" \
+            "    " $x "    " $y [string trimleft $wcsname] ]
+    }
+    send wtWcs$num set string $line
+
+    if {[info exists coord(wcs$num)]} {
+	if {$num == 1} {
+            set coord(wcs1) [ format "\{%s\} \{%s\} \{%s\}" $x $y $coord(sval) ]
+	} elseif {$num == 2} {
+            set coord(wcs2) [ format "\{%s\} \{%s\} \{%s\}" $x $y $coord(ival) ]
+	} else {
+	    set coord(wcs$num) [ format "\{%s\} \{%s\} \{%s\}" $x $y $wcsname  ]
+	}
+
+	set coordLab(wcs$num) [ format "\{%s\} \{%s\} \{%s\}" \
+	    $xunit $yunit [string trimleft $wcsname ] ]
+        updateCoordsBox
+    }
+}
+
+
+
+# Handle the wcsbox readout.
+#------------------------------
+set  up_todo	  2
+set  up_done	  0
+set  coord(ival)  0.
+set  coord(sval)  0.
+set  coord(bval)  0
+set  coord(wcs1)  { 0. 0. 0. }
+set  coord(wcs2)  { 0. 0. 0. }
+set  coord(wcs3)  { 0. 0. 0. }
+set  coord(wcs4)  { 0. 0. 0. }
+
+proc wcsCoordB { widget type state args } \
+{
+    global coord up_todo
+
+    switch $widget {
+    wiWcs1	{ set line wcs1  ;set coord($line) { 0. 0. "" } }
+    wiWcs2	{ set line wcs2  ;set coord($line) { 0. 0. "" } }
+    wiWcs3	{ set line wcs3  ;set coord($line) { 0. 0. "" } }
+    wiWcs4	{ set line wcs4  ;set coord($line) { 0. 0. "" } }
+    }
+
+    if {$state} {
+	incr up_todo
+    } else {
+	unset coord($line)
+	incr up_todo -1
+    }
+
+    resizeCoordsBox $up_todo
+    updateCoordsBox
+}
+set wiValues { wiWcs1 wiWcs2 wiWcs3 wiWcs4 }
+foreach w $wiValues { send $w addCallback wcsCoordB }
+
+
+# Resize the coords box depending on the panel options.
+proc resizeCoordsBox { nlines } \
+{
+    global track_enable wcsLabels winWidth winHeight wcsboxGeom 
+
+    if {! $track_enable} \
+	return
+
+    send wcsbox getAttributes width cur_w height cur_h 
+    set defGeom [format "%sx%s-5-5" $cur_w $cur_h]
+    send imagewin parseGeometry $wcsboxGeom $defGeom x y width height
+
+    set ew [expr (($wcsLabels == 1) ? 125 : 65)]
+
+    # Reset to the default geometry
+    if {$nlines == 0} {
+	set x [expr ($x + $ew)]
+	set y [expr ($y + $height - 17 + 1)]
+	set new_w  166
+	set new_h  17
+
+    } else {
+	if {$width > 166} {			;# not using default wcsbox
+	    set new_w $width
+	} else {
+	    set new_w [expr ($width + $ew)]
+	    set x [expr ($x - $ew)]
+	    if {$wcsLabels == 0} {
+		incr x 60
+	    }
+	}
+        set new_h [ expr ($nlines * 17) ]
+	set y [expr ($y + $height - $new_h + 1)]
+    }
+
+    # Bounds checking.
+    if {$x < 5} {
+	set x 5
+    } elseif {$x > [expr ($winWidth - $new_w - 5)]} {
+        set x [expr ($winWidth - $new_w - 5)]
+    }
+    if {$y < 5} {
+	set y 5
+    } elseif {$y > [expr ($winHeight - $new_h - 5)]} {
+        set y [expr ($winHeight - $new_h - 5)]
+    }
+
+    # Finally redraw the marker.
+    send wcsbox "\
+        setAttributes     \
+	    width  $new_w \
+	    height $new_h \
+	    x	   $x     \
+	    y	   $y;    \
+	redraw"
+
+    set wcsboxGeom [send imagewin getGeometry $x $y $new_w $new_h]
+    send client encodewcs [expr ($winWidth / 2)] [expr ($winHeight / 2)]
+    updateCoordsBox
+}
+
+
+# Shortcuts for known WCS labels.
+set labels(display)		"TV"
+set labels(logical)		"Log"
+set labels(physical)		"Phys"
+set labels(equatorial)		"Eq"
+set labels(ecliptic)		"Ecl"
+set labels(galactic)		"Gal"
+set labels(supergalactic)	"SGal"
+set labels(amplifier)		"Amp"
+set labels(ccd)			"CCD"
+set labels(detector)		"Det"
+
+
+# Format the coords box marker with the selected output options.
+proc updateCoordsBox args \
+{
+    global ism_enable coord coordLab wcsLabels
+    global up_done up_todo labels track_enable
+    global coord
+
+    if {! $ism_enable} \
+	return
+
+    incr up_done
+
+    set text ""
+    foreach l {wcs1 wcs2 wcs3 wcs4} {
+	if {[info exists coord($l)]} {
+	    set x [lindex $coord($l) 0]
+	    set y [lindex $coord($l) 1]
+	    set z [string tolower [string trimleft [lindex $coord($l) 2] ] ]
+	    if {[info exists labels($z)]} {
+		set z $labels($z)
+	    }
+
+	    if {$wcsLabels && [info exists coordLab($l)]} {
+	        set lx [lindex $coordLab($l) 0]
+	        set ly [lindex $coordLab($l) 1]
+	        append text [format " %4s %12.12s %4s %12.12s %9.9s \n" \
+		    $lx $x $ly $y $z ]
+	    } else {
+	        append text [format " %12.12s %12.12s %9.9s \n" $x $y $z ]
+	    }
+	}
+    }
+
+    # Now send the string.
+    if {$track_enable} {
+	set color [expr { ($coord(bval) == 0) ? "black" : "red" } ]
+        set txt [format "set text \{%s\}; set textBgColor %s; redraw noerase" \
+		$text $color ]
+        send wcsbox $txt
+    }
+
+    if {$up_done >= $up_todo} {
+        set up_done	0			;# reset counter
+    }
+}
+
+
+# Create the WCS format menus.
+#------------------------------------
+proc setWcsFmt { format line } \
+{
+    catch { send wcspix set format $format $line }
+}
+
+for {set i 1} {$i <= 4} {incr i} {
+   set items {}
+   lappend items "\"Default\"     f.exec \{setWcsFmt default $i\}"
+   lappend items "\"Sexigesimal\" f.exec \{setWcsFmt hms     $i\}"
+   lappend items "\"Degrees\"     f.exec \{setWcsFmt deg     $i\}"
+   lappend items "\"Radians\"     f.exec \{setWcsFmt rad     $i\}"
+   editMenu fmtMenu$i fmtWcs$i $items
+}
+
+
+# Create the default WCS type menus.
+#------------------------------------
+
+set defaultWcsMenu {
+   { "None"		f.exec	{setWcsSys none     WCS_LINE } }
+   { "Display"		f.exec	{setWcsSys display  WCS_LINE } }
+   { "World"		f.exec	{setWcsSys world    WCS_LINE } }
+   { "Logical"		f.exec	{setWcsSys logical  WCS_LINE } }
+   { "Physical"		f.exec	{setWcsSys physical WCS_LINE } }
+   { 			f.dblline	}
+}
+
+proc setWcsSys { sys line } \
+{
+    if {[string tolower $sys] == "none"} {
+        wcsCoordB wiWcs$line junk 0
+        send sysWcs$line set label "None"; send fmtWcs$line set label "Default"
+        send wpWcs$line  set on False    ; send wiWcs$line  set on False
+        send wtWcs$line  set height 4
+	setCoordPanelHeight
+
+    } else {
+        catch { send wcspix set wcs $sys $line }
+    }
+}
+
+proc resetDefaultWcsMenu args \
+{
+    global defaultWcsMenu
+
+    for {set i 1} {$i <= 4} {incr i} {
+        regsub -all WCS_LINE $defaultWcsMenu $i menu_def
+        editMenu sysMenu$i sysWcs$i $menu_def
+    }
+} ; resetDefaultWcsMenu
+
+
+# Initialize the coordinates panel.
+#------------------------------------
+
+proc initCoordsPanel args \
+{
+    #send wcLine set height 2		;# kludge for label widget
+
+    # Initialize the display strings in the coords box.
+    wcsFmtImname   ""
+    wcsFmtImtitle  ""
+    wcsFmtFBConfig
+    wcsFmtIValue  "0." ; wcsFmtSValue "0." ; wcsFmtBValue "0"
+    wcsFmtWcs      1 "" "" "" "   X" "   Y"
+    wcsFmtWcs      2 "" "" "" "   X" "   Y"
+    wcsFmtWcs      3 "" "" "" "   X" "   Y"
+    wcsFmtWcs      4 "" "" "" "   X" "   Y"
+
+    send fmtWcs1 set label Default
+    send wpWcs1 set on True  ;send wiWcs1 set on True
+    send wpWcs2 set on True  ;send wiWcs2 set on True
+    send wpWcs3 set on False ;send wiWcs3 set on False ;send wtWcs3 set height 4
+    send wpWcs4 set on False ;send wiWcs4 set on False ;send wtWcs4 set height 4
+
+    # Set the Coords Panel height.
+    set wcsPTxtHeight [send wcsText get height]
+    setCoordPanelHeight
+
+    # Set the WCS readout panel sensitivity.
+    setCoordPanelSensitivity
+
+} ; initCoordsPanel
+
+