aboutsummaryrefslogtreecommitdiff
path: root/vendor/x11iraf/ximtool/gui/toolbars.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'vendor/x11iraf/ximtool/gui/toolbars.tcl')
-rw-r--r--vendor/x11iraf/ximtool/gui/toolbars.tcl557
1 files changed, 557 insertions, 0 deletions
diff --git a/vendor/x11iraf/ximtool/gui/toolbars.tcl b/vendor/x11iraf/ximtool/gui/toolbars.tcl
new file mode 100644
index 00000000..85e6946e
--- /dev/null
+++ b/vendor/x11iraf/ximtool/gui/toolbars.tcl
@@ -0,0 +1,557 @@
+
+
+################################################################################
+#
+# XIMTOOL-ALT -- Procedures and declarations for the ALT GUI.
+#
+################################################################################
+
+# Creat the bitmaps needed for the alternate optional bars.
+
+createBitmap tools 16 16 {
+ 0xff, 0xff, 0xff, 0xff, 0x03, 0xc0, 0xf3, 0xcf, 0xf3, 0xcf, 0xf3, 0xcf,
+ 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1,
+ 0x83, 0xc1, 0x03, 0xc0, 0xff, 0xff, 0xff, 0xff};
+
+createBitmap control 16 16 {
+ 0xff, 0xff, 0xff, 0xff, 0x03, 0xc0, 0xe3, 0xc7, 0xe3, 0xcf, 0x33, 0xcc,
+ 0x33, 0xc0, 0x1b, 0xc0, 0x1b, 0xc0, 0x1b, 0xc0, 0x33, 0xcc, 0xf3, 0xcf,
+ 0xe3, 0xc7, 0x03, 0xc0, 0xff, 0xff, 0xff, 0xff};
+
+createBitmap tile 16 16 {
+ 0xff, 0xff, 0xff, 0xff, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1,
+ 0x83, 0xc1, 0xff, 0xff, 0xff, 0xff, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1,
+ 0x83, 0xc1, 0x83, 0xc1, 0xff, 0xff, 0xff, 0xff};
+
+createBitmap compass 16 16 {
+ 0x00, 0x00, 0x00, 0x02, 0x00, 0x07, 0x80, 0x0f, 0xc0, 0x1f, 0x00, 0x07,
+ 0x00, 0x07, 0x00, 0x07, 0x00, 0x07, 0x00, 0x07, 0x00, 0x07, 0xfc, 0x07,
+ 0xfc, 0x07, 0xfc, 0x07, 0x00, 0x00, 0x00, 0x00}
+
+createBitmap plus 11 11 {
+ 0x00, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0xfe, 0x03, 0xfe, 0x03,
+ 0xfe, 0x03, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x00, 0x00};
+
+createBitmap minus 11 11 {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, 0xfe, 0x03,
+ 0xfe, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+
+createBitmap disk 16 16 {
+ 0xfe,0x1f,0x11,0x25,0x11,0x45,0x11,0x44,0xf1,0x47,0x01,0x40,0x01,0x40,0xf9,
+ 0x4f,0x05,0x50,0x05,0x50,0x05,0x50,0x05,0x50,0x05,0x50,0x05,0x50,0xff,0x7f,
+ 0x00,0x00};
+
+createBitmap printer 32 16 {
+ 0x00, 0xfe, 0x07, 0x00, 0x00, 0x02, 0x0a, 0x00, 0x00, 0x02, 0x12, 0x00,
+ 0x00, 0x02, 0x22, 0x00, 0x00, 0x02, 0x3e, 0x00, 0x00, 0x02, 0x20, 0x00,
+ 0x00, 0x02, 0x20, 0x00, 0xe0, 0x03, 0xe0, 0x03, 0x10, 0x03, 0xe0, 0x06,
+ 0x08, 0xff, 0x7f, 0x09, 0x04, 0x00, 0x00, 0x10, 0xfc, 0xff, 0xff, 0x1f,
+ 0x04, 0x00, 0x00, 0x10, 0xfc, 0xff, 0xff, 0x1f, 0x08, 0x00, 0x00, 0x08,
+ 0xf8, 0xff, 0xff, 0x0f};
+
+
+send tbBlinkDec "set bitmap larrow" ;# Assign the bitmaps to the buttons.
+send tbBlinkInc "set bitmap rarrow"
+send tbZoomIn "set bitmap plus"
+send tbZoomOut "set bitmap minus"
+send tbTile "set bitmap tile"
+send tbCompass "set bitmap compass; addCallback toggleCompass"
+#send helpButton "set bitmap qmark; addCallback Help"
+send mXflipButton "set bitmap xflip; addCallback xflip"
+send mYflipButton "set bitmap yflip; addCallback yflip"
+send mNextButton "set bitmap rarrow; addCallback nextFrame"
+send mPrevButton "set bitmap larrow; addCallback prevFrame"
+
+
+# toolBox -- Toggle the toolbox and panelbar display.
+
+set toolbox_up [ true $showToolBar ]
+set panelbar_up [ true $showPanelBar ]
+
+proc toolBoxToggle args \
+{
+ global toolbox_up
+
+ set w [send display get width] ; set h [send display get height]
+ set iw [send imagewin get width] ; set ih [send imagewin get height]
+
+ if {$toolbox_up} {
+ send toolbar set height 0
+ send toolButton set state 0
+ send imagewin "set width $iw; set height $ih"
+ set nh [expr $h - 25]
+ send display "set width $w; set height $nh"
+ set toolbox_up 0
+ send mXflipButton map
+ send mYflipButton map
+ send mPrevButton map
+ send mFrameButton map
+ send mNextButton map
+ } else {
+ send toolbar set height 25
+ send toolButton set state 1
+ send imagewin "set width $iw; set height $ih"
+ set nh [expr $h + 25]
+ send display "set width $w ; set height $nh"
+ set toolbox_up 1
+ send mXflipButton unmap
+ send mYflipButton unmap
+ send mPrevButton unmap
+ send mFrameButton unmap
+ send mNextButton unmap
+ }
+}
+
+proc panelBarToggle args \
+{
+ global panelbar_up
+
+ set w [send display get width] ; set h [send display get height]
+ set iw [send imagewin get width] ; set ih [send imagewin get height]
+
+ if {$panelbar_up} {
+ send panelbar set height 0
+ send panelButton set state 0
+ send imagewin "set width $iw; set height $ih"
+ set nh [expr $h - 25]
+ send display "set width $w ; set height $nh"
+ set panelbar_up 0
+ } else {
+ send panelbar set height 25
+ send panelButton set state 1
+ send imagewin "set width $iw; set height $ih"
+ set nh [expr $h + 25]
+ send display "set width $w ; set height $nh"
+ set panelbar_up 1
+ }
+}
+
+
+
+# Initialize the bars to be displayed if the resource was set.
+
+send toolButton "set bitmap tools; addCallback toolBoxToggle"
+if { ! [ true $showToolBar ] } {
+ send display set height [expr [send display get height] - 25]
+ send toolbar set height 0
+ send toolButton set state 0
+} else {
+ send toolButton set state 1
+ send mXflipButton unmap
+ send mYflipButton unmap
+ send mPrevButton unmap
+ send mFrameButton unmap
+ send mNextButton unmap
+}
+
+send panelButton "deleteCallback panel"
+send panelButton "set bitmap control; addCallback panelBarToggle"
+
+if { ! [ true $showPanelBar ] } {
+ send display set height [expr [send display get height] - 25]
+ send panelbar set height 0
+ send panelButton set state 0
+} else {
+ send panelButton set state 1
+}
+
+
+##############################################
+# Panelbar callbacks.
+##############################################
+
+send pbQuit addCallback Quit
+send helpClose addCallback "send helpButton set state 0"
+
+
+# Control Panel.
+#------------------------------------------------------
+proc pbToggleControl {name element op} \
+{
+ upvar $name panel_up
+ send pbDisplayP set state [expr !($panel_up)]
+} ; #trace variable panel_up w pbToggleControl
+
+proc pbResetPanel {param old new} \
+{
+ global displayPanner displayMagnifier displayCoords
+ switch $new {
+ done { send pbPanM set state [true $displayPanner]
+ send pbMagM set state [true $displayMagnifier]
+ send pbWcsM set state [true $displayCoords]
+ }
+ }
+} ; send initialize addCallback pbResetPanel
+
+set WidgetToTab(pbDisplayP) display_panel
+set WidgetToTab(pbInfoP) info_panel
+set WidgetToTab(pbLoadP) load_panel
+set WidgetToTab(pbPrintP) print_panel
+set WidgetToTab(pbSaveP) save_panel
+set WidgetToTab(pbTileP) tile_panel
+set WidgetToTab(pbCoordP) wcs_panel
+
+set TabToWidget(display_panel) pbDisplayP
+set TabToWidget(print_panel) pbPrintP
+set TabToWidget(load_panel) pbLoadP
+set TabToWidget(save_panel) pbSaveP
+set TabToWidget(info_panel) pbInfoP
+set TabToWidget(tile_panel) pbTileP
+set TabToWidget(wcs_panel) pbCoordP
+
+set pbTabTop "pbDisplayP"
+
+proc pbPanelDismiss args \
+{
+ global tabTop TabToWidget WidgetToTab
+ set panel $TabToWidget($tabTop)
+ send $panel set state 0
+} ; send panelClose addCallback pbPanelDismiss
+
+proc pbResizeCB {widget event a b c d e args} \
+{
+ global pbTabTop TabToWidget WidgetToTab
+ if { $a == 0 && $b == 0 && $c == 0 && $d == 0 && $e == 0 } {
+ send $pbTabTop set state 0
+ set new $TabToWidget($widget)
+ send $new set state 1
+ set pbTabTop $new
+ }
+} ; foreach w $cpTabs {send $w addEventHandler pbResizeCB exposureMask}
+
+proc pbPanelTabs { widget type state args } \
+{
+ global pbTabTop tabTop panel_up
+ global TabToWidget WidgetToTab
+
+ set panel $WidgetToTab($widget)
+ if {$tabTop == $panel && $panel_up} {
+ send panelShell unmap
+ send $widget set state 0
+ set panel_up 0
+ return
+ }
+
+ send $TabToWidget($tabTop) set state 0
+ set tabTop $panel
+ set pbTabTop $TabToWidget($panel)
+ send panelTabs setTop $panel
+
+ # Now fire it up if it's not already open.
+ if {$panel_up == 0} {
+ send $widget set state 1
+ send panelShell map
+ set panel_up 1
+ }
+}
+foreach w { pbDisplayP pbInfoP pbLoadP pbPrintP pbSaveP pbTileP pbCoordP } {
+ send $w addCallback pbPanelTabs
+}
+
+
+
+# Load Panel. (Really need to clean this up.)
+#------------------------------------------------------
+proc pbDoLoadOptions { param old new } \
+{
+ set val [ join [lrange $new 1 end] " " ]
+ switch [lindex $new 0] {
+ newfile { send fnameText set string $val }
+ }
+} ; send loadOptions addCallback pbDoLoadOptions
+
+proc pbFileLoad { widget mode fname args } \
+{
+ set fpath [format "%s/%s" \
+ [string range [send dirLabel get label] 12 end] $fname ]
+ send imagewin setCursorType idle
+} ; send fnameText addCallback pbFileLoad
+
+proc pbflSelectPrint {widget cbtype selections args} \
+{
+ foreach selection $selections {
+ ;
+ }
+}; #send imageList addCallback pbflSelectPrint
+
+proc pbFileLoadB args \
+{
+ set fname [send fnameText get string]
+ if {$fname != ""} {
+ set fpath [format "%s/%s" \
+ [string range [send dirLabel get label] 12 end] $fname ]
+ }
+} ; send filesLoadButton addCallback pbFileLoadB
+
+
+# Panner Marker.
+#------------------------------------------------------
+proc pbTracePanner {name element op} \
+{
+ global last_compass
+
+ catch {
+ upvar $name panner_enable
+ send pbPanM set state $panner_enable
+
+ if { $panner_enable } {
+ send tbCompass "setSensitive True ; set state $last_compass"
+ drawCompass
+ } else {
+ send tbCompass "setSensitive False ; set state False"
+ eraseCompass
+ }
+ }
+} ; trace variable panner_enable w pbTracePanner
+
+proc pannerPanel args \
+{
+ global panner_enable displayPanner
+
+ setPanner [expr !$panner_enable]
+ send pannerButton set on [expr $panner_enable]
+}; send pbPanM addCallback pannerPanel
+
+
+# Magnifier Marker.
+#------------------------------------------------------
+proc pbTraceMagnifier {name element op} \
+{
+ upvar $name magnifier_enable
+ send pbMagM set state $magnifier_enable
+} ; trace variable magnifier_enable w pbTraceMagnifier
+
+proc magnifierPanel args \
+{
+ global magnifier_enable displayMagnifier
+ setMagnifier [expr !$magnifier_enable]
+ send magnifierButton set on [expr $magnifier_enable]
+}; send pbMagM addCallback magnifierPanel
+
+
+# CoordsBox Marker.
+#------------------------------------------------------
+proc pbTraceCoordsBox {name element op} \
+{
+ upvar $name track_enable
+ send pbWcsM set state $track_enable
+} ; trace variable track_enable w pbTraceCoordsBox
+
+proc wcsPanel args \
+{
+ global track_enable
+ setTrack [expr !$track_enable]
+}; send pbWcsM addCallback wcsPanel
+
+
+
+# WPIX ISM Callbacks.
+#------------------------------------------------------
+
+proc altIsmToggle { widget type state args } \
+{
+ ismToggle pbIsm junk $state
+} ; send pbIsm addCallback altIsmToggle
+
+proc pbTraceIsm {name element op} \
+{
+ upvar $name ism_enable
+ send pbIsm set state $ism_enable
+} ; trace variable ism_enable w pbTraceIsm
+
+
+proc altIsmMsgCB { param old new } \
+{
+ set cmd [lindex $new 0] ;# command name
+ set ism [lindex $new 1] ;# determine ISM name
+ set argv [lrange $new 2 end] ;# get args
+ set argc [llength $argv]
+
+ switch $cmd {
+ deliver { ${ism}_alt_msg $argc $argv }
+ }
+} ; send ism_msg addCallback altIsmMsgCB
+
+
+proc wcspix_alt_msg { argc argv } \
+{
+ set arg [string trimleft [ string trimright [lindex $argv 0] ] ]
+ set cmd [lindex $arg 0]
+ switch $cmd {
+ startup { }
+ shutdown { }
+ disable { send pbIsm "set state False ; setSensitive False" }
+ capable { send pbIsm "setSensitive True" }
+ }
+}
+
+
+
+##############################################
+# Toolbar callbacks.
+##############################################
+
+send tbNormalize addCallback normalize
+send tbInvert addCallback cpInvert
+send tbRegister addCallback cpRegisterFrames
+send tbMatchLUT addCallback cpMatchFrames
+
+
+# Frame Selection.
+#------------------
+createMenu mFrameMenu mFrameButton $frameMenuDescription
+
+proc altFrameChanged {param old new} \
+{
+ send mFrameButton set label $new
+} ; send frame addCallback altFrameChanged
+
+
+# Image Flipping.
+#------------------------------------------------------
+proc tbSetFlip {param old new} \
+{
+ if {$param == "xflip"} {
+ send mXflipButton set state [true $new]
+ } else {
+ send mYflipButton set state [true $new]
+ }
+}; foreach i {xflip yflip} { send $i addCallback tbSetFlip }
+
+
+# Zoom/Pan buttons.
+#------------------------------------------------------
+proc tbZoomAction { widget args } \
+{
+ global frameWidth frameHeight
+
+ switch $widget {
+ tbZoom0 { cpZoom 1 1 fixed }
+ tbZoomIn { cpZoom 2.0 2.0 relative }
+ tbZoomOut { cpZoom 0.5 0.5 relative }
+ tbCenter { send client pan [expr $frameWidth/2.0] [expr $frameHeight/2.0] }
+ }
+}
+foreach widget { tbCenter tbZoomIn tbZoom0 tbZoomOut } {
+ send $widget addCallback tbZoomAction
+}
+
+
+# Frame Blink.
+#------------------------------------------------------
+proc tbSetBlinkRate {w args} \
+{
+ if {$w == "tbBlinkInc"} {
+ cpSetBlinkRate BRincrease
+ } else {
+ cpSetBlinkRate BRdeccrease
+ }
+}
+foreach w {tbBlinkDec tbBlinkInc} { send $w addCallback tbSetBlinkRate }
+
+proc tbBlink { widget args } \
+{
+ global blinkRate blinkId
+
+ if {$blinkRate < 0.01} {
+ send tbBlink set state 0
+ } else {
+ if {$widget != "tbBlink"} {
+ if {($blinkId != 0) != [send $widget get on]} {
+ toggleBlink
+ }
+ } else {
+ if {($blinkId != 0) != [send $widget get state]} {
+ toggleBlink
+ }
+ }
+ }
+} ; send tbBlink addCallback tbBlink
+
+proc tbTraceBlink {name element op} \
+{
+ upvar $name blinkId
+ send tbBlink set state [expr $blinkId != 0]
+} ; trace variable blinkId w tbTraceBlink
+
+
+# Auto-register.
+#------------------------------------------------------
+proc tbAutoRegister { widget type state args } \
+{
+ send tbAutoReg set state $state
+}
+foreach w {autoregButton brAregButton tbAutoReg} {
+ send $w addCallback cpAutoRegister
+}
+
+proc tbToggleAutoReg args \
+{
+ global auto_reg
+ if {$auto_reg} {
+ cpAutoRegister autoregButton dummy 0
+ set auto_reg 0
+ send tbAutoReg set state 0
+ } else {
+ cpAutoRegister autoregButton dummy 1
+ set auto_reg 1
+ send tbAutoReg set state 1
+ }
+}
+
+
+# Frame Tiles.
+#------------------------------------------------------
+proc tbSetTileFrames args \
+{
+ global tileOpt
+
+ # Send the option to the client.
+ if {[send tbTile get state ]} {
+ if {$tileOpt == 0} {
+ # If mode is disabled, turn on the tile selection.
+ selectTileOrientation junk junk Best
+ } else {
+ # Otherwise, turn on in current mode.
+ selectTileOrientation junk junk [tileSelToLabel $tileOpt]
+ }
+ } else {
+ selectTileOrientation junk junk Disabled
+ }
+}; send tbTile addCallback tbSetTileFrames
+
+proc tbTrackTileFrames {param old new} \
+{
+ send tileFramesButton set on [true $new]
+ send tbTile set state $new
+}; send tileFrames addCallback tbTrackTileFrames
+
+proc tbTileFramesToggle args \
+{
+ set value [send tileFramesButton get on]
+ if {$value} { set not 0 } else { set not 1 }
+
+ send tileFramesButton set on $not
+ send tbTile set state $not
+ cpSetTileFrames tbTile junk $not
+}
+
+
+# Compass Indicator.
+#------------------------------------------------------
+proc tbToggleCompass { widget type state args } \
+{
+ global frame
+
+ if {$state} {
+ send compass set on True
+ send tbCompass set state 1
+ drawCompass
+ } else {
+ send compass set on False
+ send tbCompass set state 0
+ eraseCompass
+ }
+} ; foreach w {compass tbCompass} { send $w addCallback tbToggleCompass }
+
+
generated by cgit (git 2.34.1) at 2025-09-20 13:14:52 -0400