diff options
Diffstat (limited to 'vendor/x11iraf/ximtool/gui/compass.tcl')
| -rw-r--r-- | vendor/x11iraf/ximtool/gui/compass.tcl | 215 |
1 files changed, 215 insertions, 0 deletions
diff --git a/vendor/x11iraf/ximtool/gui/compass.tcl b/vendor/x11iraf/ximtool/gui/compass.tcl new file mode 100644 index 00000000..13f5bed8 --- /dev/null +++ b/vendor/x11iraf/ximtool/gui/compass.tcl @@ -0,0 +1,215 @@ + + +################################################################################ +# Compass indicator procedures. +################################################################################ + +set compassColor 207 ;# normally this is yellow +set last_compass [send compass get on] ;# save compass state + +proc drawCompass args \ +{ + global ism_enable frame frameCache compassColor Compass Orient + global panner_x panner_y panner_width panner_height cur_objid + global redraw_compass last_compass + + + if {! [send compass get on]} \ + return + + eraseCompass ;# erase the old compass + + if {! [info exists frameCache($frame)] } { + set id -1 + } elseif {$cur_objid != [lindex $frameCache($frame) 1]} { + set id [lindex $frameCache($frame) 1] + } else { + set id $cur_objid + } + + if { [info exists Compass($id)] } { + set angle [lindex $Compass($id) 0] + set north_x [lindex $Compass($id) 1] + set north_y [lindex $Compass($id) 2] + set east_x [lindex $Compass($id) 3] + set east_y [lindex $Compass($id) 4] + set transpose [lindex $Compass($id) 5] + set xlab [lindex $Compass($id) 6] + set ylab [lindex $Compass($id) 7] + } else { + set north_x 0.0 ; set north_y 1.0 + set east_x 1.0 ; set east_y 0.0 + set xlab X ; set ylab Y + set angle 0.0 ; set transpose 0 + set Compass($id) { 0.0 1.0 0.0 1.0 0.0 0 X Y } + } + set xflip 1 + set yflip 1 + + # Adjust the compass for the display orientation (e.g. image sections + # used to flip an image during display). + if { [info exists Orient($id)] } { + set xflip [expr $xflip * [lindex $Orient($id) 1] ] + set yflip [expr $yflip * [lindex $Orient($id) 2] ] + } + + # Get the panner center position. + set pcx [expr ($panner_x + $panner_width / 2)] + set pcy [expr ($panner_y + $panner_height / 2)] + + # Setup for the overlay. + send imagewin getLogRes sv_xl sv_yl + send imagewin getPhysRes sv_xp sv_yp + send imagewin setLogRes $sv_xp $sv_yp + send imagewin setLineWidth 2 + + set xflip [ expr ($xflip * ([send xflipButton get state] ? -1 : 1))] + set yflip [ expr ($yflip * ([send yflipButton get state] ? -1 : 1))] + + # Normalized compass points. The first row are the axes, second is + # the pointer head, and last are the X/Y label coords. Assumes a + # zero rotation with North up and East left, or standard X/Y orientation. + set cpoints { + {-1 0} {0 0} {0 -1} + {-0.07 -0.85} {0 -1} {0.07 -0.85} {-0.07 -0.85} + {-1.2 0} {0 -1.2} + } + + + # Get rotation and scale factors. + set angle [expr "atan2($north_y,$north_x)"] + set coso [expr "cos (-$angle)"] + set sino [expr "sin (-$angle)"] + set scale [expr ([min $panner_width $panner_height] * 0.3)] + + # Initialize the drawing points. + set pts {} + + set cpoints { } + lappend cpoints [list $east_x $east_y ] + lappend cpoints [list 0 0] + lappend cpoints [list $north_x $north_y] + foreach p $cpoints { + # Get the scaled position. + set sx [expr ($scale * [lindex $p [expr "($transpose > 0) ? 1 : 0"]])] + set sy [expr ($scale * [lindex $p [expr "($transpose > 0) ? 0 : 1"]])] + + # Translate to the scaled position. + set rx [expr int($pcx + $sx + 0.5)] + set ry [expr int($pcy - $sy + 0.5)] + + # Now handle the axis flip. + set rx [expr (($xflip < 0) ? ($pcx + ($pcx - $rx)) : $rx)] + set ry [expr (($yflip < 0) ? ($pcy + ($pcy - $ry)) : $ry)] + lappend pts $rx $ry + } + + + set rpoints { } + set hpoints { {0.0 0.0} {-0.1 -0.07} {-0.1 0.07} {0.0 0.0} } + foreach p $hpoints { + # Break out the position. + set sx [lindex $p [expr "($transpose > 0) ? 1 : 0"]] + set sy [lindex $p [expr "($transpose > 0) ? 0 : 1"]] + + # Do the rotation of the head at the origin. + set rx [expr ($north_x + ($sx * $coso + $sy * $sino))] + set ry [expr ($north_y - ($sx * $sino + $sy * $coso))] + + lappend rpoints [list $rx $ry] + } + foreach p $rpoints { + # Get the scaled position. + set sx [expr ($scale * [lindex $p [expr "($transpose > 0) ? 1 : 0"]])] + set sy [expr ($scale * [lindex $p [expr "($transpose > 0) ? 0 : 1"]])] + + # Translate to the scaled position. + set rx [expr int($pcx + $sx + 0.5)] + set ry [expr int($pcy - $sy + 0.5)] + + # Now handle the axis flip. + set rx [expr (($xflip < 0) ? ($pcx + ($pcx - $rx)) : $rx)] + set ry [expr (($yflip < 0) ? ($pcy + ($pcy - $ry)) : $ry)] + lappend pts $rx $ry + } + + set lpoints { } + lappend lpoints [list [expr "$east_x-0.2"] $east_y ] + lappend lpoints [list $north_x [expr "$north_y+0.2"] ] + foreach p $lpoints { + # Get the scaled position. + set sx [expr ($scale * [lindex $p [expr "($transpose > 0) ? 1 : 0"]])] + set sy [expr ($scale * [lindex $p [expr "($transpose > 0) ? 0 : 1"]])] + + # Translate to the scaled position. + set rx [expr int($pcx + $sx + 0.5)] + set ry [expr int($pcy - $sy - 0.5)] + + # Now handle the axis flip. + set rx [expr (($xflip < 0) ? ($pcx + ($pcx - $rx)) : $rx)] + set ry [expr (($yflip < 0) ? ($pcy + ($pcy - $ry)) : $ry)] + lappend pts $rx $ry + } + + + # Draw the compass axes. + set compassPts [lrange $pts 0 5] + send imagewin setColorIndex $compassColor + send imagewin drawPolyline $compassPts + + + # Draw the compass pointer. + set head [lrange $pts 6 13] + send imagewin setFillType solid + send imagewin drawPolygon $head + + # Draw the labels. + send imagewin drawAlphaText [lindex $pts 14] [lindex $pts 15] $xlab + send imagewin drawAlphaText [lindex $pts 16] [lindex $pts 17] $ylab + + send imagewin setLogRes $sv_xl $sv_yl + + set redraw_compass 0 + +} ; foreach w {xflip yflip} { send $w addCallback drawCompass } + + +# This is a kludge to redraw the compass after it is erased when displaying +# a new image. Once the user moves the mouse back into the main window we'll +# do the redraw. +send imagewin addEventHandler drawCompass enterWindowMask + + + +proc createCompassMarker { pts args } \ +{ + set cm_points { } + lappend cm_points [lrange $pts 0 1] + lappend cm_points [lrange $pts 2 3] + lappend cm_points [lrange $pts 4 5] + + print [list $cm_points] + +} + + +proc eraseCompass args \ +{ + global panner_mapping + send imagewin refreshMapping $panner_mapping +} + +proc toggleCompass { widget type state args } \ +{ + global last_compass + + if {$state} { + drawCompass + set last_compass True + } else { + eraseCompass + set last_compass False + } +} ; send compass addCallback toggleCompass + + |