diff options
Diffstat (limited to 'ds9/library/panner.tcl')
| -rw-r--r-- | ds9/library/panner.tcl | 296 |
1 files changed, 296 insertions, 0 deletions
diff --git a/ds9/library/panner.tcl b/ds9/library/panner.tcl new file mode 100644 index 0000000..5ff5e7a --- /dev/null +++ b/ds9/library/panner.tcl @@ -0,0 +1,296 @@ +# 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 CreatePanner {} { + global ipanner + global ds9 + + set ds9(panner) [canvas $ds9(panel).pan -width $ipanner(size) \ + -height $ipanner(size) \ + -relief groove \ + -borderwidth 2 \ + -highlightthickness 0 \ + -insertofftime 0 \ + -takefocus 0] + $ds9(panner) create panner$ds9(visual) \ + -width $ipanner(size) \ + -height $ipanner(size) \ + -command panner \ + -tag panner \ + -helvetica $ds9(helvetica) \ + -courier $ds9(courier) \ + -times $ds9(times) +} + +proc PannerDef {} { + global ipanner + global ppanner + + set ipanner(size) 128 + + # prefs only + set ppanner(compass) 1 +} + +proc InitPanner {} { + global ds9 + global ppanner + + # other bindings + BindEventsPanner + + bind $ds9(panner) <Tab> [list NextFrame] + bind $ds9(panner) <Shift-Tab> [list PrevFrame] + + switch $ds9(wm) { + x11 {bind $ds9(panner) <ISO_Left_Tab> [list PrevFrame]} + aqua - + win32 {} + } + + switch $ds9(wm) { + x11 - + aqua { + bind $ds9(panner) <Enter> [list focus $ds9(panner)] + bind $ds9(panner) <Leave> [list focus {}] + } + win32 {} + } + + # compass + panner compass $ppanner(compass) +} + +proc BindEventsPanner {} { + global ds9 + + $ds9(panner) bind panner <Enter> [list EnterPanner %x %y] + $ds9(panner) bind panner <Leave> [list LeavePanner] + $ds9(panner) bind panner <Motion> [list MotionPanner %x %y] + $ds9(panner) bind panner <Button-1> [list Button1Panner %x %y] + $ds9(panner) bind panner <B1-Motion> [list Motion1Panner %x %y] + $ds9(panner) bind panner <ButtonRelease-1> [list Release1Panner %x %y] + + switch $ds9(wm) { + x11 - + win32 { + $ds9(panner) bind panner <ButtonRelease-2> \ + [list Release2Panner %x %y] + } + aqua { + $ds9(panner) bind panner <ButtonRelease-3> \ + [list Release2Panner %x %y] + } + } + + + $ds9(panner) bind panner <Up> [list ArrowKeyPanner 0 -1] + $ds9(panner) bind panner <Down> [list ArrowKeyPanner 0 1] + $ds9(panner) bind panner <Left> [list ArrowKeyPanner -1 0] + $ds9(panner) bind panner <Right> [list ArrowKeyPanner 1 0] +} + +proc UnBindEventsPanner {} { + global ds9 + + $ds9(panner) bind panner <Enter> {} + $ds9(panner) bind panner <Leave> {} + $ds9(panner) bind panner <Motion> {} + $ds9(panner) bind panner <Button-1> {} + $ds9(panner) bind panner <B1-Motion> {} + $ds9(panner) bind panner <ButtonRelease-1> {} + + switch $ds9(wm) { + x11 - + win32 {$ds9(panner) bind panner <ButtonRelease-2> {}} + aqua {$ds9(panner) bind panner <ButtonRelease-3> {}} + } + + $ds9(panner) bind panner <Up> {} + $ds9(panner) bind panner <Down> {} + $ds9(panner) bind panner <Left> {} + $ds9(panner) bind panner <Right> {} +} + +proc EnterPanner {x y} { + global ds9 + global current + + global debug + if {$debug(tcl,events)} { + puts stderr "EnterPanner" + } + + switch $ds9(wm) { + x11 - + aqua { + focus $ds9(panner) + $ds9(panner) focus panner + } + win32 {} + } + + if {$current(frame) != {}} { + EnterInfoBox $current(frame) + UpdateInfoBox $current(frame) $x $y panner + UpdatePixelTableDialog $current(frame) $x $y panner + UpdateGraph $current(frame) $x $y panner + } +} + +proc LeavePanner {} { + global ds9 + + global debug + if {$debug(tcl,events)} { + puts stderr "LeavePanner" + } + + panner highlite off + switch $ds9(wm) { + x11 - + aqua { + $ds9(panner) focus {} + focus {} + } + win32 {} + } + + LeaveInfoBox + PixelTableClearDialog + ClearGraphData +} + +proc MotionPanner {x y} { + global current + + global debug + if {$debug(tcl,events)} { + puts stderr "MotionPanner" + } + + panner highlite $x $y + if {$current(frame) != {}} { + UpdateColormapLevelMosaic $current(frame) $x $y panner + UpdateInfoBox $current(frame) $x $y panner + UpdatePixelTableDialog $current(frame) $x $y panner + UpdateGraph $current(frame) $x $y panner + } +} + +proc Button1Panner {x y} { + global ds9 + + global debug + if {$debug(tcl,events)} { + puts stderr "Button1Panner" + } + + panner pan begin $x $y +} + +proc Motion1Panner {x y} { + global ds9 + global current + + global debug + if {$debug(tcl,events)} { + puts stderr "Motion1Panner" + } + + panner pan motion $x $y + if {$current(frame) != {}} { + UpdateColormapLevelMosaic $current(frame) $x $y panner + UpdateInfoBox $current(frame) $x $y panner + UpdatePixelTableDialog $current(frame) $x $y panner + UpdateGraph $current(frame) $x $y panner + } +} + +proc Release1Panner {x y} { + global ds9 + global current + + global debug + if {$debug(tcl,events)} { + puts stderr "Release1Panner" + } + + if {$current(frame) != {}} { + panner pan end $x $y + $current(frame) pan bbox [panner get bbox] + + UpdateColormapLevelMosaic $current(frame) $x $y panner + UpdateInfoBox $current(frame) $x $y panner + UpdatePixelTableDialog $current(frame) $x $y panner + UpdateGraph $current(frame) $x $y panner + + LockFrameCurrent + UpdateGraphXAxis $current(frame) + UpdatePanZoomDialog + SAMPSendCoordPointAtSkyCmd $current(frame) + } +} + +proc Release2Panner {x y} { + global ds9 + global current + + if {$current(frame) != {}} { + panner pan to $x $y + $current(frame) pan bbox [panner get bbox] + + UpdateColormapLevelMosaic $current(frame) $x $y panner + UpdateInfoBox $current(frame) $x $y panner + UpdatePixelTableDialog $current(frame) $x $y panner + UpdateGraph $current(frame) $x $y panner + + LockFrameCurrent + UpdateGraphXAxis $current(frame) + UpdatePanZoomDialog + SAMPSendCoordPointAtSkyCmd $current(frame) + } +} + +proc ArrowKeyPanner {x y} { + global current + + panner warp $x $y + SAMPSendCoordPointAtSkyCmd $current(frame) +} + +proc PannerBackup {ch} { + global ppanner + + puts $ch "panner compass $ppanner(compass)" +} + +# Prefs + +proc PrefsDialogPanner {} { + global dprefs + + set w $dprefs(tab) + + $dprefs(list) insert end [msgcat::mc {Panner}] + lappend dprefs(tabs) [ttk::frame $w.panner] + + set f [ttk::labelframe $w.panner.param -text [msgcat::mc {Panner}]] + + ttk::checkbutton $f.compass \ + -text [msgcat::mc {Show Compass}] \ + -variable ppanner(compass) -command PrefsPannerCompass + + grid $f.compass -padx 2 -pady 2 -sticky w + + pack $f -side top -fill both -expand true +} + +proc PrefsPannerCompass {} { + global ppanner + + panner compass $ppanner(compass) +} |