aboutsummaryrefslogtreecommitdiff
path: root/vendor/x11iraf/ximtool/gui/wcs.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'vendor/x11iraf/ximtool/gui/wcs.tcl')
-rw-r--r--vendor/x11iraf/ximtool/gui/wcs.tcl464
1 files changed, 464 insertions, 0 deletions
diff --git a/vendor/x11iraf/ximtool/gui/wcs.tcl b/vendor/x11iraf/ximtool/gui/wcs.tcl
new file mode 100644
index 00000000..8b14db4f
--- /dev/null
+++ b/vendor/x11iraf/ximtool/gui/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
+
+
generated by cgit (git 2.34.1) at 2025-09-20 13:14:17 -0400