diff options
Diffstat (limited to 'vendor/x11iraf/ximtool/gui/func.tcl')
| -rw-r--r-- | vendor/x11iraf/ximtool/gui/func.tcl | 202 |
1 files changed, 202 insertions, 0 deletions
diff --git a/vendor/x11iraf/ximtool/gui/func.tcl b/vendor/x11iraf/ximtool/gui/func.tcl new file mode 100644 index 00000000..3144e214 --- /dev/null +++ b/vendor/x11iraf/ximtool/gui/func.tcl @@ -0,0 +1,202 @@ + +################################################################################ +# CURSOR CENTEROID AND AUTO-REGISTER FUNCTIONS. +################################################################################ + +# Set the centroiding box size. +set ctid 0 +set cid 0 + +proc cbxDestroy args \ +{ + global centerBoxSize cid ctid + catch { + if {$ctid != 0} { + send cbm$cid destroy + deleteTimedCallback $ctid + set ctid 0 + } + } +} + +proc setCtrBoxSize { x y delta args } \ +{ + global centerBoxSize cid ctid + global cpXscale cpYscale + + incr centerBoxSize $delta + if {$centerBoxSize <= 1} { set centerBoxSize 1 } + + # Kill off any old markers before drawing the new one. + catch { + if {$ctid != 0} { + send cbm$cid destroy + deleteTimedCallback $ctid + set ctid 0 + } + } + + # create a transient marker indicating the centering box and post a + # callback to delete it in about a second. + incr cid + send imagewin createMarker cbm$cid \ + type box \ + createMode noninteractive \ + lineColor red \ + x $x \ + y $y \ + width [expr $cpXscale * $centerBoxSize] \ + height [expr $cpXscale * $centerBoxSize] \ + activated True \ + visible True \ + sensitive False + + set ctid [ postTimedCallback cbxDestroy 500] +} + + +# Box size is half-width of the marker size. Value is the slider value. +set focusBoxSize $winWidth +set focusValue 100.0 +set fid 0 +set ftid 0 +set moving 0 + +proc setFocusBoxSize { sz args } \ +{ + global focusBoxSize fid ftid focusValue moving + global winWidth winHeight + + + if { $moving == 0 } { + return done + } + + if { $winWidth < $winHeight } { + set max [expr $winWidth / 2 - 64] + } else { + set max [expr $winHeight / 2 - 64] + } + set focusBoxSize [expr 64 + ($sz * $max) - 1] + #send client setOption cmfocus [expr ($focusBoxSize / 2)] + send client setOption cmfocus $focusBoxSize + + # Destroy any existing markers. + catch { + if {$ftid != 0} { + send fm$fid destroy + set ftid 0 + } + } + + # create a transient marker indicating the centering box and post a + # callback to delete it in about a second. + incr fid + send imagewin createMarker fm$fid \ + type box \ + createMode noninteractive \ + lineColor green \ + lineWidth 4 \ + x [expr $winWidth / 2] \ + y [expr $winHeight / 2] \ + width $focusBoxSize \ + height $focusBoxSize \ + activated True \ + visible True \ + sensitive False + + set ftid [ postTimedCallback fbxDestroy 500] + set moving 0 +} + +proc fbxDestroy args \ +{ + global fid ftid moving + catch { + if {$ftid != 0} { + send fm$fid destroy + set ftid 0 + } + } +} + +proc setFocusSize { widget cbtype x y } \ +{ + global focusValue ftid moving + + # Only update once we've stopped the movement. + if { $x == $focusValue && $moving == 1 } { + set ftid [ postWorkProc setFocusBoxSize $x ] + } else { + set moving 1 + } + set focusValue $x +} ; send focusSlider addCallback setFocusSize scroll + + +# Compute a centroid offset for the current position to peak-up on the +# feature. + +proc centroid { x y type args } \ +{ + global centerBoxSize + global cpXscale cpYscale + + # Convert to image coords. + set sz [expr "int ($centerBoxSize * $cpXscale)"] + + # Get the centroid position. + if {$type != "min"} { + if {[send peakupButton get on]} { + set center [ send client centroid $x $y $sz ] + } else { + set center [ send client centroid $x $y $sz max ] + } + } else { + set center [ send client centroid $x $y $sz min ] + } + + # Now reposition the cursor. + set xoff [lindex $center 0 ] + set yoff [lindex $center 1 ] + move_cursor $xoff $yoff +} + + +# Set the auto-register center offset position +proc offset { x y args } \ +{ + global frame blinkFrames auto_reg + global frameCenterX frameCenterY + global frameOffsetX frameOffsetY + + # No-op of auto-register isn't on. + if { $auto_reg == 0 } { + Wexec client "Auto-Register is not enabled!" + return + } + + # If we're not in the blink frames list ignore the request. + if { [string first $frame $blinkFrames] == -1 } { + Wexec client "Frame not in current\nregister list." + return + } + + set rx $x; set ry $y + set raster 0 + + # Convert raw screen coordinates to frame buffer raster coordinates. + send imagewin unmapPixel $x $y raster rx ry + + # Select a pixel. + set xoff [expr "int ($rx) - $frameCenterX($frame)" ] + set yoff [expr "int ($ry) - $frameCenterY($frame)" ] + + set frameOffsetX($frame) $xoff + set frameOffsetY($frame) $yoff + + # Adjust the display. + send client setOffset $xoff $yoff +} + + |