path: root/vendor/x11iraf/ximtool/gui.bak/wcs.tcl

################################################################################
#  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