diff options
Diffstat (limited to 'vendor/x11iraf/guidemo/region.gui')
| -rw-r--r-- | vendor/x11iraf/guidemo/region.gui | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/vendor/x11iraf/guidemo/region.gui b/vendor/x11iraf/guidemo/region.gui new file mode 100644 index 00000000..4013c890 --- /dev/null +++ b/vendor/x11iraf/guidemo/region.gui @@ -0,0 +1,197 @@ +# REGION.GUI -- Demo the use of region markers. +# This GUI can be run as "cl> hello gui=region.gui". + +reset-server +appInitialize regions Regions { + *objects:\ + toplevel Paned panel\ + panel Box control\ + panel Gterm graphics\ + panel AsciiText output\ + control Command quitButton\ + control Command measureButton\ + control Toggle skyButton + + *background: gray + *foreground: black + *menubar.showGrip: False + *menubar.skipAdjust: True + *menubar.width: 480 + *skyButton.label: Annulus + *measureButton.label: Measure + *quitButton.label: Quit + + *graphics.resizable: true + *graphics.ginmodeCursor: circle + *graphics.width: 640 + *graphics.height: 480 + + *output.width: 480 + + *graphics.translations: \ + <Btn1Down>: call(makeMarker,$name,$x,$y) m_create() \n\ + !Shift <Btn2Down>: crosshair(on) \n\ + !Shift <Btn2Motion>: crosshair(on) \n\ + <Btn2Up>: crosshair(off) \n\ + <EnterWindow>: enter-window() \n\ + <LeaveWindow>: leave-window() \n\ + <KeyPress>: graphics-input() \n\ + <Motion>: track-cursor() + + *allowShellResize: true + *shapeStyle: Rectangle + *beNiceToColormap: False + *Label*shadowWidth: 2 +} + +# Start up the GUI. +createObjects +send graphics setGterm +activate + +# Global variables +set marker objMarker ;# only one marker currently +set skyGap 10 ;# gap to sky annulus +set skyWidth 15 ;# width of sky annulus + + +# Procedures. +# ------------------------- + +proc quit args { send client gkey q; deactivate unmap } +send quitButton addCallback quit + +# Get a description of the region and print it in the output window. +proc measure args { + global marker + + # getRegion unmap will reverse any mappings and return raster coords. + set region [send $marker getRegion unmap] + send output set string $region + +}; send measureButton addCallback measure + + +# Draw/erase sky annulus. Once created these are not tied to the object +# region and the user is expected to toggle the skyButton to erase and +# redraw the annulus markers if the object marker is moved. If we wanted +# to be fancier about this we could register a move callback with the object +# marker and redraw the annulus markers at the new location if the object +# marker is moved. Currently there is no way to group markers so that they +# behave as one object. + +proc annulus args { + global skyGap skyWidth + global marker + + # In this case we use getRegion with no args, which returns window coords. + set region [send $marker getRegion] + + if [send skyButton get state] { + set x [lindex $region 2] + set y [lindex $region 3] + set width [lindex $region 4] + set height [lindex $region 5] + set rotangle [lindex $region 6] + + # Create a marker outlining the inner boundary of the annulus region. + # See obm/ObmW/Gterm.h for a list of marker attributes. + + send graphics createMarker sky1 \ + type ellipse \ + createMode noninteractive \ + lineColor blue \ + highlightColor blue \ + x $x \ + y $y \ + width [expr "$width + $skyGap"] \ + height [expr "$height + $skyGap"] \ + rotangle $rotangle \ + activated True \ + visible True \ + sensitive False + + # Create a marker outlining the outer boundary of the annulus region. + send graphics createMarker sky2 \ + type ellipse \ + createMode noninteractive \ + lineColor blue \ + highlightColor blue \ + x $x \ + y $y \ + width [expr "$width + $skyGap + $skyWidth"] \ + height [expr "$height + $skyGap + $skyWidth"] \ + rotangle $rotangle \ + activated True \ + visible True \ + sensitive False + + send sky1 "redraw noerase; lower" + send sky2 "redraw noerase; lower" + + } else { + send sky1 destroy + send sky2 destroy + } + +}; send skyButton addCallback annulus + + +# Support routines. +# ------------------------- + +# Create marker action. Makes a new marker. +proc makeMarker { parent x y } \ +{ + global markerTranslations marker + + send $parent createMarker $marker \ + type ellipse \ + createMode interactive \ + translations $markerTranslations \ + lineColor green \ + x $x \ + y $y + + send $marker addCallback moveResize moveResize +} + +proc moveResize args { + print "moveResize called: $args" +} + + +# Translations when pointer is inside a marker. +set markerTranslations { \ + !Shift <Btn1Motion>: m_rotateResize() + <Btn1Motion>: m_moveResize() + !Shift <Btn1Down>: m_raise() m_markpos() + <Btn1Down>: m_raise() m_markposAdd() + <Btn1Up>: m_redraw() m_destroyNull() + <Btn2Down>: m_lower() + <Btn3Down>: popup(markerMenu) + <Btn3Up>: popdown(markerMenu) + <Key>BackSpace: m_deleteDestroy() + <Key>Delete: m_deleteDestroy() + <KeyPress>: m_input() + <Motion>: track-cursor() +} + +# Popup menu in effect when inside marker. +createMenu markerMenu graphics { + { Object f.title } + { f.dblline } + { Measure f.exec { + measure + } } + { Dummy1 f.exec { + print dummy1 ;# (replace by real code) + } } + { Dummy2 f.exec { + print dummy2 ;# (replace by real code) + } } + { f.line } + { Destroy f.exec { + send $marker destroy + } } +} |